Simplify withHydraNode

Author: ch1bo

hydra-cluster/src/HydraNode.hs

@@ -477,107 +477,9 @@ withHydraNode ::
   [Int] ->
   (HydraClient -> IO a) ->
   IO a
-withHydraNode tracer chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds action =
-  withLogFile logFilePath $ \logFileHandle -> 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
-    let cardanoLedgerProtocolParametersFile = stateDir </> "protocol-parameters.json"
-    case chainConfig of
-      Offline _ ->
-        readConfigFile "protocol-parameters.json"
-          >>= writeFileBS cardanoLedgerProtocolParametersFile
-      Cardano CardanoChainConfig{chainBackendOptions} -> do
-        protocolParameters <- case chainBackendOptions of
-          Direct DirectOptions{networkId, nodeSocket} ->
-            -- NOTE: This implicitly tests of cardano-cli with hydra-node
-            cliQueryProtocolParameters nodeSocket networkId
-          Blockfrost BlockfrostOptions{projectPath} -> do
-            prj <- Blockfrost.projectFromFile projectPath
-            toJSON <$> Blockfrost.runBlockfrostM prj Blockfrost.queryProtocolParameters
-
-        Aeson.encodeFile cardanoLedgerProtocolParametersFile $
-          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)
-
-    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
-
-    let cmd =
-          ( proc "hydra-node" . toArgs $
-              -- NOTE: Using 0.0.0.0 over 127.0.0.1 will make the hydra-node
-              -- crash if it can't bind the interface and make tests fail more
-              -- obvious when e.g. a hydra-node instance is already running.
-              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
-                , persistenceRotateAfter = Nothing
-                , chainConfig
-                , whichEtcd = EmbeddedEtcd
-                , ledgerConfig =
-                    CardanoLedgerConfig
-                      { cardanoLedgerProtocolParametersFile
-                      }
-                }
-          )
-            & setStdout (useHandleOpen logFileHandle)
-            & setStderr createPipe
-
-    traceWith tracer $ HydraNodeCommandSpec $ show cmd
-
-    withProcessTerm cmd $ \p -> do
-      -- NOTE: exit code thread gets cancelled if 'action' terminates first
-      race
-        (collectAndCheckExitCode p)
-        (withConnectionToNode tracer hydraNodeId action)
-        <&> either absurd id
- where
-  collectAndCheckExitCode p = do
-    let h = getStderr p
-    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
-            ]
-
-  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
-    ]
-
-  logFilePath = workDir </> "logs" </> "hydra-node-" <> show hydraNodeId <.> "log"
+withHydraNode tracer chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds action = do
+  opts <- prepareHydraNode chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds id
+  withPreparedHydraNode tracer workDir hydraNodeId opts action
 
 withConnectionToNode :: forall a. Tracer IO HydraNodeLog -> Int -> (HydraClient -> IO a) -> IO a
 withConnectionToNode tracer hydraNodeId =