Draft roll forward and backward

Reusing logic from ouroborus client.
cardano-scaling · Sep 17, 2024 · 35e3d9a · 35e3d9a
1 parent e8a24e3
commit 35e3d9a
Show file tree

Hide file tree

Showing 4 changed files with 42 additions and 5 deletions.
diff --git a/hydra-chain-observer/src/Hydra/Blockfrost/ChainObserver.hs b/hydra-chain-observer/src/Hydra/Blockfrost/ChainObserver.hs
@@ -16,9 +16,11 @@ import Blockfrost.Client (
  )
 import Control.Retry (RetryPolicyM, exponentialBackoff, limitRetries)
 
-import Hydra.Cardano.Api (Hash, SlotNo)
+import Hydra.Cardano.Api (BlockNo, Hash, NetworkId, SlotNo, Tx, UTxO)
 import Hydra.Cardano.Api.Prelude (BlockHeader (..), ChainPoint (..))
-import Hydra.ChainObserver.NodeClient (ChainObserverLog (..), NodeClient (..))
+import Hydra.Chain.Direct.Handlers (convertObservation)
+import Hydra.ChainObserver.NodeClient (ChainObservation (..), ChainObserverLog (..), NodeClient (..), ObserverHandler, logOnChainTx, observeAll)
+import Hydra.Tx (txId)
 
 blockfrostClient ::
   Tracer IO ChainObserverLog ->
@@ -49,6 +51,41 @@ blockfrostClient tracer = do
           pure ()
     }
 
+-- TODO! DRY
+rollForward ::
+  Tracer IO ChainObserverLog ->
+  NetworkId ->
+  ChainPoint ->
+  BlockNo ->
+  UTxO ->
+  [Tx] ->
+  ObserverHandler IO ->
+  IO UTxO
+rollForward tracer networkId point blockNo currentUTxO receivedTxs observerHandler = do
+  let receivedTxIds = txId <$> receivedTxs
+  traceWith tracer RollForward{point, receivedTxIds}
+  let (adjustedUTxO, observations) = observeAll networkId currentUTxO receivedTxs
+  let onChainTxs = mapMaybe convertObservation observations
+  forM_ onChainTxs (traceWith tracer . logOnChainTx)
+  let observationsAt = HeadObservation point blockNo <$> onChainTxs
+  observerHandler $
+    if null observationsAt
+      then [Tick point blockNo]
+      else observationsAt
+  pure adjustedUTxO
+
+-- TODO! DRY
+rollBackward ::
+  Tracer IO ChainObserverLog ->
+  ChainPoint ->
+  b ->
+  IO b
+rollBackward tracer point currentUTxO = do
+  traceWith tracer Rollback{point}
+  pure currentUTxO
+
+-- * Helpers
+
 toChainPoint :: Block -> ChainPoint
 toChainPoint Block{_blockSlot, _blockHash} =
   ChainPoint slotNo headerHash

diff --git a/hydra-explorer/src/Hydra/Explorer.hs b/hydra-explorer/src/Hydra/Explorer.hs
@@ -5,7 +5,7 @@ import Hydra.Prelude
 
 import Control.Concurrent.Class.MonadSTM (modifyTVar', newTVarIO, readTVarIO)
 import Hydra.API.APIServerLog (APIServerLog (..), Method (..), PathInfo (..))
-import Hydra.ChainObserver (ChainObservation)
+import Hydra.ChainObserver.NodeClient (ChainObservation)
 import Hydra.Explorer.ExplorerState (ExplorerState (..), HeadState, TickState, aggregateHeadObservations, initialTickState)
 import Hydra.Explorer.Options (Options (..), toArgStartChainFrom)
 import Hydra.Logging (Tracer, Verbosity (..), traceWith, withTracer)

diff --git a/hydra-explorer/src/Hydra/Explorer/ExplorerState.hs b/hydra-explorer/src/Hydra/Explorer/ExplorerState.hs
@@ -10,7 +10,7 @@ import Hydra.Chain (OnChainTx (..))
 import Hydra.Chain.Direct.Tx (
   headSeedToTxIn,
  )
-import Hydra.ChainObserver (ChainObservation (..))
+import Hydra.ChainObserver.NodeClient (ChainObservation (..))
 import Hydra.Tx.ContestationPeriod (ContestationPeriod, toNominalDiffTime)
 import Hydra.Tx.HeadParameters (HeadParameters (..))
 import Hydra.Tx.OnChainId (OnChainId)

diff --git a/hydra-explorer/test/Hydra/Explorer/ExplorerStateSpec.hs b/hydra-explorer/test/Hydra/Explorer/ExplorerStateSpec.hs
@@ -3,7 +3,7 @@ module Hydra.Explorer.ExplorerStateSpec where
 import Hydra.Prelude
 import Test.Hydra.Prelude
 
-import Hydra.ChainObserver (ChainObservation (..))
+import Hydra.ChainObserver.NodeClient (ChainObservation (..))
 import Hydra.Explorer.ExplorerState (ExplorerState (..), HeadState (..), aggregateHeadObservations, initialTickState)
 import Hydra.Tx.HeadId (HeadId)
 import Test.QuickCheck (forAll, listOf1, (=/=))