Merge pull request #735 from input-output-hk/plt-8235-improve-tracing

PLT-8235 Improve traces for chain-seek and chain-query
input-output-hk · Oct 27, 2023 · cde7197 · cde7197
2 parents b291822 + 2c1b584
commit cde7197
Show file tree

Hide file tree

Showing 36 changed files with 2,325 additions and 689 deletions.
diff --git a/marlowe-chain-sync/.golden/ChainSeek/golden b/marlowe-chain-sync/.golden/ChainSeek/golden
@@ -1,9 +1,9 @@
 Show: MsgCancel
 Binary: 08
-Show: MsgCancelScan
-Binary: 0b
-Show: MsgCollect
-Binary: 0a
+Show: MsgCancelScan Nothing
+Binary: 0b00
+Show: MsgCollect Nothing
+Binary: 0a00
 Show: MsgCollectFailed (TxInPast (BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}})) Genesis
 Binary: 0c030100000000000000010000000000000000000000000000000100
 Show: MsgCollectFailed (TxInPast (BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "61", blockNo = BlockNo {unBlockNo = 1}})) Genesis
@@ -142,46 +142,46 @@ Show: MsgCollected [] Genesis
 Binary: 0d02000000000000000000
 Show: MsgCollected [] Genesis
 Binary: 0d05000000000000000000
-Show: MsgDone
-Binary: 02
+Show: MsgDone Nothing
+Binary: 0200
 Show: MsgPoll
 Binary: 07
-Show: MsgQueryNext (AdvanceBlocks 1)
-Binary: 0101000000000000000001
-Show: MsgQueryNext (FindConsumingTxs (fromList [TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}]))
-Binary: 0104000000000000000100000000000000000001
-Show: MsgQueryNext (FindConsumingTxs (fromList [TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}}]))
-Binary: 010400000000000000010000000000000001610001
-Show: MsgQueryNext (FindConsumingTxs (fromList []))
-Binary: 01040000000000000000
-Show: MsgQueryNext (FindTx "" False)
-Binary: 0103000000000000000000
-Show: MsgQueryNext (FindTx "" True)
-Binary: 0103000000000000000001
-Show: MsgQueryNext (FindTx "61" False)
-Binary: 010300000000000000016100
-Show: MsgQueryNext (FindTxsFor (fromList (PaymentKeyCredential "" :| [PaymentKeyCredential "61"])))
-Binary: 0106000000000000000200000000000000000000000000000000000161
-Show: MsgQueryNext (FindTxsFor (fromList (PaymentKeyCredential "" :| [ScriptCredential ""])))
-Binary: 01060000000000000002000000000000000000010000000000000000
-Show: MsgQueryNext (FindTxsFor (fromList (PaymentKeyCredential "" :| [ScriptCredential "61"])))
-Binary: 0106000000000000000200000000000000000001000000000000000161
-Show: MsgQueryNext (FindTxsFor (fromList (PaymentKeyCredential "" :| [])))
-Binary: 01060000000000000001000000000000000000
-Show: MsgQueryNext (FindTxsFor (fromList (PaymentKeyCredential "61" :| [])))
-Binary: 0106000000000000000100000000000000000161
-Show: MsgQueryNext (FindTxsFor (fromList (ScriptCredential "" :| [])))
-Binary: 01060000000000000001010000000000000000
-Show: MsgQueryNext (FindTxsFor (fromList (ScriptCredential "61" :| [])))
-Binary: 0106000000000000000101000000000000000161
-Show: MsgQueryNext (Intersect [BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}])
-Binary: 01020000000000000001000000000000000100000000000000000000000000000001
-Show: MsgQueryNext (Intersect [BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "61", blockNo = BlockNo {unBlockNo = 1}}])
-Binary: 0102000000000000000100000000000000010000000000000001610000000000000001
-Show: MsgQueryNext (Intersect [])
-Binary: 01020000000000000000
-Show: MsgQueryNext AdvanceToTip
-Binary: 0105
+Show: MsgQueryNext Nothing (AdvanceBlocks 1)
+Binary: 010001000000000000000001
+Show: MsgQueryNext Nothing (FindConsumingTxs (fromList [TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}]))
+Binary: 010004000000000000000100000000000000000001
+Show: MsgQueryNext Nothing (FindConsumingTxs (fromList [TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}}]))
+Binary: 01000400000000000000010000000000000001610001
+Show: MsgQueryNext Nothing (FindConsumingTxs (fromList []))
+Binary: 0100040000000000000000
+Show: MsgQueryNext Nothing (FindTx "" False)
+Binary: 010003000000000000000000
+Show: MsgQueryNext Nothing (FindTx "" True)
+Binary: 010003000000000000000001
+Show: MsgQueryNext Nothing (FindTx "61" False)
+Binary: 01000300000000000000016100
+Show: MsgQueryNext Nothing (FindTxsFor (fromList (PaymentKeyCredential "" :| [PaymentKeyCredential "61"])))
+Binary: 010006000000000000000200000000000000000000000000000000000161
+Show: MsgQueryNext Nothing (FindTxsFor (fromList (PaymentKeyCredential "" :| [ScriptCredential ""])))
+Binary: 0100060000000000000002000000000000000000010000000000000000
+Show: MsgQueryNext Nothing (FindTxsFor (fromList (PaymentKeyCredential "" :| [ScriptCredential "61"])))
+Binary: 010006000000000000000200000000000000000001000000000000000161
+Show: MsgQueryNext Nothing (FindTxsFor (fromList (PaymentKeyCredential "" :| [])))
+Binary: 0100060000000000000001000000000000000000
+Show: MsgQueryNext Nothing (FindTxsFor (fromList (PaymentKeyCredential "61" :| [])))
+Binary: 010006000000000000000100000000000000000161
+Show: MsgQueryNext Nothing (FindTxsFor (fromList (ScriptCredential "" :| [])))
+Binary: 0100060000000000000001010000000000000000
+Show: MsgQueryNext Nothing (FindTxsFor (fromList (ScriptCredential "61" :| [])))
+Binary: 010006000000000000000101000000000000000161
+Show: MsgQueryNext Nothing (Intersect [BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}])
+Binary: 0100020000000000000001000000000000000100000000000000000000000000000001
+Show: MsgQueryNext Nothing (Intersect [BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "61", blockNo = BlockNo {unBlockNo = 1}}])
+Binary: 010002000000000000000100000000000000010000000000000001610000000000000001
+Show: MsgQueryNext Nothing (Intersect [])
+Binary: 0100020000000000000000
+Show: MsgQueryNext Nothing AdvanceToTip
+Binary: 010005
 Show: MsgRejectQuery (TxInPast (BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}})) Genesis
 Binary: 03030100000000000000010000000000000000000000000000000100
 Show: MsgRejectQuery (TxInPast (BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "61", blockNo = BlockNo {unBlockNo = 1}})) Genesis
@@ -656,39 +656,39 @@ Show: MsgRollForward (fromList []) Genesis Genesis
 Binary: 040400000000000000000000
 Show: MsgRollForward (fromList []) Genesis Genesis
 Binary: 040600000000000000000000
-Show: MsgScan (AdvanceBlocks 1)
-Binary: 0901000000000000000001
-Show: MsgScan (FindConsumingTxs (fromList [TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}]))
-Binary: 0904000000000000000100000000000000000001
-Show: MsgScan (FindConsumingTxs (fromList [TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}}]))
-Binary: 090400000000000000010000000000000001610001
-Show: MsgScan (FindConsumingTxs (fromList []))
-Binary: 09040000000000000000
-Show: MsgScan (FindTx "" False)
-Binary: 0903000000000000000000
-Show: MsgScan (FindTx "" True)
-Binary: 0903000000000000000001
-Show: MsgScan (FindTx "61" False)
-Binary: 090300000000000000016100
-Show: MsgScan (FindTxsFor (fromList (PaymentKeyCredential "" :| [PaymentKeyCredential "61"])))
-Binary: 0906000000000000000200000000000000000000000000000000000161
-Show: MsgScan (FindTxsFor (fromList (PaymentKeyCredential "" :| [ScriptCredential ""])))
-Binary: 09060000000000000002000000000000000000010000000000000000
-Show: MsgScan (FindTxsFor (fromList (PaymentKeyCredential "" :| [ScriptCredential "61"])))
-Binary: 0906000000000000000200000000000000000001000000000000000161
-Show: MsgScan (FindTxsFor (fromList (PaymentKeyCredential "" :| [])))
-Binary: 09060000000000000001000000000000000000
-Show: MsgScan (FindTxsFor (fromList (PaymentKeyCredential "61" :| [])))
-Binary: 0906000000000000000100000000000000000161
-Show: MsgScan (FindTxsFor (fromList (ScriptCredential "" :| [])))
-Binary: 09060000000000000001010000000000000000
-Show: MsgScan (FindTxsFor (fromList (ScriptCredential "61" :| [])))
-Binary: 0906000000000000000101000000000000000161
-Show: MsgScan (Intersect [BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}])
-Binary: 09020000000000000001000000000000000100000000000000000000000000000001
-Show: MsgScan (Intersect [BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "61", blockNo = BlockNo {unBlockNo = 1}}])
-Binary: 0902000000000000000100000000000000010000000000000001610000000000000001
-Show: MsgScan (Intersect [])
-Binary: 09020000000000000000
-Show: MsgScan AdvanceToTip
-Binary: 0905
+Show: MsgScan Nothing (AdvanceBlocks 1)
+Binary: 090001000000000000000001
+Show: MsgScan Nothing (FindConsumingTxs (fromList [TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}]))
+Binary: 090004000000000000000100000000000000000001
+Show: MsgScan Nothing (FindConsumingTxs (fromList [TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}}]))
+Binary: 09000400000000000000010000000000000001610001
+Show: MsgScan Nothing (FindConsumingTxs (fromList []))
+Binary: 0900040000000000000000
+Show: MsgScan Nothing (FindTx "" False)
+Binary: 090003000000000000000000
+Show: MsgScan Nothing (FindTx "" True)
+Binary: 090003000000000000000001
+Show: MsgScan Nothing (FindTx "61" False)
+Binary: 09000300000000000000016100
+Show: MsgScan Nothing (FindTxsFor (fromList (PaymentKeyCredential "" :| [PaymentKeyCredential "61"])))
+Binary: 090006000000000000000200000000000000000000000000000000000161
+Show: MsgScan Nothing (FindTxsFor (fromList (PaymentKeyCredential "" :| [ScriptCredential ""])))
+Binary: 0900060000000000000002000000000000000000010000000000000000
+Show: MsgScan Nothing (FindTxsFor (fromList (PaymentKeyCredential "" :| [ScriptCredential "61"])))
+Binary: 090006000000000000000200000000000000000001000000000000000161
+Show: MsgScan Nothing (FindTxsFor (fromList (PaymentKeyCredential "" :| [])))
+Binary: 0900060000000000000001000000000000000000
+Show: MsgScan Nothing (FindTxsFor (fromList (PaymentKeyCredential "61" :| [])))
+Binary: 090006000000000000000100000000000000000161
+Show: MsgScan Nothing (FindTxsFor (fromList (ScriptCredential "" :| [])))
+Binary: 0900060000000000000001010000000000000000
+Show: MsgScan Nothing (FindTxsFor (fromList (ScriptCredential "61" :| [])))
+Binary: 090006000000000000000101000000000000000161
+Show: MsgScan Nothing (Intersect [BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "", blockNo = BlockNo {unBlockNo = 1}}])
+Binary: 0900020000000000000001000000000000000100000000000000000000000000000001
+Show: MsgScan Nothing (Intersect [BlockHeader {slotNo = SlotNo {unSlotNo = 1}, headerHash = "61", blockNo = BlockNo {unBlockNo = 1}}])
+Binary: 090002000000000000000100000000000000010000000000000001610000000000000001
+Show: MsgScan Nothing (Intersect [])
+Binary: 0900020000000000000000
+Show: MsgScan Nothing AdvanceToTip
+Binary: 090005
diff --git a/marlowe-chain-sync/.golden/ChainSeekQuery/golden b/marlowe-chain-sync/.golden/ChainSeekQuery/golden
@@ -1,35 +1,35 @@
-Show: MsgDone
-Binary: 00
-Show: MsgRequest (ReqBin (ReqLeaf GetSecurityParameter) (ReqLeaf GetSecurityParameter))
-Binary: 010100010001
-Show: MsgRequest (ReqLeaf (GetUTxOs (GetUTxOsAtAddresses (fromList [""]))))
-Binary: 0100060100000000000000010000000000000000
-Show: MsgRequest (ReqLeaf (GetUTxOs (GetUTxOsAtAddresses (fromList ["61"]))))
-Binary: 010006010000000000000001000000000000000161
-Show: MsgRequest (ReqLeaf (GetUTxOs (GetUTxOsAtAddresses (fromList []))))
-Binary: 010006010000000000000000
-Show: MsgRequest (ReqLeaf (GetUTxOs (GetUTxOsForTxOutRefs (fromList [TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}]))))
-Binary: 01000602000000000000000100000000000000000001
-Show: MsgRequest (ReqLeaf (GetUTxOs (GetUTxOsForTxOutRefs (fromList [TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}}]))))
-Binary: 0100060200000000000000010000000000000001610001
-Show: MsgRequest (ReqLeaf (GetUTxOs (GetUTxOsForTxOutRefs (fromList []))))
-Binary: 010006020000000000000000
-Show: MsgRequest (ReqLeaf GetEra)
-Binary: 010009
-Show: MsgRequest (ReqLeaf GetEraHistory)
-Binary: 010005
-Show: MsgRequest (ReqLeaf GetNetworkId)
-Binary: 010002
-Show: MsgRequest (ReqLeaf GetNodeTip)
-Binary: 010007
-Show: MsgRequest (ReqLeaf GetProtocolParameters)
-Binary: 010003
-Show: MsgRequest (ReqLeaf GetSecurityParameter)
-Binary: 010001
-Show: MsgRequest (ReqLeaf GetSystemStart)
-Binary: 010004
-Show: MsgRequest (ReqLeaf GetTip)
-Binary: 010008
+Show: MsgDone Nothing
+Binary: 0000
+Show: MsgRequest Nothing (ReqBin (ReqLeaf GetSecurityParameter) (ReqLeaf GetSecurityParameter))
+Binary: 01000100010001
+Show: MsgRequest Nothing (ReqLeaf (GetUTxOs (GetUTxOsAtAddresses (fromList [""]))))
+Binary: 010000060100000000000000010000000000000000
+Show: MsgRequest Nothing (ReqLeaf (GetUTxOs (GetUTxOsAtAddresses (fromList ["61"]))))
+Binary: 01000006010000000000000001000000000000000161
+Show: MsgRequest Nothing (ReqLeaf (GetUTxOs (GetUTxOsAtAddresses (fromList []))))
+Binary: 01000006010000000000000000
+Show: MsgRequest Nothing (ReqLeaf (GetUTxOs (GetUTxOsForTxOutRefs (fromList [TxOutRef {txId = "", txIx = TxIx {unTxIx = 1}}]))))
+Binary: 0100000602000000000000000100000000000000000001
+Show: MsgRequest Nothing (ReqLeaf (GetUTxOs (GetUTxOsForTxOutRefs (fromList [TxOutRef {txId = "61", txIx = TxIx {unTxIx = 1}}]))))
+Binary: 010000060200000000000000010000000000000001610001
+Show: MsgRequest Nothing (ReqLeaf (GetUTxOs (GetUTxOsForTxOutRefs (fromList []))))
+Binary: 01000006020000000000000000
+Show: MsgRequest Nothing (ReqLeaf GetEra)
+Binary: 01000009
+Show: MsgRequest Nothing (ReqLeaf GetEraHistory)
+Binary: 01000005
+Show: MsgRequest Nothing (ReqLeaf GetNetworkId)
+Binary: 01000002
+Show: MsgRequest Nothing (ReqLeaf GetNodeTip)
+Binary: 01000007
+Show: MsgRequest Nothing (ReqLeaf GetProtocolParameters)
+Binary: 01000003
+Show: MsgRequest Nothing (ReqLeaf GetSecurityParameter)
+Binary: 01000001
+Show: MsgRequest Nothing (ReqLeaf GetSystemStart)
+Binary: 01000004
+Show: MsgRequest Nothing (ReqLeaf GetTip)
+Binary: 01000008
 Show: MsgRespond (1, 1)
 Binary: 00000000000000010000000000000001
 Show: MsgRespond (AnyCardanoEra AllegraEra)

diff --git a/marlowe-chain-sync/libchainsync/Language/Marlowe/Runtime/ChainSync.hs b/marlowe-chain-sync/libchainsync/Language/Marlowe/Runtime/ChainSync.hs
@@ -21,7 +21,7 @@ import Data.ByteString (ByteString)
 import Data.Maybe (catMaybes)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeUtf8)
-import Language.Marlowe.Runtime.ChainSync.Api (ChainPoint, ChainSyncCommand, ChainSyncQuery, RuntimeChainSeekServer)
+import Language.Marlowe.Runtime.ChainSync.Api
 import Language.Marlowe.Runtime.ChainSync.Database (DatabaseQueries (..))
 import Language.Marlowe.Runtime.ChainSync.Database.PostgreSQL (QuerySelector)
 import qualified Language.Marlowe.Runtime.ChainSync.Database.PostgreSQL as DB

diff --git a/marlowe-chain-sync/libchainsync/Language/Marlowe/Runtime/ChainSync/Server.hs b/marlowe-chain-sync/libchainsync/Language/Marlowe/Runtime/ChainSync/Server.hs
@@ -14,7 +14,7 @@ import Language.Marlowe.Runtime.ChainSync.Database (
   MoveResult (..),
   Scan (..),
  )
-import Network.Protocol.ChainSeek.Server
+import Network.Protocol.ChainSeek.Server hiding (Wait)
 import Network.Protocol.Connection (ServerSource (..))
 import Numeric.Natural (Natural)
 import UnliftIO (MonadUnliftIO)

diff --git a/marlowe-chain-sync/marlowe-chain-sync.cabal b/marlowe-chain-sync/marlowe-chain-sync.cabal
@@ -69,7 +69,9 @@ library
     , cardano-api ^>=8.2
     , cardano-ledger-core ^>=1.2
     , containers ^>=0.6.5
+    , eventuo11y-otel ^>=0.1
     , hashable >=1.3 && <2
+    , hs-opentelemetry-api ==0.0.3.6
     , marlowe-protocols ==0.2.1.0
     , nonempty-containers ^>=0.3.4
     , ouroboros-consensus ^>=0.7

diff --git a/marlowe-chain-sync/marlowe-chain-sync/Logging.hs b/marlowe-chain-sync/marlowe-chain-sync/Logging.hs
@@ -12,18 +12,25 @@ module Logging (
 import Control.Monad.Event.Class (Inject (..))
 import Data.ByteString (ByteString)
 import Language.Marlowe.Runtime.ChainSync (renderDatabaseSelectorOTel, renderNodeServiceSelectorOTel)
-import Language.Marlowe.Runtime.ChainSync.Api (ChainSyncCommand, ChainSyncQuery)
+import Language.Marlowe.Runtime.ChainSync.Api (
+  ChainSyncCommand,
+  ChainSyncQueryServerSelector,
+  RuntimeChainSeekServerSelector,
+  renderChainSeekServerSelectorOTel,
+  renderChainSyncQueryServerSelector,
+ )
 import qualified Language.Marlowe.Runtime.ChainSync.Database.PostgreSQL as DB
 import Language.Marlowe.Runtime.ChainSync.NodeClient (NodeClientSelector (..))
 import Network.Protocol.Driver.Trace (TcpServerSelector, renderTcpServerSelectorOTel)
 import Network.Protocol.Handshake.Types (Handshake)
 import Network.Protocol.Job.Types (Job)
-import Network.Protocol.Query.Types (Query)
+import qualified Network.Protocol.Peer.Monad.TCP as PeerT
 import Observe.Event (idInjectSelector, injectSelector)
 import Observe.Event.Render.OpenTelemetry
 
 data RootSelector f where
-  QueryServer :: TcpServerSelector (Handshake (Query ChainSyncQuery)) f -> RootSelector f
+  ChainSeekServer :: PeerT.TcpServerSelector RuntimeChainSeekServerSelector f -> RootSelector f
+  QueryServer :: PeerT.TcpServerSelector ChainSyncQueryServerSelector f -> RootSelector f
   JobServer :: TcpServerSelector (Handshake (Job ChainSyncCommand)) f -> RootSelector f
   Database :: DB.QuerySelector f -> RootSelector f
   NodeService :: NodeClientSelector f -> RootSelector f
@@ -44,7 +51,8 @@ renderRootSelectorOTel
   -> Maybe ByteString
   -> RenderSelectorOTel RootSelector
 renderRootSelectorOTel dbName dbUser host port = \case
-  QueryServer sel -> renderTcpServerSelectorOTel sel
+  ChainSeekServer sel -> PeerT.renderTcpServerSelectorOTel renderChainSeekServerSelectorOTel sel
+  QueryServer sel -> PeerT.renderTcpServerSelectorOTel renderChainSyncQueryServerSelector sel
   JobServer sel -> renderTcpServerSelectorOTel sel
   Database sel -> renderDatabaseSelectorOTel dbName dbUser host port sel
   NodeService sel -> renderNodeServiceSelectorOTel sel
diff --git a/marlowe-chain-sync/marlowe-chain-sync/Main.hs b/marlowe-chain-sync/marlowe-chain-sync/Main.hs
@@ -33,14 +33,19 @@ import qualified Database.PostgreSQL.LibPQ as PQ
 import Hasql.Connection (withLibPQConnection)
 import qualified Hasql.Pool as Pool
 import Language.Marlowe.Runtime.ChainSync (ChainSync (..), ChainSyncDependencies (..), chainSync)
+import Language.Marlowe.Runtime.ChainSync.Api (WithGenesis (..))
 import qualified Language.Marlowe.Runtime.ChainSync.Database.PostgreSQL as PostgreSQL
 import Language.Marlowe.Runtime.ChainSync.NodeClient (NodeClient (..), NodeClientDependencies (..), nodeClient)
 import Logging (RootSelector (..), renderRootSelectorOTel)
 import Network.Protocol.ChainSeek.Server (chainSeekServerPeer)
-import Network.Protocol.Driver (TcpServerDependencies (..), tcpServer)
+import qualified Network.Protocol.ChainSeek.Types as ChainSeek
+import Network.Protocol.Connection (ServerSource (..), ServerSourceTraced (ServerSourceTraced))
+import Network.Protocol.Driver (TcpServerDependencies (..))
 import Network.Protocol.Driver.Trace (tcpServerTraced)
 import Network.Protocol.Job.Server (jobServerPeer)
-import Network.Protocol.Query.Server (queryServerPeer)
+import Network.Protocol.Peer.Monad.TCP (TcpServerPeerTDependencies (..), tcpServerPeerT)
+import Network.Protocol.Query.Server (queryServerPeerT)
+import qualified Network.Protocol.Query.Types as Query
 import Observe.Event.Explicit (injectSelector)
 import OpenTelemetry.Trace
 import Options (Options (..), getOptions)
@@ -96,22 +101,26 @@ run Options{..} = bracket (Pool.acquire 100 (Just 5000000) (fromString databaseU
               , scanBatchSize = 8192 -- TODO make this a command line option
               }
 
-      tcpServer "chain-seek"
+      tcpServerPeerT "chain-seek" $ injectSelector ChainSeekServer
         -<
-          TcpServerDependencies
+          TcpServerPeerTDependencies
             { host
             , port
-            , toPeer = chainSeekServerPeer
-            , serverSource = syncServerSource
+            , nobodyHasAgency = ChainSeek.TokDone
+            , serverSource = ServerSourceTraced \inj -> do
+                server <- getServer syncServerSource
+                pure $ chainSeekServerPeer Genesis inj server
             }
 
-      tcpServerTraced "chain-query" $ injectSelector QueryServer
+      tcpServerPeerT "query" $ injectSelector QueryServer
         -<
-          TcpServerDependencies
+          TcpServerPeerTDependencies
             { host
             , port = queryPort
-            , toPeer = queryServerPeer
-            , serverSource = queryServerSource
+            , nobodyHasAgency = Query.TokDone
+            , serverSource = ServerSourceTraced \inj -> do
+                server <- getServer queryServerSource
+                pure $ queryServerPeerT inj server
             }
 
       tcpServerTraced "chain-job" $ injectSelector JobServer