push the serialized script registry to the edge with the client observer

hydra-chain-observer/exe/Main.hs

@@ -1,8 +1,10 @@
 module Main where
 
+import Hydra.Prelude
+
 import Hydra.ChainObserver qualified
 import Hydra.ChainObserver.NodeClient (defaultObserverHandler)
-import Hydra.Prelude
+import Hydra.Tx.ScriptRegistry (serialisedScriptRegistry)
 
 main :: IO ()
-main = Hydra.ChainObserver.main defaultObserverHandler
+main = Hydra.ChainObserver.main serialisedScriptRegistry defaultObserverHandler

hydra-chain-observer/hydra-chain-observer.cabal

@@ -91,6 +91,7 @@ executable hydra-chain-observer
   build-depends:
     , hydra-chain-observer
     , hydra-prelude
+    , hydra-tx
 
 test-suite tests
   import:             project-config
@@ -105,6 +106,7 @@ test-suite tests
     , hydra-node
     , hydra-prelude
     , hydra-test-utils
+    , hydra-tx
     , hydra-tx:testlib
     , QuickCheck
 

hydra-chain-observer/src/Hydra/Blockfrost/ChainObserver.hs

@@ -41,7 +41,7 @@ import Hydra.ChainObserver.NodeClient (
   observeAll,
  )
 import Hydra.Logging (Tracer, traceWith)
-import Hydra.Tx (IsTx (..))
+import Hydra.Tx (IsTx (..), SerialisedScriptRegistry)
 
 data APIBlockfrostError
   = BlockfrostError Text
@@ -66,8 +66,9 @@ blockfrostClient ::
   Tracer IO ChainObserverLog ->
   FilePath ->
   Integer ->
+  SerialisedScriptRegistry ->
   NodeClient IO
-blockfrostClient tracer projectPath blockConfirmations = do
+blockfrostClient tracer projectPath blockConfirmations serialisedScriptRegistry = do
   NodeClient
     { follow = \startChainFrom observerHandler -> do
         prj <- Blockfrost.projectFromFile projectPath
@@ -100,7 +101,7 @@ blockfrostClient tracer projectPath blockConfirmations = do
         stateTVar <- newTVarIO (blockHash, mempty)
         void $
           retrying (retryPolicy blockTime) shouldRetry $ \_ -> do
-            loop tracer prj networkId blockTime observerHandler blockConfirmations stateTVar
+            loop tracer prj networkId blockTime serialisedScriptRegistry observerHandler blockConfirmations stateTVar
               `catch` \(ex :: APIBlockfrostError) ->
                 pure $ Left ex
     }
@@ -121,15 +122,16 @@ loop ::
   Blockfrost.Project ->
   NetworkId ->
   DiffTime ->
+  SerialisedScriptRegistry ->
   ObserverHandler m ->
   Integer ->
   TVar m (Blockfrost.BlockHash, UTxO) ->
   m a
-loop tracer prj networkId blockTime observerHandler blockConfirmations stateTVar = do
+loop tracer prj networkId blockTime serialisedScriptRegistry observerHandler blockConfirmations stateTVar = do
   current <- readTVarIO stateTVar
-  next <- rollForward tracer prj networkId observerHandler blockConfirmations current
+  next <- rollForward tracer prj networkId serialisedScriptRegistry observerHandler blockConfirmations current
   atomically $ writeTVar stateTVar next
-  loop tracer prj networkId blockTime observerHandler blockConfirmations stateTVar
+  loop tracer prj networkId blockTime serialisedScriptRegistry observerHandler blockConfirmations stateTVar
 
 -- | From the current block and UTxO view, we collect Hydra observations
 -- and yield the next block and adjusted UTxO view.
@@ -138,11 +140,12 @@ rollForward ::
   Tracer m ChainObserverLog ->
   Blockfrost.Project ->
   NetworkId ->
+  SerialisedScriptRegistry ->
   ObserverHandler m ->
   Integer ->
   (Blockfrost.BlockHash, UTxO) ->
   m (Blockfrost.BlockHash, UTxO)
-rollForward tracer prj networkId observerHandler blockConfirmations (blockHash, utxo) = do
+rollForward tracer prj networkId serialisedScriptRegistry observerHandler blockConfirmations (blockHash, utxo) = do
   block@Blockfrost.Block
     { _blockHash
     , _blockConfirmations
@@ -172,7 +175,7 @@ rollForward tracer prj networkId observerHandler blockConfirmations (blockHash,
   traceWith tracer RollForward{point, receivedTxIds}
 
   -- Collect head observations
-  let (adjustedUTxO, observations) = observeAll networkId utxo receivedTxs
+  let (adjustedUTxO, observations) = observeAll networkId serialisedScriptRegistry utxo receivedTxs
   let onChainTxs = mapMaybe convertObservation observations
   forM_ onChainTxs (traceWith tracer . logOnChainTx)
 

hydra-chain-observer/src/Hydra/ChainObserver.hs

@@ -10,19 +10,20 @@ import Hydra.ChainObserver.Options (BlockfrostOptions (..), DirectOptions (..),
 import Hydra.Contract qualified as Contract
 import Hydra.Logging (Verbosity (..), traceWith, withTracer)
 import Hydra.Ouroborus.ChainObserver (ouroborusClient)
+import Hydra.Tx.ScriptRegistry (SerialisedScriptRegistry)
 import Options.Applicative (execParser)
 
-main :: ObserverHandler IO -> IO ()
-main observerHandler = do
+main :: SerialisedScriptRegistry -> ObserverHandler IO -> IO ()
+main serialisedScriptRegistry observerHandler = do
   opts <- execParser hydraChainObserverOptions
   withTracer (Verbose "hydra-chain-observer") $ \tracer -> do
     traceWith tracer KnownScripts{scriptInfo = Contract.scriptInfo}
     case opts of
       DirectOpts DirectOptions{networkId, nodeSocket, startChainFrom} -> do
-        let NodeClient{follow} = ouroborusClient tracer nodeSocket networkId
+        let NodeClient{follow} = ouroborusClient tracer nodeSocket networkId serialisedScriptRegistry
         follow startChainFrom observerHandler
       BlockfrostOpts BlockfrostOptions{projectPath, startChainFrom} -> do
         -- FIXME: should be configurable
         let blockConfirmations = 1
-            NodeClient{follow} = blockfrostClient tracer projectPath blockConfirmations
+            NodeClient{follow} = blockfrostClient tracer projectPath blockConfirmations serialisedScriptRegistry
         follow startChainFrom observerHandler

hydra-chain-observer/src/Hydra/ChainObserver/NodeClient.hs

@@ -21,7 +21,7 @@ import Hydra.Chain.Direct.Tx (
 import Hydra.Contract (ScriptInfo)
 import Hydra.Ledger.Cardano (adjustUTxO)
 import Hydra.Tx.HeadId (HeadId (..))
-import Hydra.Tx.ScriptRegistry (serialisedScriptRegistry)
+import Hydra.Tx.ScriptRegistry (SerialisedScriptRegistry)
 
 type ObserverHandler m = [ChainObservation] -> m ()
 
@@ -83,19 +83,19 @@ logOnChainTx = \case
   OnAbortTx{headId} -> HeadAbortTx{headId}
   OnContestTx{headId} -> HeadContestTx{headId}
 
-observeTx :: NetworkId -> UTxO -> Tx -> (UTxO, Maybe HeadObservation)
-observeTx networkId utxo tx =
+observeTx :: NetworkId -> SerialisedScriptRegistry -> UTxO -> Tx -> (UTxO, Maybe HeadObservation)
+observeTx networkId serialisedScriptRegistry utxo tx =
   let utxo' = adjustUTxO tx utxo
    in case observeHeadTx networkId serialisedScriptRegistry utxo tx of
         NoHeadTx -> (utxo, Nothing)
         observation -> (utxo', pure observation)
 
-observeAll :: NetworkId -> UTxO -> [Tx] -> (UTxO, [HeadObservation])
-observeAll networkId utxo txs =
+observeAll :: NetworkId -> SerialisedScriptRegistry -> UTxO -> [Tx] -> (UTxO, [HeadObservation])
+observeAll networkId serialisedScriptRegistry utxo txs =
   second reverse $ foldr go (utxo, []) txs
  where
   go :: Tx -> (UTxO, [HeadObservation]) -> (UTxO, [HeadObservation])
   go tx (utxo'', observations) =
-    case observeTx networkId utxo'' tx of
+    case observeTx networkId serialisedScriptRegistry utxo'' tx of
       (utxo', Nothing) -> (utxo', observations)
       (utxo', Just observation) -> (utxo', observation : observations)

hydra-chain-observer/src/Hydra/Ouroborus/ChainObserver.hs

@@ -36,6 +36,7 @@ import Hydra.ChainObserver.NodeClient (
   observeAll,
  )
 import Hydra.Logging (Tracer, traceWith)
+import Hydra.Tx.ScriptRegistry (SerialisedScriptRegistry)
 import Ouroboros.Network.Protocol.ChainSync.Client (
   ChainSyncClient (..),
   ClientStIdle (..),
@@ -47,8 +48,9 @@ ouroborusClient ::
   Tracer IO ChainObserverLog ->
   SocketPath ->
   NetworkId ->
+  SerialisedScriptRegistry ->
   NodeClient IO
-ouroborusClient tracer nodeSocket networkId =
+ouroborusClient tracer nodeSocket networkId serialisedScriptRegistry =
   NodeClient
     { follow = \startChainFrom observerHandler -> do
         traceWith tracer ConnectingToNode{nodeSocket, networkId}
@@ -58,7 +60,7 @@ ouroborusClient tracer nodeSocket networkId =
         traceWith tracer StartObservingFrom{chainPoint}
         connectToLocalNode
           (connectInfo nodeSocket networkId)
-          (clientProtocols tracer networkId chainPoint observerHandler)
+          (clientProtocols tracer networkId chainPoint serialisedScriptRegistry observerHandler)
     }
 
 type BlockType :: Type
@@ -79,11 +81,12 @@ clientProtocols ::
   Tracer IO ChainObserverLog ->
   NetworkId ->
   ChainPoint ->
+  SerialisedScriptRegistry ->
   ObserverHandler IO ->
   LocalNodeClientProtocols BlockType ChainPoint ChainTip slot tx txid txerr query IO
-clientProtocols tracer networkId startingPoint observerHandler =
+clientProtocols tracer networkId startingPoint serialisedScriptRegistry observerHandler =
   LocalNodeClientProtocols
-    { localChainSyncClient = LocalChainSyncClient $ chainSyncClient tracer networkId startingPoint observerHandler
+    { localChainSyncClient = LocalChainSyncClient $ chainSyncClient tracer networkId startingPoint serialisedScriptRegistry observerHandler
     , localTxSubmissionClient = Nothing
     , localStateQueryClient = Nothing
     , localTxMonitoringClient = Nothing
@@ -107,9 +110,10 @@ chainSyncClient ::
   Tracer m ChainObserverLog ->
   NetworkId ->
   ChainPoint ->
+  SerialisedScriptRegistry ->
   ObserverHandler m ->
   ChainSyncClient BlockType ChainPoint ChainTip m ()
-chainSyncClient tracer networkId startingPoint observerHandler =
+chainSyncClient tracer networkId startingPoint serialisedScriptRegistry observerHandler =
   ChainSyncClient $
     pure $
       SendMsgFindIntersect [startingPoint] clientStIntersect
@@ -142,7 +146,7 @@ chainSyncClient tracer networkId startingPoint observerHandler =
                 BlockInMode ConwayEra (Block _ conwayTxs) -> conwayTxs
                 _ -> []
 
-              (utxo', observations) = observeAll networkId utxo txs
+              (utxo', observations) = observeAll networkId serialisedScriptRegistry utxo txs
               onChainTxs = mapMaybe convertObservation observations
 
           forM_ onChainTxs (traceWith tracer . logOnChainTx)

hydra-chain-observer/test/Hydra/ChainObserverSpec.hs

@@ -9,6 +9,7 @@ import Hydra.Chain.Direct.State qualified as Transition
 import Hydra.Chain.Direct.Tx (HeadObservation (..))
 import Hydra.ChainObserver.NodeClient (observeAll, observeTx)
 import Hydra.Ledger.Cardano (genSequenceOfSimplePaymentTransactions)
+import Hydra.Tx.ScriptRegistry (serialisedScriptRegistry)
 import Test.Hydra.Tx.Fixture (testNetworkId)
 import Test.QuickCheck (counterexample, forAll, forAllBlind, property, (=/=), (===))
 import Test.QuickCheck.Property (checkCoverage)
@@ -22,7 +23,7 @@ spec =
           genericCoverTable [transition] $
             counterexample (show transition) $
               let utxo = getKnownUTxO st <> utxoFromTx tx <> additionalUTxO
-               in case snd $ observeTx testNetworkId utxo tx of
+               in case snd $ observeTx testNetworkId serialisedScriptRegistry utxo tx of
                     Just (Init{}) -> transition === Transition.Init
                     Just (Commit{}) -> transition === Transition.Commit
                     Just (CollectCom{}) -> transition === Transition.Collect
@@ -37,8 +38,8 @@ spec =
     prop "Updates UTxO state given transaction part of Head lifecycle" $
       forAllBlind genChainStateWithTx $ \(_ctx, st, additionalUTxO, tx, _transition) ->
         let utxo = getKnownUTxO st <> additionalUTxO
-         in fst (observeTx testNetworkId utxo tx) =/= utxo
+         in fst (observeTx testNetworkId serialisedScriptRegistry utxo tx) =/= utxo
 
     prop "Does not updates UTxO state given transactions outside of Head lifecycle" $
       forAll genSequenceOfSimplePaymentTransactions $ \(utxo, txs) ->
-        fst (observeAll testNetworkId utxo txs) === utxo
+        fst (observeAll testNetworkId serialisedScriptRegistry utxo txs) === utxo