draft e2e scenario for head getting stuck

ffakenz · ffakenz · commit 5c7993787707 · 2025-03-06T10:28:33.000+01:00
diff --git a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs
@@ -26,10 +26,10 @@ import CardanoClient (
  )
 import CardanoNode (NodeLog)
 import Control.Concurrent.Async (mapConcurrently_)
-import Control.Lens ((.~), (^.), (^..), (^?))
+import Control.Lens ((.~), (?~), (^.), (^..), (^?))
 import Data.Aeson (Value, object, (.=))
 import Data.Aeson qualified as Aeson
-import Data.Aeson.Lens (key, values, _JSON, _String)
+import Data.Aeson.Lens (atKey, key, values, _JSON, _String)
 import Data.Aeson.Types (parseMaybe)
 import Data.ByteString (isInfixOf)
 import Data.ByteString qualified as B
@@ -108,6 +108,7 @@ import HydraNode (
   input,
   output,
   postDecommit,
+  prepareHydraNode,
   requestCommitTx,
   send,
   waitFor,
@@ -116,6 +117,7 @@ import HydraNode (
   waitMatch,
   withHydraCluster,
   withHydraNode,
+  withPreparedHydraNode,
  )
 import Network.HTTP.Conduit (parseUrlThrow)
 import Network.HTTP.Conduit qualified as L
@@ -1316,6 +1318,84 @@ canDecommit tracer workDir node hydraScriptsTxId =
 
   RunningNode{networkId, nodeSocket, blockTime} = node
 
+-- | Can side load snapshot and resume agreement after a peer comes back online with healthy configuration
+canSideLoadSnapshot :: Tracer IO EndToEndLog -> FilePath -> RunningNode -> [TxId] -> IO ()
+canSideLoadSnapshot tracer workDir cardanoNode hydraScriptsTxId = do
+  let clients = [Alice, Bob, Carol]
+  [(aliceCardanoVk, aliceCardanoSk), (bobCardanoVk, _), (carolCardanoVk, _)] <- forM clients keysFor
+  seedFromFaucet_ cardanoNode aliceCardanoVk 100_000_000 (contramap FromFaucet tracer)
+  seedFromFaucet_ cardanoNode bobCardanoVk 100_000_000 (contramap FromFaucet tracer)
+  seedFromFaucet_ cardanoNode carolCardanoVk 100_000_000 (contramap FromFaucet tracer)
+
+  let contestationPeriod = UnsafeContestationPeriod 1
+  let depositDeadline = UnsafeDepositDeadline 200
+  aliceChainConfig <-
+    chainConfigFor Alice workDir nodeSocket hydraScriptsTxId [Bob, Carol] contestationPeriod depositDeadline
+      <&> setNetworkId networkId
+  bobChainConfig <-
+    chainConfigFor Bob workDir nodeSocket hydraScriptsTxId [Alice, Carol] contestationPeriod depositDeadline
+      <&> setNetworkId networkId
+  carolChainConfig <-
+    chainConfigFor Carol workDir nodeSocket hydraScriptsTxId [Alice, Bob] contestationPeriod depositDeadline
+      <&> setNetworkId networkId
+
+  withHydraNode hydraTracer aliceChainConfig workDir 1 aliceSk [bobVk, carolVk] [1, 2, 3] $ \n1 -> do
+    aliceUTxO <- seedFromFaucet cardanoNode aliceCardanoVk 1_000_000 (contramap FromFaucet tracer)
+    withHydraNode hydraTracer bobChainConfig workDir 2 bobSk [aliceVk, carolVk] [1, 2, 3] $ \n2 -> do
+      -- Carol starts its node missconfigured
+      let pparamsDecorator = atKey "maxTxSize" ?~ toJSON (Aeson.Number 0)
+      wrongOptions <- prepareHydraNode carolChainConfig workDir 3 carolSk [aliceVk, bobVk] [1, 2, 3] pparamsDecorator
+      withPreparedHydraNode hydraTracer workDir 3 wrongOptions $ \n3 -> do
+        -- Init
+        send n1 $ input "Init" []
+        headId <- waitForAllMatch (10 * blockTime) [n1, n2, n3] $ headIsInitializingWith (Set.fromList [alice, bob, carol])
+
+        -- Alice commits something
+        requestCommitTx n1 aliceUTxO >>= submitTx cardanoNode
+
+        -- Everyone else commits nothing
+        mapConcurrently_ (\n -> requestCommitTx n mempty >>= submitTx cardanoNode) [n2, n3]
+
+        -- Observe open with the relevant UTxOs
+        waitFor hydraTracer (20 * blockTime) [n1, n2, n3] $
+          output "HeadIsOpen" ["utxo" .= toJSON aliceUTxO, "headId" .= headId]
+
+        -- Alice submits a new transaction
+        utxo <- getSnapshotUTxO n1
+        tx <- mkTransferTx testNetworkId utxo aliceCardanoSk aliceCardanoVk
+        send n1 $ input "NewTx" ["transaction" .= tx]
+
+        -- Alice and Bob accept it
+        waitForAllMatch (200 * blockTime) [n1, n2] $ \v -> do
+          guard $ v ^? key "tag" == Just "TxValid"
+          guard $ v ^? key "transactionId" == Just (toJSON $ txId tx)
+
+        -- Carol does not because of its node being missconfigured
+        waitMatch 3 n3 $ \v -> do
+          guard $ v ^? key "tag" == Just "TxInvalid"
+          guard $ v ^? key "transaction" . key "txId" == Just (toJSON $ txId tx)
+
+      -- Carol disconnects and the others observe it
+      waitForAllMatch (100 * blockTime) [n1, n2] $ \v -> do
+        guard $ v ^? key "tag" == Just "PeerDisconnected"
+
+      -- Carol reconnects with reconfigured node
+      withHydraNode hydraTracer carolChainConfig workDir 3 carolSk [aliceVk, bobVk] [1, 2, 3] $ \n3 -> do
+        -- Everyone confirms it
+        -- Note: We can't use `waitForAlMatch` here as it expects them to
+        -- emit the exact same datatype; but Carol will be behind in sequence
+        -- numbers as she was offline.
+        flip mapConcurrently_ [n1, n2, n3] $ \n ->
+          waitMatch (200 * blockTime) n $ \v -> do
+            guard $ v ^? key "tag" == Just "SnapshotConfirmed"
+            guard $ v ^? key "snapshot" . key "number" == Just (toJSON (2 :: Integer))
+            -- Just check that everyone signed it.
+            let sigs = v ^.. key "signatures" . key "multiSignature" . values
+            guard $ length sigs == 3
+ where
+  RunningNode{nodeSocket, networkId, blockTime} = cardanoNode
+  hydraTracer = contramap FromHydraNode tracer
+
 -- * L2 scenarios
 
 -- | Finds UTxO owned by given key in the head and creates transactions
diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs
@@ -302,6 +302,131 @@ withHydraCluster tracer workDir nodeSocket firstNodeId allKeys hydraKeys hydraSc
 
 -- * Start / connect to a hydra-node
 
+-- | Prepare protocol-parameters to run a hydra-node with given 'ChainConfig' and using the config from
+-- config/.
+preparePParams ::
+  ChainConfig ->
+  FilePath ->
+  (Aeson.Value -> Aeson.Value) ->
+  IO FilePath
+preparePParams chainConfig stateDir paramsDecorator = do
+  let cardanoLedgerProtocolParametersFile = stateDir </> "protocol-parameters.json"
+  case chainConfig of
+    Offline _ ->
+      readConfigFile "protocol-parameters.json"
+        >>= writeFileBS cardanoLedgerProtocolParametersFile
+    Direct DirectChainConfig{nodeSocket, networkId} -> do
+      -- NOTE: This implicitly tests of cardano-cli with hydra-node
+      protocolParameters <- cliQueryProtocolParameters nodeSocket networkId
+      Aeson.encodeFile cardanoLedgerProtocolParametersFile $
+        paramsDecorator protocolParameters
+          & atKey "txFeeFixed" ?~ toJSON (Number 0)
+          & atKey "txFeePerByte" ?~ toJSON (Number 0)
+          & key "executionUnitPrices" . atKey "priceMemory" ?~ toJSON (Number 0)
+          & key "executionUnitPrices" . atKey "priceSteps" ?~ toJSON (Number 0)
+          & atKey "utxoCostPerByte" ?~ toJSON (Number 0)
+          & atKey "treasuryCut" ?~ toJSON (Number 0)
+          & atKey "minFeeRefScriptCostPerByte" ?~ toJSON (Number 0)
+  pure cardanoLedgerProtocolParametersFile
+
+-- | Prepare 'RunOptions' to run a hydra-node with given 'ChainConfig' and using the config from
+-- config/.
+prepareHydraNode ::
+  HasCallStack =>
+  ChainConfig ->
+  FilePath ->
+  Int ->
+  SigningKey HydraKey ->
+  [VerificationKey HydraKey] ->
+  [Int] ->
+  (Aeson.Value -> Aeson.Value) ->
+  IO RunOptions
+prepareHydraNode chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds paramsDecorator = do
+  -- NOTE: AirPlay on MacOS uses 5000 and we must avoid it.
+  when (os == "darwin") $ port `shouldNotBe` (5_000 :: Network.PortNumber)
+  let stateDir = workDir </> "state-" <> show hydraNodeId
+  createDirectoryIfMissing True stateDir
+  cardanoLedgerProtocolParametersFile <- preparePParams chainConfig stateDir paramsDecorator
+  let hydraSigningKey = stateDir </> "me.sk"
+  void $ writeFileTextEnvelope (File hydraSigningKey) Nothing hydraSKey
+  hydraVerificationKeys <- forM (zip [1 ..] hydraVKeys) $ \(i :: Int, vKey) -> do
+    let filepath = stateDir </> ("other-" <> show i <> ".vk")
+    filepath <$ writeFileTextEnvelope (File filepath) Nothing vKey
+  pure $
+    RunOptions
+      { verbosity = Verbose "HydraNode"
+      , nodeId = NodeId $ show hydraNodeId
+      , listen = Host "0.0.0.0" (fromIntegral $ 5_000 + hydraNodeId)
+      , advertise = Nothing
+      , peers
+      , apiHost = "0.0.0.0"
+      , apiPort = fromIntegral $ 4_000 + hydraNodeId
+      , tlsCertPath = Nothing
+      , tlsKeyPath = Nothing
+      , monitoringPort = Just $ fromIntegral $ 6_000 + hydraNodeId
+      , hydraSigningKey
+      , hydraVerificationKeys
+      , persistenceDir = stateDir
+      , chainConfig
+      , ledgerConfig =
+          CardanoLedgerConfig
+            { cardanoLedgerProtocolParametersFile
+            }
+      }
+ where
+  port = fromIntegral $ 5_000 + hydraNodeId
+  -- NOTE: See comment above about 0.0.0.0 vs 127.0.0.1
+  peers =
+    [ Host
+        { Network.hostname = "0.0.0.0"
+        , Network.port = fromIntegral $ 5_000 + i
+        }
+    | i <- allNodeIds
+    , i /= hydraNodeId
+    ]
+
+-- | Run a hydra-node with given 'RunOptions'.
+withPreparedHydraNode ::
+  HasCallStack =>
+  Tracer IO HydraNodeLog ->
+  FilePath ->
+  Int ->
+  RunOptions ->
+  (HydraClient -> IO a) ->
+  IO a
+withPreparedHydraNode tracer workDir hydraNodeId runOptions action =
+  withLogFile logFilePath $ \logFileHandle -> do
+    -- XXX: using a dedicated pipe as 'createPipe' from typed-process closes too early
+    (readErr, writeErr) <- P.createPipe
+    let cmd =
+          (proc "hydra-node" . toArgs $ runOptions)
+            & setStdout (useHandleOpen logFileHandle)
+            & setStderr (useHandleOpen writeErr)
+
+    traceWith tracer $ HydraNodeCommandSpec $ show cmd
+
+    withProcessTerm cmd $ \p -> do
+      hClose writeErr
+      -- NOTE: exit code thread gets cancelled if 'action' terminates first
+      race
+        (collectAndCheckExitCode p readErr)
+        (withConnectionToNode tracer hydraNodeId action)
+        <&> either absurd id
+ where
+  collectAndCheckExitCode p h =
+    (`finally` hClose h) $
+      waitExitCode p >>= \case
+        ExitSuccess -> failure "hydra-node stopped early"
+        ExitFailure ec -> do
+          err <- hGetContents h
+          failure . toString $
+            unlines
+              [ "hydra-node (nodeId = " <> show hydraNodeId <> ") exited with failure code: " <> show ec
+              , decodeUtf8 err
+              ]
+
+  logFilePath = workDir </> "logs" </> "hydra-node-" <> show hydraNodeId <.> "log"
+
 -- | Run a hydra-node with given 'ChainConfig' and using the config from
 -- config/.
 withHydraNode ::
diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs
@@ -55,6 +55,7 @@ import Hydra.Cluster.Scenarios (
   canDecommit,
   canRecoverDeposit,
   canSeePendingDeposits,
+  canSideLoadSnapshot,
   canSubmitTransactionThroughAPI,
   headIsInitializingWith,
   initWithWrongKeys,
@@ -466,6 +467,12 @@ spec = around (showLogsOnFailure "EndToEndSpec") $ do
                     guard $ v ^? key "tag" == Just "HeadIsContested"
                     guard $ v ^? key "headId" == Just (toJSON headId)
 
+      fit "can side load snapshot" $ \tracer -> do
+        withClusterTempDir $ \tmpDir -> do
+          withCardanoNodeDevnet (contramap FromCardanoNode tracer) tmpDir $ \node ->
+            publishHydraScriptsAs node Faucet
+              >>= canSideLoadSnapshot tracer tmpDir node
+
     describe "two hydra heads scenario" $ do
       it "two heads on the same network do not conflict" $ \tracer ->
         failAfter 60 $
