diff --git a/hydra-chain-observer/hydra-chain-observer.cabal b/hydra-chain-observer/hydra-chain-observer.cabal index 507f532a65f..f8703e7b8ad 100644 --- a/hydra-chain-observer/hydra-chain-observer.cabal +++ b/hydra-chain-observer/hydra-chain-observer.cabal @@ -105,6 +105,7 @@ test-suite tests , hydra-node , hydra-prelude , hydra-test-utils + , hydra-tx , hydra-tx:testlib , QuickCheck diff --git a/hydra-chain-observer/src/Hydra/Blockfrost/ChainObserver.hs b/hydra-chain-observer/src/Hydra/Blockfrost/ChainObserver.hs index 79894732dc7..f3b56d5c813 100644 --- a/hydra-chain-observer/src/Hydra/Blockfrost/ChainObserver.hs +++ b/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) diff --git a/hydra-chain-observer/src/Hydra/ChainObserver.hs b/hydra-chain-observer/src/Hydra/ChainObserver.hs index ac21e82750b..e9f8a3b50bf 100644 --- a/hydra-chain-observer/src/Hydra/ChainObserver.hs +++ b/hydra-chain-observer/src/Hydra/ChainObserver.hs @@ -10,6 +10,7 @@ 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 () @@ -19,10 +20,10 @@ main observerHandler = 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 diff --git a/hydra-chain-observer/src/Hydra/ChainObserver/NodeClient.hs b/hydra-chain-observer/src/Hydra/ChainObserver/NodeClient.hs index bf412d5fc50..2e799600f20 100644 --- a/hydra-chain-observer/src/Hydra/ChainObserver/NodeClient.hs +++ b/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) diff --git a/hydra-chain-observer/src/Hydra/Ouroborus/ChainObserver.hs b/hydra-chain-observer/src/Hydra/Ouroborus/ChainObserver.hs index 2953267ce87..0ac6af971e7 100644 --- a/hydra-chain-observer/src/Hydra/Ouroborus/ChainObserver.hs +++ b/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) diff --git a/hydra-chain-observer/test/Hydra/ChainObserverSpec.hs b/hydra-chain-observer/test/Hydra/ChainObserverSpec.hs index dcea24cabf5..dd7447e095e 100644 --- a/hydra-chain-observer/test/Hydra/ChainObserverSpec.hs +++ b/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