versioning hydra tx observations

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.SerialisedScriptRegistry (serialisedScriptRegistry)
 
 main :: IO ()
-main = Hydra.ChainObserver.main defaultObserverHandler
+main = Hydra.ChainObserver.main serialisedScriptRegistry defaultObserverHandler

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

@@ -90,6 +90,7 @@ executable hydra-chain-observer
   main-is:        Main.hs
   build-depends:
     , hydra-chain-observer
+    , hydra-plutus
     , hydra-prelude
 
 test-suite tests
@@ -103,6 +104,7 @@ test-suite tests
     , hydra-cardano-api
     , hydra-chain-observer
     , hydra-node
+    , hydra-plutus
     , hydra-prelude
     , hydra-test-utils
     , hydra-tx:testlib

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

@@ -41,6 +41,7 @@ import Hydra.ChainObserver.NodeClient (
   observeAll,
  )
 import Hydra.Logging (Tracer, traceWith)
+import Hydra.SerialisedScriptRegistry (SerialisedScriptRegistry)
 import Hydra.Tx (IsTx (..))
 
 data APIBlockfrostError
@@ -66,8 +67,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 +102,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 +123,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 +141,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
   [email protected]
     { _blockHash
     , _blockConfirmations
@@ -172,7 +176,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.SerialisedScriptRegistry (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}
+    traceWith tracer KnownScripts{scriptInfo = Contract.scriptInfo serialisedScriptRegistry}
     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

@@ -20,6 +20,7 @@ import Hydra.Chain.Direct.Tx (
  )
 import Hydra.Contract (ScriptInfo)
 import Hydra.Ledger.Cardano (adjustUTxO)
+import Hydra.SerialisedScriptRegistry (SerialisedScriptRegistry)
 import Hydra.Tx.HeadId (HeadId (..))
 
 type ObserverHandler m = [ChainObservation] -> m ()
@@ -79,19 +80,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 utxo tx of
+   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.SerialisedScriptRegistry (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.SerialisedScriptRegistry (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

hydra-node/bench/tx-cost/Main.hs

@@ -6,6 +6,7 @@ import Hydra.Cardano.Api (Coin (..), serialiseToRawBytesHexText)
 import Hydra.Contract (ScriptInfo (..), scriptInfo)
 import Hydra.Ledger.Cardano.Evaluate (maxCpu, maxMem, maxTxSize)
 import Hydra.Plutus.Orphans ()
+import Hydra.SerialisedScriptRegistry (serialisedScriptRegistry)
 import Options.Applicative (
   Parser,
   ParserInfo,
@@ -171,7 +172,7 @@ scriptSizes =
     , headScriptSize
     , depositScriptHash
     , depositScriptSize
-    } = scriptInfo
+    } = scriptInfo serialisedScriptRegistry
 
 genFromSeed :: Gen a -> Int -> a
 genFromSeed (MkGen g) seed = g (mkQCGen seed) 30

hydra-node/src/Hydra/Chain/Direct/Handlers.hs

@@ -80,6 +80,7 @@ import Hydra.Chain.Direct.Wallet (
 import Hydra.Ledger.Cardano (adjustUTxO, fromChainSlot)
 import Hydra.Logging (Tracer, traceWith)
 import Hydra.Plutus.Extras (posixToUTCTime)
+import Hydra.SerialisedScriptRegistry (serialisedScriptRegistry)
 import Hydra.Tx (
   CommitBlueprintTx (..),
   HeadParameters (..),
@@ -305,7 +306,7 @@ chainSyncHandler tracer callback getTimeHandle ctx localChainState =
 
   maybeObserveSomeTx point tx = atomically $ do
     ChainStateAt{spendableUTxO} <- getLatest
-    let observation = observeHeadTx networkId spendableUTxO tx
+    let observation = observeHeadTx networkId serialisedScriptRegistry spendableUTxO tx
     case convertObservation observation of
       Nothing -> pure Nothing
       Just observedTx -> do

hydra-node/src/Hydra/Chain/Direct/State.hs

@@ -85,6 +85,7 @@ import Hydra.Ledger.Cardano.Evaluate (genPointInTimeBefore, genValidityBoundsFro
 import Hydra.Ledger.Cardano.Time (slotNoFromUTCTime)
 import Hydra.Plutus (commitValidatorScript, depositValidatorScript, initialValidatorScript)
 import Hydra.Plutus.Extras (posixToUTCTime)
+import Hydra.SerialisedScriptRegistry (serialisedScriptRegistry)
 import Hydra.Tx (
   CommitBlueprintTx (..),
   ConfirmedSnapshot (..),
@@ -778,7 +779,7 @@ observeInit ::
   Tx ->
   Either NotAnInitReason (OnChainTx Tx, InitialState)
 observeInit _ctx _allVerificationKeys tx = do
-  observation <- observeInitTx tx
+  observation <- observeInitTx serialisedScriptRegistry tx
   pure (toEvent observation, toState observation)
  where
   toEvent InitObservation{contestationPeriod, parties, headId, seedTxIn, participants} =
@@ -813,7 +814,7 @@ observeCommit ::
   Maybe (OnChainTx Tx, InitialState)
 observeCommit ctx st tx = do
   let utxo = getKnownUTxO st
-  observation <- observeCommitTx networkId utxo tx
+  observation <- observeCommitTx networkId serialisedScriptRegistry utxo tx
   let CommitObservation{commitOutput, party, committed, headId = commitHeadId} = observation
   guard $ commitHeadId == headId
   let event = OnCommitTx{headId, party, committed}
@@ -844,7 +845,7 @@ observeCollect ::
   Maybe (OnChainTx Tx, OpenState)
 observeCollect st tx = do
   let utxo = getKnownUTxO st
-  observation <- observeCollectComTx utxo tx
+  observation <- observeCollectComTx serialisedScriptRegistry utxo tx
   let CollectComObservation{threadOutput = threadOutput, headId = collectComHeadId, utxoHash} = observation
   guard (headId == collectComHeadId)
   -- REVIEW: is it enough to pass here just the 'openThreadUTxO' or we need also
@@ -874,7 +875,7 @@ observeClose ::
   Maybe (OnChainTx Tx, ClosedState)
 observeClose st tx = do
   let utxo = getKnownUTxO st
-  observation <- observeCloseTx utxo tx
+  observation <- observeCloseTx serialisedScriptRegistry utxo tx
   let CloseObservation{threadOutput, headId = closeObservationHeadId, snapshotNumber} = observation
   guard (headId == closeObservationHeadId)
   let ClosedThreadOutput{closedContestationDeadline} = threadOutput
@@ -1155,7 +1156,7 @@ genRecoverTx ::
 genRecoverTx = do
   (_, _, depositedUTxO, txDeposit) <- genDepositTx maximumNumberOfParties
   let DepositObservation{deposited, deadline} =
-        fromJust $ observeDepositTx testNetworkId txDeposit
+        fromJust $ observeDepositTx testNetworkId serialisedScriptRegistry txDeposit
   let slotNo = slotNoFromUTCTime systemStart slotLength (posixToUTCTime deadline)
   slotNo' <- arbitrary
   let tx = recoverTx (getTxId $ getTxBody txDeposit) deposited (slotNo + slotNo')
@@ -1165,7 +1166,7 @@ genIncrementTx :: Int -> Gen (ChainContext, OpenState, UTxO, Tx)
 genIncrementTx numParties = do
   (ctx, st@OpenState{headId}, utxo, txDeposit) <- genDepositTx numParties
   cctx <- pickChainContext ctx
-  let DepositObservation{deposited, depositTxId, deadline} = fromJust $ observeDepositTx (ctxNetworkId ctx) txDeposit
+  let DepositObservation{deposited, depositTxId, deadline} = fromJust $ observeDepositTx (ctxNetworkId ctx) serialisedScriptRegistry txDeposit
   let openUTxO = getKnownUTxO st
   let version = 0
   snapshot <- genConfirmedSnapshot headId version 1 openUTxO (Just deposited) Nothing (ctxHydraSigningKeys ctx)