WIP: simpleSingletonVersion

Author: coot

cardano-chain-gen/src/Cardano/Mock/ChainSync/Server.hs

@@ -2,11 +2,14 @@
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 
+{-# OPTIONS_GHC -Wno-orphans #-}
+
 module Cardano.Mock.ChainSync.Server (
   -- * server
   forkServerThread,
@@ -52,7 +55,7 @@ import qualified Network.Mux as Mux
 import Ouroboros.Consensus.Block (CodecConfig, HasHeader, Point, StandardHash, castPoint)
 import Ouroboros.Consensus.Config (TopLevelConfig, configCodec)
 import Ouroboros.Consensus.Ledger.Query (BlockQuery, ShowQuery)
-import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTx)
+import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTx, TxId)
 import Ouroboros.Consensus.Ledger.SupportsProtocol (LedgerSupportsProtocol)
 import Ouroboros.Consensus.Network.NodeToClient (Apps (..), Codecs' (..), DefaultCodecs)
 import qualified Ouroboros.Consensus.Network.NodeToClient as NTC
@@ -82,9 +85,11 @@ import Ouroboros.Network.Block (
   mkSerialised,
  )
 import Network.TypedProtocol.Peer (Peer (..))
+import qualified Network.TypedProtocol.Stateful.Peer as St
 import Network.TypedProtocol.Stateful.Codec ()
 import Ouroboros.Network.Channel (Channel)
 import Ouroboros.Network.Driver.Simple (runPeer)
+import qualified Ouroboros.Network.Driver.Stateful as St (runPeer)
 import Ouroboros.Network.IOManager (IOManager)
 import qualified Ouroboros.Network.IOManager as IOManager
 import Ouroboros.Network.Magic (NetworkMagic)
@@ -100,9 +105,10 @@ import Ouroboros.Network.Protocol.ChainSync.Server (
   chainSyncServerPeer,
  )
 import Ouroboros.Network.Protocol.Handshake.Version (simpleSingletonVersions)
+import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as LocalStateQuery
 import Ouroboros.Network.Snocket (LocalAddress, LocalSnocket, LocalSocket (..))
 import qualified Ouroboros.Network.Snocket as Snocket
-import Ouroboros.Network.Util.ShowProxy (Proxy (..), ShowProxy)
+import Ouroboros.Network.Util.ShowProxy (Proxy (..), ShowProxy (..))
 
 {- HLINT ignore "Use readTVarIO" -}
 
@@ -226,7 +232,7 @@ runLocalServer iom codecConfig netMagic localDomainSock chainProdState =
        in simpleSingletonVersions
             version
             (NodeToClientVersionData netMagic False)
-            (NTC.responder version $ mkApps state version blockVersion (NTC.defaultCodecs codecConfig blockVersion version))
+            (\versionData -> NTC.responder version versionData $ mkApps state version blockVersion (NTC.defaultCodecs codecConfig blockVersion version))
 
     mkApps ::
       StrictTVar IO (ChainProducerState blk) ->
@@ -270,11 +276,12 @@ runLocalServer iom codecConfig netMagic localDomainSock chainProdState =
           Channel IO ByteString ->
           IO ((), Maybe ByteString)
         stateQueryServer _them channel =
-          runPeer
+          St.runPeer
             nullTracer
             (cStateQueryCodec codecs)
             channel
-            (Effect (forever $ threadDelay 3_600_000_000))
+            LocalStateQuery.StateIdle
+            (St.Effect (forever $ threadDelay 3_600_000_000))
 
         txMonitorServer ::
           localPeer ->
@@ -283,10 +290,14 @@ runLocalServer iom codecConfig netMagic localDomainSock chainProdState =
         txMonitorServer _them channel =
           runPeer
             nullTracer
-            (cStateQueryCodec codecs)
+            (cTxMonitorCodec codecs)
             channel
             (Effect (forever $ threadDelay 3_600_000_000))
 
+-- TODO: it should be defined somewhere in `ouroboros-consensus`
+instance ShowProxy blk => ShowProxy (TxId (GenTx blk)) where
+  showProxy _ = "TxId (GenTx (" ++ showProxy (Proxy :: Proxy blk) ++ ")"
+
 chainSyncServer ::
   forall blk m.
   ( HasHeader blk