diff --git a/.DS_Store b/.DS_Store deleted file mode 100644 index e2389c5b698..00000000000 Binary files a/.DS_Store and /dev/null differ diff --git a/CHANGELOG.md b/CHANGELOG.md index 606aaec507c..777d47ff2e6 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -24,6 +24,12 @@ changes. - Renamed `HasInlineDatums` type class to `IsBabbageEraOnwards`. Use `babbageEraOnwards` to produce witnesses for features from babbage onwards. +- New top-level offline mode command, `offline` + - Initializes ledger via `--initial-utxo` parameter, and does not connect to a + cardano-node. +- Hydra.Options split into Hydra.Options.Common, Hydra.Options.Offline, + Hydra.Options.Online, re-exported from Hydra.Options. + ## [0.14.0] - 2023-12-04 diff --git a/hydra-cluster/src/Hydra/Cluster/Util.hs b/hydra-cluster/src/Hydra/Cluster/Util.hs index 8ce8c4ca67c..3de5900e591 100644 --- a/hydra-cluster/src/Hydra/Cluster/Util.hs +++ b/hydra-cluster/src/Hydra/Cluster/Util.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} + -- | Utilities used across hydra-cluster module Hydra.Cluster.Util where @@ -5,21 +7,36 @@ import Hydra.Prelude import Data.Aeson qualified as Aeson import Data.ByteString qualified as BS +import Data.Map qualified as Map import Hydra.Cardano.Api ( + Address, AsType (AsPaymentKey, AsSigningKey), HasTypeProxy (AsType), - Key (VerificationKey, getVerificationKey), + IsMaryEraOnwards, + IsShelleyBasedEra, + Key (VerificationKey, getVerificationKey, verificationKeyHash), + NetworkId, PaymentKey, + ShelleyAddr, SigningKey, SocketPath, + StakeAddressReference (NoStakeAddress), TextEnvelopeError (TextEnvelopeAesonDecodeError), + Tx, + UTxO' (UTxO), + VerificationKey (GenesisUTxOVerificationKey, PaymentVerificationKey), deserialiseFromTextEnvelope, + genesisUTxOPseudoTxIn, + mkTxOutValue, + mkVkAddress, textEnvelopeToJSON, ) +import Hydra.Cardano.Api.Prelude (PaymentCredential (PaymentCredentialByKey), ReferenceScript (ReferenceScriptNone), TxOut (TxOut), TxOutDatum (TxOutDatumNone), Value, makeShelleyAddress) import Hydra.Cluster.Fixture (Actor, actorName) import Hydra.ContestationPeriod (ContestationPeriod) +import Hydra.Ledger (IsTx (UTxOType)) import Hydra.Ledger.Cardano (genSigningKey) -import Hydra.Options (ChainConfig (..), defaultChainConfig) +import Hydra.Options (ChainConfig (..), OfflineConfig (OfflineConfig, initialUTxOFile, ledgerGenesisFile), defaultChainConfig) import Paths_hydra_cluster qualified as Pkg import System.FilePath ((<.>), ()) import Test.Hydra.Prelude (failure) @@ -59,8 +76,63 @@ createAndSaveSigningKey path = do writeFileLBS path $ textEnvelopeToJSON (Just "Key used to commit funds into a Head") sk pure sk +offlineConfigFor :: [(Actor, Value)] -> FilePath -> NetworkId -> IO OfflineConfig +offlineConfigFor actorToVal targetDir networkId = do + initialUtxoForActors actorToVal networkId >>= offlineConfigForUTxO @Tx targetDir + +offlineConfigForUTxO :: forall tx. IsTx tx => FilePath -> UTxOType tx -> IO OfflineConfig +offlineConfigForUTxO targetDir utxo = do + utxoPath <- seedInitialUTxOFromOffline @tx targetDir utxo + pure $ + OfflineConfig + { initialUTxOFile = utxoPath + , ledgerGenesisFile = Nothing + } + +seedInitialUTxOFromOffline :: IsTx tx => FilePath -> UTxOType tx -> IO FilePath +seedInitialUTxOFromOffline targetDir utxo = do + let destinationPath = targetDir "utxo.json" + writeFileBS destinationPath . toStrict . Aeson.encode $ utxo + + pure destinationPath + +buildAddress :: VerificationKey PaymentKey -> NetworkId -> Address ShelleyAddr +buildAddress vKey networkId = + makeShelleyAddress networkId (PaymentCredentialByKey $ verificationKeyHash vKey) NoStakeAddress + +initialUtxoWithFunds :: + forall era ctx. + (IsShelleyBasedEra era, IsMaryEraOnwards era) => + NetworkId -> + [(VerificationKey PaymentKey, Value)] -> + IO (UTxO' (TxOut ctx era)) +initialUtxoWithFunds networkId valueMap = + pure + . UTxO + . Map.fromList + . map (\(vKey, val) -> (txin vKey, txout vKey val)) + $ valueMap + where + txout vKey val = + TxOut + (mkVkAddress networkId vKey) + (mkTxOutValue val) + TxOutDatumNone + ReferenceScriptNone + txin vKey = genesisUTxOPseudoTxIn networkId (verificationKeyHash . castKey $ vKey) + castKey (PaymentVerificationKey vkey) = GenesisUTxOVerificationKey vkey + +initialUtxoForActors :: [(Actor, Value)] -> NetworkId -> IO (UTxOType Tx) +initialUtxoForActors actorToVal networkId = do + initialUtxoWithFunds networkId =<< vkToVal + where + vkForActor actor = fmap fst (keysFor actor) + vkToVal = + forM actorToVal $ \(actor, val) -> + vkForActor actor <&> (,val) + chainConfigFor :: HasCallStack => Actor -> FilePath -> SocketPath -> [Actor] -> ContestationPeriod -> IO ChainConfig -chainConfigFor me targetDir nodeSocket them cp = do +chainConfigFor me targetDir nodeSocket them contestationPeriod = do when (me `elem` them) $ failure $ show me <> " must not be in " <> show them @@ -73,7 +145,7 @@ chainConfigFor me targetDir nodeSocket them cp = do { nodeSocket , cardanoSigningKey = skTarget me , cardanoVerificationKeys = [vkTarget himOrHer | himOrHer <- them] - , contestationPeriod = cp + , contestationPeriod } where skTarget x = targetDir skName x diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs index e52b28f8443..38cb83f2ecf 100644 --- a/hydra-cluster/src/HydraNode.hs +++ b/hydra-cluster/src/HydraNode.hs @@ -25,7 +25,9 @@ import Hydra.Ledger.Cardano () import Hydra.Logging (Tracer, Verbosity (..), traceWith) import Hydra.Network (Host (Host), NodeId (NodeId)) import Hydra.Network qualified as Network -import Hydra.Options (ChainConfig (..), LedgerConfig (..), RunOptions (..), defaultChainConfig, toArgs) +import Hydra.Options (ChainConfig (..), LedgerConfig (..), OfflineConfig, RunOfflineOptions (..), RunOptions (..)) +import Hydra.Options.Offline qualified as OfflineOptions +import Hydra.Options.Online qualified as OnlineOptions import Network.HTTP.Req (GET (..), HttpException, JsonResponse, NoReqBody (..), POST (..), ReqBodyJson (..), defaultHttpConfig, responseBody, runReq, (/:)) import Network.HTTP.Req qualified as Req import Network.WebSockets (Connection, receiveData, runClient, sendClose, sendTextData) @@ -264,7 +266,7 @@ withConfiguredHydraCluster tracer workDir nodeSocket firstNodeId allKeys hydraKe cardanoVerificationKeys = [workDir show i <.> "vk" | i <- allNodeIds, i /= nodeId] chainConfig = chainConfigDecorator nodeId $ - defaultChainConfig + OnlineOptions.defaultChainConfig { nodeSocket , cardanoSigningKey , cardanoVerificationKeys @@ -281,6 +283,73 @@ withConfiguredHydraCluster tracer workDir nodeSocket firstNodeId allKeys hydraKe hydraScriptsTxId (\c -> startNodes (c : clients) rest) +withOfflineHydraNode :: + Tracer IO HydraNodeLog -> + OfflineConfig -> + FilePath -> + Int -> + SigningKey HydraKey -> + (HydraClient -> IO a) -> + IO a +withOfflineHydraNode tracer offlineConfig workDir hydraNodeId hydraSKey action = + withLogFile logFilePath $ \logFileHandle -> do + withOfflineHydraNode' offlineConfig workDir hydraNodeId hydraSKey (Just logFileHandle) $ do + \_stdoutHandle _stderrHandle processHandle -> do + result <- + race + (checkProcessHasNotDied ("hydra-node (" <> show hydraNodeId <> ")") processHandle) + (withConnectionToNode tracer hydraNodeId action) + case result of + Left e -> absurd e + Right a -> pure a + where + logFilePath = workDir "logs" "hydra-node-" <> show hydraNodeId <.> "log" + +withOfflineHydraNode' :: + OfflineConfig -> + FilePath -> + Int -> + SigningKey HydraKey -> + -- | If given use this as std out. + Maybe Handle -> + (Handle -> Handle -> ProcessHandle -> IO a) -> + IO a +withOfflineHydraNode' offlineConfig workDir hydraNodeId hydraSKey mGivenStdOut action = + withSystemTempDirectory "hydra-node-e2e" $ \dir -> do + let cardanoLedgerProtocolParametersFile = dir "protocol-parameters.json" + readConfigFile "protocol-parameters.json" >>= writeFileBS cardanoLedgerProtocolParametersFile + let hydraSigningKey = dir (show hydraNodeId <> ".sk") + void $ writeFileTextEnvelope (File hydraSigningKey) Nothing hydraSKey + let ledgerConfig = + CardanoLedgerConfig + { cardanoLedgerProtocolParametersFile + } + let p = + ( hydraNodeOfflineProcess $ + RunOfflineOptions + { verbosity = Verbose "HydraNode" + , host = "127.0.0.1" + , port = fromIntegral $ 5_000 + hydraNodeId + , apiHost = "127.0.0.1" + , apiPort = fromIntegral $ 4_000 + hydraNodeId + , monitoringPort = Just $ fromIntegral $ 6_000 + hydraNodeId + , hydraSigningKey + , hydraVerificationKeys = [] + , persistenceDir = workDir "state-" <> show hydraNodeId + , ledgerConfig + , offlineConfig + } + ) + { std_out = maybe CreatePipe UseHandle mGivenStdOut + , std_err = CreatePipe + } + withCreateProcess p $ \_stdin mCreatedHandle mErr processHandle -> + case (mCreatedHandle, mGivenStdOut, mErr) of + (Just out, _, Just err) -> action out err processHandle + (Nothing, Just out, Just err) -> action out err processHandle + (_, _, _) -> error "Should not happen™" + where + -- | Run a hydra-node with given 'ChainConfig' and using the config from -- config/. withHydraNode :: @@ -392,7 +461,10 @@ withConnectionToNode tracer hydraNodeId action = do pure res hydraNodeProcess :: RunOptions -> CreateProcess -hydraNodeProcess = proc "hydra-node" . toArgs +hydraNodeProcess = proc "hydra-node" . OnlineOptions.toArgs + +hydraNodeOfflineProcess :: RunOfflineOptions -> CreateProcess +hydraNodeOfflineProcess = proc "hydra-node" . OfflineOptions.toArgs waitForNodesConnected :: HasCallStack => Tracer IO HydraNodeLog -> DiffTime -> [HydraClient] -> IO () waitForNodesConnected tracer timeOut clients = diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs index 175fec9e6b8..0784e7fc808 100644 --- a/hydra-cluster/test/Test/EndToEndSpec.hs +++ b/hydra-cluster/test/Test/EndToEndSpec.hs @@ -34,6 +34,7 @@ import Hydra.Cardano.Api ( mkVkAddress, serialiseAddress, signTx, + pattern TxOut, pattern TxValidityLowerBound, ) import Hydra.Chain.Direct.State () @@ -74,7 +75,7 @@ import Hydra.Cluster.Util (chainConfigFor, keysFor) import Hydra.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod)) import Hydra.Crypto (generateSigningKey) import Hydra.Ledger (txId) -import Hydra.Ledger.Cardano (genKeyPair, mkRangedTx, mkSimpleTx) +import Hydra.Ledger.Cardano (genKeyPair, genUTxOFor, mkRangedTx, mkSimpleTx) import Hydra.Logging (Tracer, showLogsOnFailure) import Hydra.Options import Hydra.Party (deriveParty) @@ -92,6 +93,7 @@ import HydraNode ( withHydraCluster, withHydraNode, withHydraNode', + withOfflineHydraNode, ) import System.Directory (removeDirectoryRecursive) import System.FilePath (()) @@ -112,7 +114,37 @@ withClusterTempDir name = withTempDir ("hydra-cluster-e2e-" <> name) spec :: Spec -spec = around (showLogsOnFailure "EndToEndSpec") $ +spec = around (showLogsOnFailure "EndToEndSpec") $ do + it "End-to-end offline mode" $ \tracer -> do + withTempDir ("offline-mode-e2e") $ \tmpDir -> do + let networkId = Testnet (NetworkMagic 42) -- from defaultChainConfig + (aliceCardanoVk, aliceCardanoSk) <- keysFor Alice + (bobCardanoVk, _) <- keysFor Bob + initialUtxo <- generate $ do + a <- genUTxOFor aliceCardanoVk + b <- genUTxOFor bobCardanoVk + pure $ a <> b + Aeson.encodeFile (tmpDir "utxo.json") initialUtxo + let offlineConfig = + OfflineConfig + { initialUTxOFile = tmpDir "utxo.json" + , ledgerGenesisFile = Nothing + } + + let Just (aliceSeedTxIn, aliceSeedTxOut) = UTxO.find (\(TxOut addr _ _ _) -> addr == mkVkAddress networkId aliceCardanoVk) initialUtxo + + withOfflineHydraNode (contramap FromHydraNode tracer) offlineConfig tmpDir 0 aliceSk $ \node -> do + let Right tx = + mkSimpleTx + (aliceSeedTxIn, aliceSeedTxOut) + (mkVkAddress networkId bobCardanoVk, lovelaceToValue paymentFromAliceToBob) + aliceCardanoSk + + send node $ input "NewTx" ["transaction" .= tx] + + waitMatch 10 node $ \v -> do + guard $ v ^? key "tag" == Just "SnapshotConfirmed" + describe "End-to-end on Cardano devnet" $ do describe "single party hydra head" $ do it "full head life-cycle" $ \tracer -> do diff --git a/hydra-node/exe/hydra-node/Main.hs b/hydra-node/exe/hydra-node/Main.hs index 6ed42044d63..f7eadbfddff 100644 --- a/hydra-node/exe/hydra-node/Main.hs +++ b/hydra-node/exe/hydra-node/Main.hs @@ -10,13 +10,14 @@ import Hydra.Cardano.Api ( import Hydra.Chain.Direct.ScriptRegistry (publishHydraScripts) import Hydra.Chain.Direct.Util (readKeyPair) import Hydra.Logging (Verbosity (..)) -import Hydra.Node.Run (explain, run) +import Hydra.Node.Run (explain, run, runOffline) import Hydra.Options ( - Command (GenHydraKey, Publish, Run), + Command (GenHydraKey, Publish, Run, RunOffline), PublishOptions (..), RunOptions (..), parseHydraCommand, ) +import Hydra.Options.Online qualified as OnlineOptions import Hydra.Utils (genHydraKeys) main :: IO () @@ -25,6 +26,8 @@ main = do case command of Run options -> run (identifyNode options) `catch` (die . explain) + RunOffline options -> + runOffline options `catch` (die . explain) Publish options -> publish options GenHydraKey outputFile -> @@ -37,5 +40,5 @@ main = do putStr (decodeUtf8 (serialiseToRawBytesHex txId)) identifyNode :: RunOptions -> RunOptions -identifyNode opt@RunOptions{verbosity = Verbose "HydraNode", nodeId} = opt{verbosity = Verbose $ "HydraNode-" <> show nodeId} +identifyNode opt@RunOptions{verbosity = Verbose "HydraNode", nodeId} = opt{OnlineOptions.verbosity = Verbose $ "HydraNode-" <> show nodeId} identifyNode opt = opt diff --git a/hydra-node/golden/RunOptions.json b/hydra-node/golden/RunOptions.json index 5630cbceb31..0dee179d0a5 100644 --- a/hydra-node/golden/RunOptions.json +++ b/hydra-node/golden/RunOptions.json @@ -39,6 +39,7 @@ }, "monitoringPort": 10, "nodeId": "ibqamqhmfggaqsj", + "offlineConfig": null, "peers": [ { "hostname": "0.0.0.2", @@ -89,6 +90,7 @@ }, "monitoringPort": null, "nodeId": "spdagobgcblquqlviwbymhcdr", + "offlineConfig": null, "peers": [ { "hostname": "0.0.0.7", @@ -145,6 +147,7 @@ }, "monitoringPort": 19746, "nodeId": "icqna", + "offlineConfig": null, "peers": [ { "hostname": "0.0.0.4", @@ -216,6 +219,7 @@ }, "monitoringPort": 6616, "nodeId": "ip", + "offlineConfig": null, "peers": [], "persistenceDir": "b/b/c", "port": 12529, @@ -264,6 +268,7 @@ }, "monitoringPort": 9885, "nodeId": "vgnfmvtyrtutqozcjppmpaab", + "offlineConfig": null, "peers": [ { "hostname": "0.0.0.0", diff --git a/hydra-node/hydra-node.cabal b/hydra-node/hydra-node.cabal index 584726cbef0..bd3bbfdb12a 100644 --- a/hydra-node/hydra-node.cabal +++ b/hydra-node/hydra-node.cabal @@ -64,6 +64,9 @@ library Hydra.Chain.Direct.Tx Hydra.Chain.Direct.Util Hydra.Chain.Direct.Wallet + Hydra.Chain.Offline + Hydra.Chain.Offline.Handlers + Hydra.Chain.Offline.Persistence Hydra.ContestationPeriod Hydra.Crypto Hydra.HeadId @@ -99,6 +102,9 @@ library Hydra.Node.Run Hydra.OnChainId Hydra.Options + Hydra.Options.Common + Hydra.Options.Offline + Hydra.Options.Online Hydra.Party Hydra.Persistence Hydra.Snapshot diff --git a/hydra-node/json-schemas/logs.yaml b/hydra-node/json-schemas/logs.yaml index 3d90d610240..fe6d4395859 100644 --- a/hydra-node/json-schemas/logs.yaml +++ b/hydra-node/json-schemas/logs.yaml @@ -115,6 +115,23 @@ properties: description: >- Configuration needed to run the hydra node + - title: NodeOfflineOptions + description: >- + Hydra node in offline mode parsed command line arguments + type: object + additionalProperties: false + required: + - tag + - runOfflineOptions + properties: + tag: + type: string + enum: ["NodeOfflineOptions"] + runOfflineOptions: + "$ref": "logs.yaml#/definitions/RunOfflineOptions" + description: >- + Configuration needed to run the hydra node in offline mode + - title: Authentication description: >- Hydra node detected a difference between the signer and the sender @@ -2172,6 +2189,71 @@ definitions: cardanoLedgerProtocolParametersFile: type: string + RunOfflineOptions: + type: object + required: + - verbosity + - host + - port + - apiHost + - apiPort + - monitoringPort + - hydraSigningKey + - hydraVerificationKeys + - persistenceDir + - ledgerConfig + - offlineConfig + properties: + verbosity: + oneOf: + - title: Quiet + properties: + tag: + type: string + enum: ["Quiet"] + - title: Verbose + properties: + tag: + type: string + enum: ["Verbose"] + contents: + type: string + host: + type: object + $ref: "logs.yaml#/definitions/IP" + port: + type: integer + apiHost: + $ref: "logs.yaml#/definitions/IP" + apiPort: + type: integer + monitoringPort: + oneOf: + - type: "null" + - type: integer + hydraSigningKey: + type: string + hydraVerificationKeys: + type: array + items: + type: string + persistenceDir: + type: string + ledgerConfig: + type: object + properties: + cardanoLedgerProtocolParametersFile: + type: string + offlineConfig: + type: object + properties: + initialUTxOFile: + type: string + ledgerGenesisFile: + oneOf: + - type: "null" + - type: string + AuthLog: type: object required: diff --git a/hydra-node/src/Hydra/Chain/Direct.hs b/hydra-node/src/Hydra/Chain/Direct.hs index 6fc8c7480a5..fdda726cb6e 100644 --- a/hydra-node/src/Hydra/Chain/Direct.hs +++ b/hydra-node/src/Hydra/Chain/Direct.hs @@ -50,7 +50,7 @@ import Hydra.Cardano.Api ( import Hydra.Chain ( ChainComponent, ChainStateHistory, - PostTxError (..), + PostTxError (FailedToPostTx, failureReason), currentState, ) import Hydra.Chain.CardanoClient ( diff --git a/hydra-node/src/Hydra/Chain/Offline.hs b/hydra-node/src/Hydra/Chain/Offline.hs new file mode 100644 index 00000000000..47d484c62e9 --- /dev/null +++ b/hydra-node/src/Hydra/Chain/Offline.hs @@ -0,0 +1,126 @@ +module Hydra.Chain.Offline ( + withOfflineChain, +) where + +import Hydra.Prelude + +import Cardano.Ledger.BaseTypes (epochInfoPure) +import Cardano.Ledger.BaseTypes qualified as Ledger +import Cardano.Ledger.Shelley.API qualified as Ledger +import Cardano.Ledger.Slot (SlotNo (SlotNo, unSlotNo)) +import Cardano.Slotting.EpochInfo (EpochInfo (EpochInfo), epochInfoFirst, epochInfoSlotToUTCTime) +import Cardano.Slotting.Time (SystemStart (SystemStart), mkSlotLength, toRelativeTime) +import Cardano.Slotting.Time qualified as Slotting +import Hydra.Cardano.Api ( + StandardCrypto, + Tx, + ) +import Hydra.Chain ( + ChainComponent, + ChainEvent (Tick), + ChainStateHistory, + chainSlot, + chainTime, + ) +import Hydra.Chain.Direct.Handlers ( + DirectChainLog (), + newLocalChainState, + ) +import Hydra.Chain.Offline.Handlers (mkFakeL1Chain) +import Hydra.Chain.Offline.Persistence (initializeStateIfOffline) +import Hydra.ContestationPeriod (ContestationPeriod) +import Hydra.HeadId (HeadId) +import Hydra.Ledger (ChainSlot (ChainSlot), IsTx (UTxOType)) +import Hydra.Ledger.Cardano.Configuration (readJsonFileThrow) +import Hydra.Logging (Tracer) +import Hydra.Options (OfflineConfig (OfflineConfig, initialUTxOFile, ledgerGenesisFile)) +import Hydra.Party (Party) +import Ouroboros.Consensus.HardFork.History (interpretQuery, mkInterpreter, neverForksSummary, slotToWallclock, wallclockToSlot) +import Ouroboros.Consensus.HardFork.History qualified as Consensus +import Ouroboros.Consensus.Util.Time (nominalDelay) + +withOfflineChain :: + Tracer IO DirectChainLog -> + OfflineConfig -> + Ledger.Globals -> + HeadId -> + Party -> + ContestationPeriod -> + -- | Last known chain state as loaded from persistence. + ChainStateHistory Tx -> + ChainComponent Tx IO a +withOfflineChain tracer OfflineConfig{ledgerGenesisFile, initialUTxOFile} globals@Ledger.Globals{systemStart} ownHeadId party contestationPeriod chainStateHistory callback action = do + initialUTxO :: UTxOType Tx <- readJsonFileThrow (parseJSON @(UTxOType Tx)) initialUTxOFile + initializeStateIfOffline chainStateHistory initialUTxO ownHeadId party contestationPeriod callback + + localChainState <- newLocalChainState chainStateHistory + let chainHandle = mkFakeL1Chain contestationPeriod localChainState tracer ownHeadId callback + + -- L2 ledger normally has fixed epoch info based on slot length from protocol params + -- we're getting it from gen params here, it should match, but this might motivate generating shelleygenesis based on protocol params + + tickForeverAction <- case ledgerGenesisFile of + Just filePath -> do + Ledger.ShelleyGenesis{sgSystemStart, sgSlotLength, sgEpochLength} <- + readJsonFileThrow (parseJSON @(Ledger.ShelleyGenesis StandardCrypto)) filePath + let slotLengthNominalDiffTime = Ledger.fromNominalDiffTimeMicro sgSlotLength + slotLength = mkSlotLength slotLengthNominalDiffTime + + let interpreter = mkInterpreter $ neverForksSummary sgEpochLength slotLength + + let slotFromUTCTime :: HasCallStack => UTCTime -> Either Consensus.PastHorizonException ChainSlot + slotFromUTCTime utcTime = do + let relativeTime = toRelativeTime (SystemStart sgSystemStart) utcTime + case interpretQuery interpreter (wallclockToSlot relativeTime) of + Left pastHorizonEx -> + Left pastHorizonEx + Right (SlotNo slotNoWord64, _timeSpentInSlot, _timeLeftInSlot) -> + Right . ChainSlot . fromIntegral @Word64 @Natural $ slotNoWord64 + + slotToUTCTime :: HasCallStack => ChainSlot -> Either Consensus.PastHorizonException UTCTime + slotToUTCTime (ChainSlot slotNat) = + case interpretQuery interpreter (slotToWallclock . SlotNo . fromIntegral @Natural @Word64 $ slotNat) of + Left pastHorizonEx -> Left pastHorizonEx + Right (relativeTime, _slotLength) -> pure $ Slotting.fromRelativeTime (SystemStart sgSystemStart) relativeTime + + let nextTick (SlotNo upcomingSlotWord64) = do + let upcomingSlotChainSlot = ChainSlot . fromIntegral @Word64 @Natural $ upcomingSlotWord64 + timeToSleepUntil <- either throwIO pure . slotToUTCTime $ upcomingSlotChainSlot + sleepDelay <- diffUTCTime timeToSleepUntil <$> getCurrentTime + threadDelay $ nominalDelay sleepDelay + callback $ + Tick + { chainTime = timeToSleepUntil + , chainSlot = ChainSlot . fromIntegral @Word64 @Natural $ upcomingSlotWord64 + } + + ChainSlot initialSlotNat <- either throwIO pure =<< fmap slotFromUTCTime getCurrentTime + let initialSlot = SlotNo . fromIntegral @Natural @Word64 $ initialSlotNat + let tickForever = traverse_ nextTick [initialSlot ..] + pure tickForever + Nothing -> do + let epochInfo@EpochInfo{} = epochInfoPure globals + initialSlot = runIdentity $ epochInfoFirst epochInfo 0 + + nextTick upcomingSlot = do + let timeToSleepUntil = runIdentity $ epochInfoSlotToUTCTime epochInfo systemStart upcomingSlot + sleepDelay <- diffUTCTime timeToSleepUntil <$> getCurrentTime + threadDelay $ nominalDelay sleepDelay + callback $ + Tick + { chainTime = timeToSleepUntil + , chainSlot = ChainSlot . fromIntegral @Word64 @Natural $ unSlotNo upcomingSlot + } + + tickForever = traverse_ nextTick [initialSlot ..] + + pure tickForever + + res <- + race + tickForeverAction + (action chainHandle) + + case res of + Left () -> error "'connectTo' cannot terminate but did?" + Right a -> pure a diff --git a/hydra-node/src/Hydra/Chain/Offline/Handlers.hs b/hydra-node/src/Hydra/Chain/Offline/Handlers.hs new file mode 100644 index 00000000000..c0cbe3aeb0e --- /dev/null +++ b/hydra-node/src/Hydra/Chain/Offline/Handlers.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE TypeApplications #-} + +module Hydra.Chain.Offline.Handlers ( + mkFakeL1Chain, +) where + +import Hydra.Chain ( + Chain (Chain, draftCommitTx, postTx, submitTx), + ChainEvent (Observation, newChainState, observedTx), + OnChainTx (..), + PostChainTx (..), + PostTxError (FailedToDraftTxNotInitializing), + confirmedSnapshot, + snapshotNumber, + ) +import Hydra.Chain.Direct.Handlers (DirectChainLog (ToPost, toPost), LocalChainState, getLatest) +import Hydra.Chain.Direct.State (ChainStateAt (ChainStateAt)) +import Hydra.ContestationPeriod (ContestationPeriod, toNominalDiffTime) +import Hydra.HeadId (HeadId, HeadSeed (UnsafeHeadSeed)) +import Hydra.Ledger.Cardano (Tx) +import Hydra.Logging (Tracer, traceWith) +import Hydra.Prelude +import Hydra.Snapshot (Snapshot (number), getSnapshot) + +mkFakeL1Chain :: + ContestationPeriod -> + LocalChainState IO Tx -> + Tracer IO DirectChainLog -> + HeadId -> + (ChainEvent Tx -> IO ()) -> + Chain Tx IO +mkFakeL1Chain contestationPeriod localChainState tracer ownHeadId callback = + Chain + { submitTx = const $ pure () + , draftCommitTx = \_ _ -> pure $ Left FailedToDraftTxNotInitializing + , postTx = \tx -> do + cst@ChainStateAt{} <- atomically (getLatest localChainState) + traceWith tracer $ ToPost{toPost = tx} + + let headId = ownHeadId + let offlineHeadSeed = UnsafeHeadSeed "OfflineHeadSeed_" + headSeed = offlineHeadSeed + _ <- case tx of + InitTx{headParameters} -> + callback $ Observation{newChainState = cst, observedTx = OnInitTx{headId, headParameters, headSeed, participants = []}} + AbortTx{} -> + callback $ Observation{newChainState = cst, observedTx = OnAbortTx{headId}} + CollectComTx{} -> + callback $ Observation{newChainState = cst, observedTx = OnCollectComTx{headId}} + CloseTx{confirmedSnapshot} -> do + contestationDeadline <- addUTCTime (toNominalDiffTime contestationPeriod) <$> getCurrentTime + callback $ + Observation + { newChainState = cst + , observedTx = + OnCloseTx{headId, snapshotNumber = number $ getSnapshot confirmedSnapshot, contestationDeadline} + } + ContestTx{confirmedSnapshot} -> + -- TODO: this shouldn't really happen... make it impossible to do contestation in offline mode? + callback $ + Observation + { newChainState = cst + , observedTx = + OnContestTx{snapshotNumber = number $ getSnapshot confirmedSnapshot, headId} + } + FanoutTx{} -> + callback $ + Observation + { newChainState = cst + , observedTx = + OnFanoutTx{headId} + } + pure () + } diff --git a/hydra-node/src/Hydra/Chain/Offline/Persistence.hs b/hydra-node/src/Hydra/Chain/Offline/Persistence.hs new file mode 100644 index 00000000000..72ff1a5c101 --- /dev/null +++ b/hydra-node/src/Hydra/Chain/Offline/Persistence.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE DisambiguateRecordFields #-} + +module Hydra.Chain.Offline.Persistence ( + initializeStateIfOffline, +) where + +import Hydra.Prelude + +import Hydra.Cardano.Api (Tx) +import Hydra.Chain ( + ChainEvent (Observation, observedTx), + ChainStateHistory, + HeadParameters (..), + OnChainTx (..), + committed, + initHistory, + newChainState, + party, + ) +import Hydra.Chain.Direct.State (initialChainState) +import Hydra.ContestationPeriod (ContestationPeriod) +import Hydra.HeadId (HeadId, HeadSeed (UnsafeHeadSeed)) +import Hydra.Ledger (IsTx (UTxOType)) +import Hydra.Party (Party) + +initializeStateIfOffline :: + ChainStateHistory Tx -> + UTxOType Tx -> + HeadId -> + Party -> + ContestationPeriod -> + (ChainEvent Tx -> IO ()) -> + IO () +initializeStateIfOffline chainStateHistory initialUTxO ownHeadId ownParty contestationPeriod callback = do + let emptyChainStateHistory = initHistory initialChainState + + -- if we don't have a chainStateHistory to restore from disk from, start a new one + when (chainStateHistory == emptyChainStateHistory) $ do + callback $ + Observation + { newChainState = initialChainState + , observedTx = + OnInitTx + { headId = ownHeadId + , headParameters = HeadParameters{parties = [ownParty], contestationPeriod} + , headSeed = UnsafeHeadSeed "OfflineHeadSeed_" + , participants = [] + } + } + + callback $ + Observation + { newChainState = initialChainState + , observedTx = + OnCommitTx + { party = ownParty + , committed = initialUTxO + , headId = ownHeadId + } + } diff --git a/hydra-node/src/Hydra/Logging/Messages.hs b/hydra-node/src/Hydra/Logging/Messages.hs index 47cf23a0215..f472c98c1e6 100644 --- a/hydra-node/src/Hydra/Logging/Messages.hs +++ b/hydra-node/src/Hydra/Logging/Messages.hs @@ -15,7 +15,8 @@ import Hydra.Chain.Direct.Handlers (DirectChainLog) import Hydra.Network.Authenticate (AuthLog) import Hydra.Network.Reliability (ReliabilityLog) import Hydra.Node (HydraNodeLog) -import Hydra.Options (RunOptions) +import Hydra.Options (RunOfflineOptions, RunOptions) +import Hydra.Options.Offline () data HydraLog tx net = DirectChain {directChain :: DirectChainLog} @@ -23,6 +24,7 @@ data HydraLog tx net | Network {network :: net} | Node {node :: HydraNodeLog tx} | NodeOptions {runOptions :: RunOptions} + | NodeOfflineOptions {runOfflineOptions :: RunOfflineOptions} | Authentication {authentication :: AuthLog} | Reliability {reliability :: ReliabilityLog} deriving stock (Generic) diff --git a/hydra-node/src/Hydra/Node.hs b/hydra-node/src/Hydra/Node.hs index 313d84111e0..0ee41e37a88 100644 --- a/hydra-node/src/Hydra/Node.hs +++ b/hydra-node/src/Hydra/Node.hs @@ -35,7 +35,7 @@ import Hydra.HeadLogic ( Environment (..), Event (..), HeadState (..), - IdleState (IdleState), + IdleState (..), Outcome (..), aggregateState, collectEffects, @@ -46,15 +46,15 @@ import Hydra.HeadLogic ( import Hydra.HeadLogic qualified as Logic import Hydra.HeadLogic.Outcome (StateChanged (..)) import Hydra.HeadLogic.State (getHeadParameters) -import Hydra.Ledger (IsTx, Ledger) +import Hydra.Ledger (IsTx (), Ledger) import Hydra.Logging (Tracer, traceWith) import Hydra.Network (Network (..)) import Hydra.Network.Message (Message) import Hydra.Node.EventQueue (EventQueue (..), Queued (..)) import Hydra.Node.ParameterMismatch (ParamMismatch (..), ParameterMismatch (..)) -import Hydra.Options (ChainConfig (..), RunOptions (..)) +import Hydra.Options (ChainConfig (..), RunOfflineOptions (..), RunOptions (..), defaultContestationPeriod) import Hydra.Party (Party (..), deriveParty) -import Hydra.Persistence (PersistenceIncremental (..), loadAll) +import Hydra.Persistence (PersistenceIncremental (..)) -- * Environment Handling @@ -65,6 +65,7 @@ initEnvironment options = do otherParties <- mapM loadParty hydraVerificationKeys -- NOTE: This is a cardano-specific initialization step of loading -- --cardano-verification-key options and deriving 'OnChainId's from it. + ownSigningKey <- readFileTextEnvelopeThrow (AsSigningKey AsPaymentKey) cardanoSigningKey otherVerificationKeys <- mapM (readFileTextEnvelopeThrow (AsVerificationKey AsPaymentKey)) cardanoVerificationKeys let participants = verificationKeyToOnChainId <$> (getVerificationKey ownSigningKey : otherVerificationKeys) @@ -91,6 +92,29 @@ initEnvironment options = do } } = options +initEnvironmentOffline :: RunOfflineOptions -> IO Environment +initEnvironmentOffline options = do + sk <- readFileTextEnvelopeThrow (AsSigningKey AsHydraKey) hydraSigningKey + otherParties <- mapM loadParty hydraVerificationKeys + + let participants = [] + pure $ + Environment + { party = deriveParty sk + , signingKey = sk + , otherParties + , participants + , contestationPeriod = defaultContestationPeriod + } + where + loadParty p = + Party <$> readFileTextEnvelopeThrow (AsVerificationKey AsHydraKey) p + + RunOfflineOptions + { hydraSigningKey + , hydraVerificationKeys + } = options + -- | Checks that command line options match a given 'HeadState'. This function -- takes 'Environment' because it is derived from 'RunOptions' via -- 'initEnvironment'. diff --git a/hydra-node/src/Hydra/Node/Run.hs b/hydra-node/src/Hydra/Node/Run.hs index 70b325030df..da026f6efcb 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -1,20 +1,31 @@ +{-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-} module Hydra.Node.Run where import Hydra.Prelude hiding (fromList) +import Cardano.Ledger.BaseTypes qualified as Ledger +import Cardano.Ledger.Crypto qualified as Ledger +import Cardano.Ledger.Shelley.API qualified as Shelley import Hydra.API.Server (Server (..), withAPIServer) import Hydra.API.ServerOutput (ServerOutput (..)) import Hydra.Cardano.Api ( + GenesisParameters (..), ProtocolParametersConversionError, ShelleyBasedEra (..), + StandardCrypto, + SystemStart (..), toLedgerPParams, ) +import Hydra.Cardano.Api qualified as Shelley import Hydra.Chain (maximumNumberOfParties) import Hydra.Chain.CardanoClient (QueryPoint (..), queryGenesisParameters) import Hydra.Chain.Direct (loadChainContext, mkTinyWallet, withDirectChain) +import Hydra.Chain.Direct.Fixture (defaultGlobals) import Hydra.Chain.Direct.State (initialChainState) +import Hydra.Chain.Offline (withOfflineChain) +import Hydra.HeadId (HeadId (..)) import Hydra.HeadLogic ( Environment (..), Event (..), @@ -30,6 +41,7 @@ import Hydra.Ledger.Cardano.Configuration ( import Hydra.Logging (Verbosity (..), traceWith, withTracer) import Hydra.Logging.Messages (HydraLog (..)) import Hydra.Logging.Monitoring (withMonitoring) +import Hydra.Network (NodeId (NodeId)) import Hydra.Network.Authenticate (Authenticated (Authenticated)) import Hydra.Network.Message (Connectivity (..)) import Hydra.Node ( @@ -37,6 +49,7 @@ import Hydra.Node ( checkHeadState, createNodeState, initEnvironment, + initEnvironmentOffline, loadState, runHydraNode, ) @@ -46,9 +59,13 @@ import Hydra.Options ( ChainConfig (..), InvalidOptions (..), LedgerConfig (..), + OfflineConfig (..), + RunOfflineOptions (..), RunOptions (..), validateRunOptions, ) +import Hydra.Options.Offline qualified as OfflineOptions +import Hydra.Options.Online qualified as OnlineOptions import Hydra.Persistence (createPersistenceIncremental) data ConfigurationException @@ -66,6 +83,67 @@ explain = \case ConfigurationException err -> "Incorrect protocol parameters configuration provided: " <> show err +runOffline :: RunOfflineOptions -> IO () +runOffline opts = do + either (throwIO . InvalidOptionException) pure $ OfflineOptions.validateRunOfflineOptions opts + let RunOfflineOptions{verbosity, monitoringPort, persistenceDir, offlineConfig} = opts + env@Environment{party, otherParties, signingKey, contestationPeriod} <- initEnvironmentOffline opts + + withTracer verbosity $ \tracer' -> + withMonitoring monitoringPort tracer' $ \tracer -> do + traceWith tracer (NodeOfflineOptions opts) + eq@EventQueue{putEvent} <- createEventQueue + let RunOfflineOptions{ledgerConfig} = opts + protocolParams <- readJsonFileThrow protocolParametersFromJson (cardanoLedgerProtocolParametersFile ledgerConfig) + pparams <- case toLedgerPParams ShelleyBasedEraBabbage protocolParams of + Left err -> throwIO (ConfigurationException err) + Right bpparams -> pure bpparams + + globals <- loadGlobalsFromGenesis (ledgerGenesisFile offlineConfig) + + withCardanoLedger pparams globals $ \ledger -> do + persistence <- createPersistenceIncremental $ persistenceDir <> "/state" + (hs, chainStateHistory) <- loadState (contramap Node tracer) persistence initialChainState + + checkHeadState (contramap Node tracer) env hs + nodeState <- createNodeState hs + -- Chain + let withChain cont = + let headId = UnsafeHeadId "HeadId" + in withOfflineChain (contramap DirectChain tracer) offlineConfig globals headId party contestationPeriod chainStateHistory (putEvent . OnChainEvent) cont + withChain $ \chain -> do + -- API + let RunOfflineOptions{host, port} = opts + peers = [] + nodeId = NodeId "offline" + putNetworkEvent (Authenticated msg otherParty) = putEvent $ NetworkEvent defaultTTL otherParty msg + RunOfflineOptions{apiHost, apiPort} = opts + apiPersistence <- createPersistenceIncremental $ persistenceDir <> "/server-output" + withAPIServer apiHost apiPort party apiPersistence (contramap APIServer tracer) chain pparams (putEvent . ClientEvent) $ \server -> do + -- Network + let networkConfiguration = NetworkConfiguration{persistenceDir, signingKey, otherParties, host, port, peers, nodeId} + withNetwork tracer (connectionMessages server) networkConfiguration putNetworkEvent $ \hn -> do + -- Main loop + runHydraNode (contramap Node tracer) $ + HydraNode + { eq + , hn + , nodeState + , oc = chain + , server + , ledger + , env + , persistence + } + where + connectionMessages Server{sendOutput} = \case + Connected nodeid -> sendOutput $ PeerConnected nodeid + Disconnected nodeid -> sendOutput $ PeerDisconnected nodeid + + withCardanoLedger protocolParams globals action = + let ledgerEnv = newLedgerEnv protocolParams + in action (Ledger.cardanoLedger globals ledgerEnv) + run :: RunOptions -> IO () run opts = do either (throwIO . InvalidOptionException) pure $ validateRunOptions opts @@ -80,15 +158,23 @@ run opts = do pparams <- case toLedgerPParams ShelleyBasedEraBabbage protocolParams of Left err -> throwIO (ConfigurationException err) Right bpparams -> pure bpparams - withCardanoLedger chainConfig pparams $ \ledger -> do + + let DirectChainConfig{networkId, nodeSocket} = chainConfig + + globals <- newGlobals =<< queryGenesisParameters networkId nodeSocket QueryTip + + withCardanoLedger pparams globals $ \ledger -> do persistence <- createPersistenceIncremental $ persistenceDir <> "/state" (hs, chainStateHistory) <- loadState (contramap Node tracer) persistence initialChainState + checkHeadState (contramap Node tracer) env hs nodeState <- createNodeState hs -- Chain - ctx <- loadChainContext chainConfig party hydraScriptsTxId - wallet <- mkTinyWallet (contramap DirectChain tracer) chainConfig - withDirectChain (contramap DirectChain tracer) chainConfig ctx wallet chainStateHistory (putEvent . OnChainEvent) $ \chain -> do + let withChain cont = do + ctx <- loadChainContext chainConfig party hydraScriptsTxId + wallet <- mkTinyWallet (contramap DirectChain tracer) chainConfig + withDirectChain (contramap DirectChain tracer) chainConfig ctx wallet chainStateHistory (putEvent . OnChainEvent) cont + withChain $ \chain -> do -- API let RunOptions{host, port, peers, nodeId} = opts putNetworkEvent (Authenticated msg otherParty) = putEvent $ NetworkEvent defaultTTL otherParty msg @@ -115,12 +201,63 @@ run opts = do Connected nodeid -> sendOutput $ PeerConnected nodeid Disconnected nodeid -> sendOutput $ PeerDisconnected nodeid - withCardanoLedger chainConfig protocolParams action = do - let DirectChainConfig{networkId, nodeSocket} = chainConfig - globals <- newGlobals =<< queryGenesisParameters networkId nodeSocket QueryTip + withCardanoLedger protocolParams globals action = let ledgerEnv = newLedgerEnv protocolParams - action (Ledger.cardanoLedger globals ledgerEnv) + in action (Ledger.cardanoLedger globals ledgerEnv) identifyNode :: RunOptions -> RunOptions -identifyNode opt@RunOptions{verbosity = Verbose "HydraNode", nodeId} = opt{verbosity = Verbose $ "HydraNode-" <> show nodeId} +identifyNode opt@RunOptions{verbosity = Verbose "HydraNode", nodeId} = opt{OnlineOptions.verbosity = Verbose $ "HydraNode-" <> show nodeId} identifyNode opt = opt + +loadGlobalsFromGenesis :: Maybe FilePath -> IO Shelley.Globals +loadGlobalsFromGenesis ledgerGenesisFile = do + shelleyGenesis <- case ledgerGenesisFile of + Nothing -> pure Nothing + Just filePath -> Just <$> readJsonFileThrow (parseJSON @(Ledger.ShelleyGenesis StandardCrypto)) filePath + systemStart <- maybe (SystemStart <$> getCurrentTime) (pure . SystemStart . Ledger.sgSystemStart) shelleyGenesis + + let genesisParameters = fromShelleyGenesis <$> shelleyGenesis + + globals <- + maybe + (pure $ defaultGlobals{Ledger.systemStart = systemStart}) + newGlobals + genesisParameters + + pure globals + +-- | Taken from Cardano.Api.GenesisParameters, a private module in cardano-api +fromShelleyGenesis :: Shelley.ShelleyGenesis Ledger.StandardCrypto -> GenesisParameters Shelley.ShelleyEra +fromShelleyGenesis + sg@Shelley.ShelleyGenesis + { Shelley.sgSystemStart + , Shelley.sgNetworkMagic + , Shelley.sgActiveSlotsCoeff + , Shelley.sgSecurityParam + , Shelley.sgEpochLength + , Shelley.sgSlotsPerKESPeriod + , Shelley.sgMaxKESEvolutions + , Shelley.sgSlotLength + , Shelley.sgUpdateQuorum + , Shelley.sgMaxLovelaceSupply + , Shelley.sgGenDelegs = _ -- unused, might be of interest + , Shelley.sgInitialFunds = _ -- unused, not retained by the node + , Shelley.sgStaking = _ -- unused, not retained by the node + } = + GenesisParameters + { protocolParamSystemStart = sgSystemStart + , protocolParamNetworkId = Shelley.fromNetworkMagic $ Shelley.NetworkMagic sgNetworkMagic + , protocolParamActiveSlotsCoefficient = + Ledger.unboundRational + sgActiveSlotsCoeff + , protocolParamSecurity = fromIntegral sgSecurityParam + , protocolParamEpochLength = sgEpochLength + , protocolParamSlotLength = Shelley.fromNominalDiffTimeMicro sgSlotLength + , protocolParamSlotsPerKESPeriod = fromIntegral sgSlotsPerKESPeriod + , protocolParamMaxKESEvolutions = fromIntegral sgMaxKESEvolutions + , protocolParamUpdateQuorum = fromIntegral sgUpdateQuorum + , protocolParamMaxLovelaceSupply = + Shelley.Lovelace + (fromIntegral sgMaxLovelaceSupply) + , protocolInitialUpdateableProtocolParameters = Shelley.sgProtocolParams sg + } diff --git a/hydra-node/src/Hydra/Options.hs b/hydra-node/src/Hydra/Options.hs index 0a28d3497d9..158fab71e04 100644 --- a/hydra-node/src/Hydra/Options.hs +++ b/hydra-node/src/Hydra/Options.hs @@ -1,6 +1,11 @@ +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -Wno-orphans #-} module Hydra.Options ( + module Hydra.Options.Common, + module Hydra.Options.Offline, + module Hydra.Options.Online, module Hydra.Options, ParserResult (..), renderFailure, @@ -8,47 +13,63 @@ module Hydra.Options ( import Hydra.Prelude -import Control.Arrow (left) -import Data.ByteString qualified as BS -import Data.ByteString.Char8 qualified as BSC -import Data.IP (IP (IPv4), toIPv4, toIPv4w) -import Data.Text (unpack) -import Data.Text qualified as T -import Data.Time.Clock (nominalDiffTimeToSeconds) import Data.Version (Version (..), showVersion) import Hydra.Cardano.Api ( - AsType (AsTxId), - ChainPoint (..), - File (..), NetworkId (..), - NetworkMagic (..), - SlotNo (..), SocketPath, - TxId (..), - deserialiseFromRawBytes, - deserialiseFromRawBytesHex, - proxyToAsType, - serialiseToRawBytesHexText, ) -import Hydra.Chain (maximumNumberOfParties) -import Hydra.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod)) import Hydra.Contract qualified as Contract import Hydra.Ledger.Cardano () -import Hydra.Logging (Verbosity (..)) -import Hydra.Network (Host, NodeId (NodeId), PortNumber, readHost, readPort) +import Hydra.Options.Common ( + InvalidOptions (..), + LedgerConfig (..), + apiHostParser, + apiPortParser, + cardanoVerificationKeyFileParser, + defaultLedgerConfig, + genChainPoint, + genDirPath, + genFilePath, + hostParser, + hydraSigningKeyFileParser, + hydraVerificationKeyFileParser, + ledgerConfigParser, + monitoringPortParser, + persistenceDirParser, + portParser, + verbosityParser, + ) +import Hydra.Options.Offline ( + OfflineConfig (..), + RunOfflineOptions (..), + defaultOfflineConfig, + offlineOptionsParser, + runOfflineOptionsParser, + validateRunOfflineOptions, + ) +import Hydra.Options.Online ( + ChainConfig (..), + RunOptions (..), + cardanoSigningKeyFileParser, + defaultChainConfig, + defaultContestationPeriod, + networkIdParser, + nodeSocketParser, + runOptionsParser, + startChainFromParser, + toArgNetworkId, + toArgs, + validateRunOptions, + ) +import Hydra.Options.Online qualified as OnlineOptions import Hydra.Version (embeddedRevision, gitRevision, unknownVersion) import Options.Applicative ( Parser, ParserInfo, ParserResult (..), - auto, command, - completer, defaultPrefs, - eitherReader, execParserPure, - flag, - flag', footer, fullDesc, handleParseResult, @@ -58,27 +79,21 @@ import Options.Applicative ( hsubparser, info, infoOption, - listCompleter, long, - maybeReader, metavar, - option, progDesc, progDescDoc, renderFailure, - short, - showDefault, strOption, subparser, value, ) -import Options.Applicative.Builder (str) import Options.Applicative.Help (vsep) import Paths_hydra_node (version) -import Test.QuickCheck (elements, listOf, listOf1, oneof, suchThat, vectorOf) data Command - = Run RunOptions + = Run OnlineOptions.RunOptions + | RunOffline RunOfflineOptions | Publish PublishOptions | GenHydraKey GenerateKeyPair deriving stock (Show, Eq) @@ -87,6 +102,7 @@ commandParser :: Parser Command commandParser = asum [ Run <$> runOptionsParser + , RunOffline <$> runOfflineOptionsParser , Publish <$> publishScriptsParser , GenHydraKey <$> genHydraKeyParser ] @@ -135,85 +151,6 @@ publishOptionsParser = <*> nodeSocketParser <*> cardanoSigningKeyFileParser -data RunOptions = RunOptions - { verbosity :: Verbosity - , nodeId :: NodeId - , -- NOTE: Why not a 'Host'? - host :: IP - , port :: PortNumber - , peers :: [Host] - , apiHost :: IP - , apiPort :: PortNumber - , monitoringPort :: Maybe PortNumber - , hydraSigningKey :: FilePath - , hydraVerificationKeys :: [FilePath] - , hydraScriptsTxId :: TxId - , persistenceDir :: FilePath - , chainConfig :: ChainConfig - , ledgerConfig :: LedgerConfig - } - deriving stock (Eq, Show, Generic) - deriving anyclass (ToJSON, FromJSON) - --- Orphan instance -instance Arbitrary IP where - arbitrary = IPv4 . toIPv4w <$> arbitrary - shrink = genericShrink - -instance Arbitrary RunOptions where - arbitrary = do - verbosity <- elements [Quiet, Verbose "HydraNode"] - nodeId <- arbitrary - host <- arbitrary - port <- arbitrary - peers <- reasonablySized arbitrary - apiHost <- arbitrary - apiPort <- arbitrary - monitoringPort <- arbitrary - hydraSigningKey <- genFilePath "sk" - hydraVerificationKeys <- reasonablySized (listOf (genFilePath "vk")) - hydraScriptsTxId <- arbitrary - persistenceDir <- genDirPath - chainConfig <- arbitrary - ledgerConfig <- arbitrary - pure $ - RunOptions - { verbosity - , nodeId - , host - , port - , peers - , apiHost - , apiPort - , monitoringPort - , hydraSigningKey - , hydraVerificationKeys - , hydraScriptsTxId - , persistenceDir - , chainConfig - , ledgerConfig - } - - shrink = genericShrink - -runOptionsParser :: Parser RunOptions -runOptionsParser = - RunOptions - <$> verbosityParser - <*> nodeIdParser - <*> hostParser - <*> portParser - <*> many peerParser - <*> apiHostParser - <*> apiPortParser - <*> optional monitoringPortParser - <*> hydraSigningKeyFileParser - <*> many hydraVerificationKeyFileParser - <*> hydraScriptsTxIdParser - <*> persistenceDirParser - <*> chainConfigParser - <*> ledgerConfigParser - newtype GenerateKeyPair = GenerateKeyPair { outputFile :: FilePath } @@ -239,335 +176,6 @@ outputFileParser = <> help "Basename of files to generate key-pair into. Signing key will be suffixed '.sk' and verification key '.vk'" ) -newtype LedgerConfig = CardanoLedgerConfig - { cardanoLedgerProtocolParametersFile :: FilePath - } - deriving stock (Eq, Show, Generic) - deriving anyclass (ToJSON, FromJSON) - -defaultLedgerConfig :: LedgerConfig -defaultLedgerConfig = - CardanoLedgerConfig - { cardanoLedgerProtocolParametersFile = "protocol-parameters.json" - } - -instance Arbitrary LedgerConfig where - arbitrary = do - cardanoLedgerProtocolParametersFile <- genFilePath ".json" - pure $ CardanoLedgerConfig{cardanoLedgerProtocolParametersFile} - -ledgerConfigParser :: Parser LedgerConfig -ledgerConfigParser = - CardanoLedgerConfig - <$> cardanoLedgerProtocolParametersParser - -cardanoLedgerProtocolParametersParser :: Parser FilePath -cardanoLedgerProtocolParametersParser = - strOption - ( long "ledger-protocol-parameters" - <> metavar "FILE" - <> value "protocol-parameters.json" - <> showDefault - <> help - "Path to protocol parameters used in the Hydra Head. \ - \See manual how to configure this." - ) - -data ChainConfig = DirectChainConfig - { networkId :: NetworkId - -- ^ Network identifer to which we expect to connect. - , nodeSocket :: SocketPath - -- ^ Path to a domain socket used to connect to the server. - , cardanoSigningKey :: FilePath - -- ^ Path to the cardano signing key of the internal wallet. - , cardanoVerificationKeys :: [FilePath] - -- ^ Paths to other node's verification keys. - , startChainFrom :: Maybe ChainPoint - -- ^ Point at which to start following the chain. - , contestationPeriod :: ContestationPeriod - } - deriving stock (Eq, Show, Generic) - deriving anyclass (ToJSON, FromJSON) - -defaultChainConfig :: ChainConfig -defaultChainConfig = - DirectChainConfig - { networkId = Testnet (NetworkMagic 42) - , nodeSocket = "node.socket" - , cardanoSigningKey = "cardano.sk" - , cardanoVerificationKeys = [] - , startChainFrom = Nothing - , contestationPeriod = defaultContestationPeriod - } - -instance Arbitrary ChainConfig where - arbitrary = do - networkId <- Testnet . NetworkMagic <$> arbitrary - nodeSocket <- File <$> genFilePath "socket" - cardanoSigningKey <- genFilePath ".sk" - cardanoVerificationKeys <- reasonablySized (listOf (genFilePath ".vk")) - startChainFrom <- oneof [pure Nothing, Just <$> genChainPoint] - contestationPeriod <- arbitrary `suchThat` (> UnsafeContestationPeriod 0) - pure $ - DirectChainConfig - { networkId - , nodeSocket - , cardanoSigningKey - , cardanoVerificationKeys - , startChainFrom - , contestationPeriod - } - -chainConfigParser :: Parser ChainConfig -chainConfigParser = - DirectChainConfig - <$> networkIdParser - <*> nodeSocketParser - <*> cardanoSigningKeyFileParser - <*> many cardanoVerificationKeyFileParser - <*> optional startChainFromParser - <*> contestationPeriodParser - -networkIdParser :: Parser NetworkId -networkIdParser = pMainnet <|> fmap Testnet pTestnetMagic - where - pMainnet :: Parser NetworkId - pMainnet = - flag' - Mainnet - ( long "mainnet" - <> help "Use the mainnet magic id." - ) - - pTestnetMagic :: Parser NetworkMagic - pTestnetMagic = - NetworkMagic - <$> option - auto - ( long "testnet-magic" - <> metavar "NATURAL" - <> value 42 - <> showDefault - <> completer (listCompleter ["1", "2", "42"]) - <> help - "Network identifier for a testnet to connect to. We only need to \ - \provide the magic number here. For example: '2' is the 'preview' \ - \network. See https://book.world.dev.cardano.org/environments.html for available networks." - ) - -nodeSocketParser :: Parser SocketPath -nodeSocketParser = - strOption - ( long "node-socket" - <> metavar "FILE" - <> value "node.socket" - <> showDefault - <> help - "Filepath to local unix domain socket used to communicate with \ - \the cardano node." - ) - -cardanoSigningKeyFileParser :: Parser FilePath -cardanoSigningKeyFileParser = - strOption - ( long "cardano-signing-key" - <> metavar "FILE" - <> showDefault - <> value "cardano.sk" - <> help - "Cardano signing key of our hydra-node. This will be used to authorize \ - \Hydra protocol transactions for heads the node takes part in and any \ - \funds owned by this key will be used as 'fuel'." - ) - -cardanoVerificationKeyFileParser :: Parser FilePath -cardanoVerificationKeyFileParser = - option - str - ( long "cardano-verification-key" - <> metavar "FILE" - <> help - ( "Cardano verification key of another party in the Head. Can be \ - \provided multiple times, once for each participant (current maximum limit is " - <> show maximumNumberOfParties - <> ")." - ) - ) - -hydraSigningKeyFileParser :: Parser FilePath -hydraSigningKeyFileParser = - option - str - ( long "hydra-signing-key" - <> metavar "FILE" - <> value "hydra.sk" - <> showDefault - <> help "Hydra signing key used by our hydra-node." - ) - -hydraVerificationKeyFileParser :: Parser FilePath -hydraVerificationKeyFileParser = - option - str - ( long "hydra-verification-key" - <> metavar "FILE" - <> help - ( "Hydra verification key of another party in the Head. Can be \ - \provided multiple times, once for each participant (current maximum limit is " - <> show maximumNumberOfParties - <> " )." - ) - ) - -peerParser :: Parser Host -peerParser = - option - (maybeReader readHost) - ( long "peer" - <> short 'P' - <> help - ( "A peer address in the form :, where can be an IP \ - \address, or a host name. Can be provided multiple times, once for \ - \each peer (current maximum limit is " - <> show maximumNumberOfParties - <> " peers)." - ) - ) - -nodeIdParser :: Parser NodeId -nodeIdParser = - option - str - ( long "node-id" - <> short 'n' - <> metavar "NODE-ID" - <> help - "The Hydra node identifier used on the Hydra network. It is \ - \important to have a unique identifier in order to be able to \ - \distinguish between connected peers." - ) - -verbosityParser :: Parser Verbosity -verbosityParser = - flag - (Verbose "HydraNode") - Quiet - ( long "quiet" - <> short 'q' - <> help "Turns off logging." - ) - -hostParser :: Parser IP -hostParser = - option - auto - ( long "host" - <> short 'h' - -- XXX: This is default does not make sense, should use 0.0.0.0. - <> value "127.0.0.1" - <> showDefault - <> metavar "IP" - <> help "Listen address for incoming Hydra network connections." - ) - -portParser :: Parser PortNumber -portParser = - option - (maybeReader readPort) - ( long "port" - <> short 'p' - <> value 5001 - <> showDefault - <> metavar "PORT" - <> help "Listen port for incoming Hydra network connections." - ) - -apiHostParser :: Parser IP -apiHostParser = - option - auto - ( long "api-host" - <> value "127.0.0.1" - <> metavar "IP" - <> showDefault - <> help "Listen address for incoming client API connections." - ) - -apiPortParser :: Parser PortNumber -apiPortParser = - option - (maybeReader readPort) - ( long "api-port" - <> value 4001 - <> showDefault - <> metavar "PORT" - <> help "Listen port for incoming client API connections." - ) - -monitoringPortParser :: Parser PortNumber -monitoringPortParser = - option - (maybeReader readPort) - ( long "monitoring-port" - <> metavar "PORT" - <> help - "Listen port for monitoring and metrics via prometheus. If left \ - \empty, monitoring server is not started." - ) - -startChainFromParser :: Parser ChainPoint -startChainFromParser = - option - (maybeReader readChainPoint) - ( long "start-chain-from" - <> metavar "SLOT.HEADER_HASH" - <> help - "The id of the block we want to start observing the chain from. \ - \If not given, uses the chain tip at startup. Composed by the slot \ - \number, a separator ('.') and the hash of the block header. \ - \For example: 52970883.d36a9936ae7a07f5f4bdc9ad0b23761cb7b14f35007e54947e27a1510f897f04." - ) - where - readChainPoint :: String -> Maybe ChainPoint - readChainPoint = \case - "0" -> Just ChainPointAtGenesis - chainPointStr -> - case T.splitOn "." (toText chainPointStr) of - [slotNoTxt, headerHashTxt] -> do - slotNo <- SlotNo <$> readMaybe (toString slotNoTxt) - headerHash <- - either (const Nothing) Just $ - deserialiseFromRawBytesHex (proxyToAsType Proxy) (encodeUtf8 headerHashTxt) - pure $ ChainPoint slotNo headerHash - _emptyOrSingularList -> - Nothing - -hydraScriptsTxIdParser :: Parser TxId -hydraScriptsTxIdParser = - option - (eitherReader $ left show . deserialiseFromRawBytesHex AsTxId . BSC.pack) - ( long "hydra-scripts-tx-id" - <> metavar "TXID" - <> value "0101010101010101010101010101010101010101010101010101010101010101" - <> help - "The transaction which is expected to have published Hydra scripts as \ - \reference scripts in its outputs. Note: All scripts need to be in the \ - \first 10 outputs. See release notes for pre-published versions. You \ - \can use the 'publish-scripts' sub-command to publish them yourself." - ) - -persistenceDirParser :: Parser FilePath -persistenceDirParser = - option - str - ( long "persistence-dir" - <> metavar "DIR" - <> value "./" - <> help - "The directory where the Hydra Head state is stored.\ - \Do not edit these files manually!" - ) - hydraNodeCommand :: ParserInfo Command hydraNodeCommand = info @@ -601,55 +209,6 @@ hydraNodeVersion = <|> gitRevision <|> Just unknownVersion -defaultContestationPeriod :: ContestationPeriod -defaultContestationPeriod = UnsafeContestationPeriod 60 - -contestationPeriodParser :: Parser ContestationPeriod -contestationPeriodParser = - option - (parseNatural <|> parseNominalDiffTime) - ( long "contestation-period" - <> metavar "SECONDS" - <> value defaultContestationPeriod - <> showDefault - <> completer (listCompleter ["60", "180", "300"]) - <> help - "Contestation period for close transaction in seconds. \ - \ If this value is not in sync with other participants hydra-node will ignore the initial tx.\ - \ Additionally, this value needs to make sense compared to the current network we are running." - ) - where - parseNatural = UnsafeContestationPeriod <$> auto - - parseNominalDiffTime = - auto >>= \dt -> do - let s = nominalDiffTimeToSeconds dt - if s <= 0 - then fail "negative contestation period" - else pure $ UnsafeContestationPeriod $ truncate s - -data InvalidOptions - = MaximumNumberOfPartiesExceeded - | CardanoAndHydraKeysMissmatch - deriving stock (Eq, Show) - --- | Validate cmd line arguments for hydra-node and check if they make sense before actually running the node. --- Rules we apply: --- - Check if number of parties is bigger than our hardcoded limit --- (by looking at loaded hydra or cardano keys and comparing it to the 'maximumNumberOfParties') --- - Check that number of loaded hydra keys match with the number of loaded cardano keys --- (by comparing lengths of the two lists) -validateRunOptions :: RunOptions -> Either InvalidOptions () -validateRunOptions RunOptions{hydraVerificationKeys, chainConfig} - | numberOfOtherParties + 1 > maximumNumberOfParties = Left MaximumNumberOfPartiesExceeded - | length (cardanoVerificationKeys chainConfig) /= length hydraVerificationKeys = - Left CardanoAndHydraKeysMissmatch - | otherwise = Right () - where - -- let's take the higher number of loaded cardano/hydra keys - numberOfOtherParties = - max (length hydraVerificationKeys) (length $ cardanoVerificationKeys chainConfig) - -- | Parse command-line arguments into a `Option` or exit with failure and error message. parseHydraCommand :: IO Command parseHydraCommand = getArgs <&> parseHydraCommandFromArgs >>= handleParseResult @@ -657,125 +216,3 @@ parseHydraCommand = getArgs <&> parseHydraCommandFromArgs >>= handleParseResult -- | Pure parsing of `Option` from a list of arguments. parseHydraCommandFromArgs :: [String] -> ParserResult Command parseHydraCommandFromArgs = execParserPure defaultPrefs hydraNodeCommand - --- | Convert an 'Options' instance into the corresponding list of command-line arguments. --- --- This is useful in situations where one wants to programatically define 'Options', providing --- some measure of type safety, without having to juggle with strings. -toArgs :: RunOptions -> [String] -toArgs - RunOptions - { verbosity - , nodeId - , host - , port - , peers - , apiHost - , apiPort - , monitoringPort - , hydraSigningKey - , hydraVerificationKeys - , hydraScriptsTxId - , persistenceDir - , chainConfig - , ledgerConfig - } = - isVerbose verbosity - <> ["--node-id", unpack nId] - <> ["--host", show host] - <> ["--port", show port] - <> ["--api-host", show apiHost] - <> ["--api-port", show apiPort] - <> ["--hydra-signing-key", hydraSigningKey] - <> concatMap (\vk -> ["--hydra-verification-key", vk]) hydraVerificationKeys - <> concatMap toArgPeer peers - <> maybe [] (\mport -> ["--monitoring-port", show mport]) monitoringPort - <> ["--hydra-scripts-tx-id", toString $ serialiseToRawBytesHexText hydraScriptsTxId] - <> ["--persistence-dir", persistenceDir] - <> argsChainConfig - <> argsLedgerConfig - where - (NodeId nId) = nodeId - isVerbose = \case - Quiet -> ["--quiet"] - _ -> [] - - toArgPeer p = - ["--peer", show p] - - toArgStartChainFrom = \case - Just ChainPointAtGenesis -> - error "ChainPointAtGenesis" - Just (ChainPoint (SlotNo slotNo) headerHash) -> - let headerHashBase16 = toString (serialiseToRawBytesHexText headerHash) - in ["--start-chain-from", show slotNo <> "." <> headerHashBase16] - Nothing -> - [] - - argsChainConfig = - toArgNetworkId networkId - <> ["--node-socket", unFile nodeSocket] - <> ["--cardano-signing-key", cardanoSigningKey] - <> ["--contestation-period", show contestationPeriod] - <> concatMap (\vk -> ["--cardano-verification-key", vk]) cardanoVerificationKeys - <> toArgStartChainFrom startChainFrom - - argsLedgerConfig = - ["--ledger-protocol-parameters", cardanoLedgerProtocolParametersFile] - - CardanoLedgerConfig - { cardanoLedgerProtocolParametersFile - } = ledgerConfig - - DirectChainConfig - { networkId - , nodeSocket - , cardanoSigningKey - , cardanoVerificationKeys - , startChainFrom - , contestationPeriod - } = chainConfig - -defaultRunOptions :: RunOptions -defaultRunOptions = - RunOptions - { verbosity = Verbose "HydraNode" - , nodeId = NodeId "hydra-node-1" - , host = localhost - , port = 5001 - , peers = [] - , apiHost = localhost - , apiPort = 4001 - , monitoringPort = Nothing - , hydraSigningKey = "hydra.sk" - , hydraVerificationKeys = [] - , hydraScriptsTxId = TxId "0101010101010101010101010101010101010101010101010101010101010101" - , persistenceDir = "./" - , chainConfig = defaultChainConfig - , ledgerConfig = defaultLedgerConfig - } - where - localhost = IPv4 $ toIPv4 [127, 0, 0, 1] - -toArgNetworkId :: NetworkId -> [String] -toArgNetworkId = \case - Mainnet -> ["--mainnet"] - Testnet (NetworkMagic magic) -> ["--testnet-magic", show magic] - -genFilePath :: String -> Gen FilePath -genFilePath extension = do - path <- reasonablySized (listOf1 (elements ["a", "b", "c"])) - pure $ intercalate "/" path <> "." <> extension - -genDirPath :: Gen FilePath -genDirPath = do - path <- reasonablySized (listOf1 (elements ["a", "b", "c"])) - pure $ intercalate "/" path - -genChainPoint :: Gen ChainPoint -genChainPoint = ChainPoint <$> (SlotNo <$> arbitrary) <*> someHeaderHash - where - someHeaderHash = do - bytes <- vectorOf 32 arbitrary - let hash = either (error "invalid bytes") id $ deserialiseFromRawBytes (proxyToAsType Proxy) . BS.pack $ bytes - pure hash diff --git a/hydra-node/src/Hydra/Options/Common.hs b/hydra-node/src/Hydra/Options/Common.hs new file mode 100644 index 00000000000..64db9a66605 --- /dev/null +++ b/hydra-node/src/Hydra/Options/Common.hs @@ -0,0 +1,219 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module Hydra.Options.Common ( + module Hydra.Options.Common, +) where + +import Hydra.Cardano.Api ( + ChainPoint (..), + SlotNo (..), + deserialiseFromRawBytes, + proxyToAsType, + ) +import Hydra.Prelude + +import Hydra.Chain (maximumNumberOfParties) +import Hydra.Ledger.Cardano () +import Hydra.Logging (Verbosity (..)) +import Hydra.Network (PortNumber, readPort) + +import Data.ByteString qualified as BS +import Data.IP (IP (IPv4), toIPv4w) +import Options.Applicative ( + Parser, + auto, + flag, + help, + long, + maybeReader, + metavar, + option, + short, + showDefault, + str, + strOption, + value, + ) + +import Test.QuickCheck (elements, listOf1, vectorOf) + +newtype LedgerConfig = CardanoLedgerConfig + { cardanoLedgerProtocolParametersFile :: FilePath + } + deriving stock (Eq, Show, Generic) + deriving anyclass (ToJSON, FromJSON) + +defaultLedgerConfig :: LedgerConfig +defaultLedgerConfig = + CardanoLedgerConfig + { cardanoLedgerProtocolParametersFile = "protocol-parameters.json" + } + +instance Arbitrary LedgerConfig where + arbitrary = do + cardanoLedgerProtocolParametersFile <- genFilePath ".json" + pure $ CardanoLedgerConfig{cardanoLedgerProtocolParametersFile} + +ledgerConfigParser :: Parser LedgerConfig +ledgerConfigParser = + CardanoLedgerConfig + <$> cardanoLedgerProtocolParametersParser + +cardanoLedgerProtocolParametersParser :: Parser FilePath +cardanoLedgerProtocolParametersParser = + strOption + ( long "ledger-protocol-parameters" + <> metavar "FILE" + <> value "protocol-parameters.json" + <> showDefault + <> help + "Path to protocol parameters used in the Hydra Head. \ + \See manual how to configure this." + ) + +verbosityParser :: Parser Verbosity +verbosityParser = + flag + (Verbose "HydraNode") + Quiet + ( long "quiet" + <> short 'q' + <> help "Turns off logging." + ) + +genFilePath :: String -> Gen FilePath +genFilePath extension = do + path <- reasonablySized (listOf1 (elements ["a", "b", "c"])) + pure $ intercalate "/" path <> "." <> extension + +genDirPath :: Gen FilePath +genDirPath = do + path <- reasonablySized (listOf1 (elements ["a", "b", "c"])) + pure $ intercalate "/" path + +genChainPoint :: Gen ChainPoint +genChainPoint = ChainPoint <$> (SlotNo <$> arbitrary) <*> someHeaderHash + where + someHeaderHash = do + bytes <- vectorOf 32 arbitrary + let hash = either (error "invalid bytes") id $ deserialiseFromRawBytes (proxyToAsType Proxy) . BS.pack $ bytes + pure hash + +cardanoVerificationKeyFileParser :: Parser FilePath +cardanoVerificationKeyFileParser = + option + str + ( long "cardano-verification-key" + <> metavar "FILE" + <> help + ( "Cardano verification key of another party in the Head. Can be \ + \provided multiple times, once for each participant (current maximum limit is " + <> show maximumNumberOfParties + <> ")." + ) + ) + +hydraSigningKeyFileParser :: Parser FilePath +hydraSigningKeyFileParser = + option + str + ( long "hydra-signing-key" + <> metavar "FILE" + <> value "hydra.sk" + <> showDefault + <> help "Hydra signing key used by our hydra-node." + ) + +hydraVerificationKeyFileParser :: Parser FilePath +hydraVerificationKeyFileParser = + option + str + ( long "hydra-verification-key" + <> metavar "FILE" + <> help + ( "Hydra verification key of another party in the Head. Can be \ + \provided multiple times, once for each participant (current maximum limit is " + <> show maximumNumberOfParties + <> " )." + ) + ) + +hostParser :: Parser IP +hostParser = + option + auto + ( long "host" + <> short 'h' + -- XXX: This is default does not make sense, should use 0.0.0.0. + <> value "127.0.0.1" + <> showDefault + <> metavar "IP" + <> help "Listen address for incoming Hydra network connections." + ) + +portParser :: Parser PortNumber +portParser = + option + (maybeReader readPort) + ( long "port" + <> short 'p' + <> value 5001 + <> showDefault + <> metavar "PORT" + <> help "Listen port for incoming Hydra network connections." + ) + +apiHostParser :: Parser IP +apiHostParser = + option + auto + ( long "api-host" + <> value "127.0.0.1" + <> metavar "IP" + <> showDefault + <> help "Listen address for incoming client API connections." + ) + +apiPortParser :: Parser PortNumber +apiPortParser = + option + (maybeReader readPort) + ( long "api-port" + <> value 4001 + <> showDefault + <> metavar "PORT" + <> help "Listen port for incoming client API connections." + ) + +monitoringPortParser :: Parser PortNumber +monitoringPortParser = + option + (maybeReader readPort) + ( long "monitoring-port" + <> metavar "PORT" + <> help + "Listen port for monitoring and metrics via prometheus. If left \ + \empty, monitoring server is not started." + ) + +persistenceDirParser :: Parser FilePath +persistenceDirParser = + option + str + ( long "persistence-dir" + <> metavar "DIR" + <> value "./" + <> help + "The directory where the Hydra Head state is stored.\ + \Do not edit these files manually!" + ) + +data InvalidOptions + = MaximumNumberOfPartiesExceeded + | CardanoAndHydraKeysMissmatch + deriving stock (Eq, Show) + +-- Orphan instance +instance Arbitrary IP where + arbitrary = IPv4 . toIPv4w <$> arbitrary + shrink = genericShrink diff --git a/hydra-node/src/Hydra/Options/Offline.hs b/hydra-node/src/Hydra/Options/Offline.hs new file mode 100644 index 00000000000..3a61aa643f6 --- /dev/null +++ b/hydra-node/src/Hydra/Options/Offline.hs @@ -0,0 +1,207 @@ +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE RecordWildCards #-} + +module Hydra.Options.Offline where + +import Hydra.Prelude + +import Hydra.Logging (Verbosity (..)) +import Hydra.Network (PortNumber) +import Hydra.Options.Common ( + InvalidOptions (MaximumNumberOfPartiesExceeded), + LedgerConfig (..), + apiHostParser, + apiPortParser, + genDirPath, + genFilePath, + hostParser, + hydraSigningKeyFileParser, + hydraVerificationKeyFileParser, + ledgerConfigParser, + monitoringPortParser, + persistenceDirParser, + portParser, + verbosityParser, + ) + +import Data.IP (IP (..)) +import Options.Applicative ( + Parser, + command, + help, + info, + long, + metavar, + option, + progDesc, + showDefault, + str, + subparser, + value, + ) +import Options.Applicative.Extra (helper) +import Test.QuickCheck (listOf) +import Test.QuickCheck.Gen (elements, oneof) + +data RunOfflineOptions = RunOfflineOptions + { verbosity :: Verbosity + , host :: IP + , port :: PortNumber + , apiHost :: IP + , apiPort :: PortNumber + , monitoringPort :: Maybe PortNumber + , hydraSigningKey :: FilePath + , hydraVerificationKeys :: [FilePath] -- under normal configuration this should be a singleton + , persistenceDir :: FilePath + , ledgerConfig :: LedgerConfig + , offlineConfig :: OfflineConfig + } + deriving stock (Eq, Show, Generic) + deriving anyclass (ToJSON, FromJSON) + +-- | Convert an 'Options' instance into the corresponding list of command-line arguments. +-- +-- This is useful in situations where one wants to programatically define 'Options', providing +-- some measure of type safety, without having to juggle with strings. +toArgs :: RunOfflineOptions -> [String] +toArgs + RunOfflineOptions + { verbosity + , host + , port + , apiHost + , apiPort + , monitoringPort + , hydraSigningKey + , hydraVerificationKeys + , persistenceDir + , ledgerConfig + , offlineConfig + } = + ["offline"] + <> isVerbose verbosity + <> ["--host", show host] + <> ["--port", show port] + <> ["--api-host", show apiHost] + <> ["--api-port", show apiPort] + <> ["--hydra-signing-key", hydraSigningKey] + <> concatMap (\vk -> ["--hydra-verification-key", vk]) hydraVerificationKeys + <> maybe [] (\mport -> ["--monitoring-port", show mport]) monitoringPort + <> ["--persistence-dir", persistenceDir] + <> argsLedgerConfig + <> argsOfflineConfig + where + isVerbose = \case + Quiet -> ["--quiet"] + _ -> [] + + argsLedgerConfig = + ["--ledger-protocol-parameters", cardanoLedgerProtocolParametersFile] + + CardanoLedgerConfig + { cardanoLedgerProtocolParametersFile + } = ledgerConfig + + argsOfflineConfig = + ["--initial-utxo", initialUTxOFile offlineConfig] + <> maybe [] (\s -> ["--ledger-genesis", s]) (ledgerGenesisFile offlineConfig) + +instance Arbitrary OfflineConfig where + arbitrary = do + ledgerGenesisFile <- oneof [pure Nothing, Just <$> genFilePath "ledgerGenesis"] + initialUTxOFile <- genFilePath "utxo.json" + + pure $ + OfflineConfig + { initialUTxOFile + , ledgerGenesisFile + } + + shrink = genericShrink + +instance Arbitrary RunOfflineOptions where + arbitrary = do + verbosity <- elements [Quiet, Verbose "HydraNode"] + host <- arbitrary + port <- arbitrary + apiHost <- arbitrary + apiPort <- arbitrary + monitoringPort <- arbitrary + hydraSigningKey <- genFilePath "sk" + hydraVerificationKeys <- reasonablySized (listOf (genFilePath "vk")) + persistenceDir <- genDirPath + ledgerConfig <- arbitrary + offlineConfig <- arbitrary + pure RunOfflineOptions{..} + shrink = genericShrink + +validateRunOfflineOptions :: RunOfflineOptions -> Either InvalidOptions () +validateRunOfflineOptions RunOfflineOptions{hydraVerificationKeys} + | numberOfOtherParties > 0 = Left MaximumNumberOfPartiesExceeded + | otherwise = Right () + where + numberOfOtherParties = length hydraVerificationKeys + +runOfflineOptionsParser :: Parser RunOfflineOptions +runOfflineOptionsParser = + subparser $ + command "offline" $ + info + ( helper + <*> ( RunOfflineOptions + <$> verbosityParser + <*> hostParser + <*> portParser + <*> apiHostParser + <*> apiPortParser + <*> optional monitoringPortParser + <*> hydraSigningKeyFileParser + <*> many hydraVerificationKeyFileParser + <*> persistenceDirParser + <*> ledgerConfigParser + <*> offlineOptionsParser + ) + ) + (progDesc "Run Hydra Head in offline mode.") + +data OfflineConfig = OfflineConfig + { initialUTxOFile :: FilePath + , ledgerGenesisFile :: Maybe FilePath + } + deriving (Eq, Show, Generic, FromJSON, ToJSON) + +defaultOfflineConfig :: OfflineConfig +defaultOfflineConfig = + OfflineConfig + { initialUTxOFile = "utxo.json" + , ledgerGenesisFile = Nothing + } + +offlineOptionsParser :: Parser OfflineConfig +offlineOptionsParser = + OfflineConfig + <$> initialUTxOFileParser + <*> ledgerGenesisFileParser + +initialUTxOFileParser :: Parser FilePath +initialUTxOFileParser = + option + str + ( long "initial-utxo" + <> metavar "FILE" + <> value "utxo.json" + <> showDefault + <> help "File containing initial UTxO for the L2 chain." + ) + +ledgerGenesisFileParser :: Parser (Maybe FilePath) +ledgerGenesisFileParser = + option + (optional str) + ( long "ledger-genesis" + <> metavar "FILE" + <> value Nothing + <> showDefault + <> help "File containing ledger genesis parameters." + ) diff --git a/hydra-node/src/Hydra/Options/Online.hs b/hydra-node/src/Hydra/Options/Online.hs new file mode 100644 index 00000000000..e76b073fd88 --- /dev/null +++ b/hydra-node/src/Hydra/Options/Online.hs @@ -0,0 +1,470 @@ +module Hydra.Options.Online where + +import Hydra.Cardano.Api ( + AsType (..), + ChainPoint (..), + File (..), + HasTypeProxy (proxyToAsType), + NetworkId (Mainnet, Testnet), + NetworkMagic (NetworkMagic), + SlotNo (..), + SocketPath, + TxId (..), + deserialiseFromRawBytesHex, + serialiseToRawBytesHexText, + ) +import Hydra.ContestationPeriod (ContestationPeriod (..)) +import Hydra.Prelude + +import Hydra.Options.Common ( + InvalidOptions (..), + LedgerConfig (..), + apiHostParser, + apiPortParser, + cardanoVerificationKeyFileParser, + defaultLedgerConfig, + genChainPoint, + genDirPath, + genFilePath, + hostParser, + hydraSigningKeyFileParser, + hydraVerificationKeyFileParser, + ledgerConfigParser, + monitoringPortParser, + persistenceDirParser, + portParser, + verbosityParser, + ) + +import Options.Applicative ( + Parser, + auto, + completer, + eitherReader, + flag', + help, + listCompleter, + long, + maybeReader, + metavar, + option, + short, + showDefault, + strOption, + value, + ) + +import Hydra.Chain (maximumNumberOfParties) +import Hydra.Ledger.Cardano () +import Hydra.Logging (Verbosity (..)) +import Hydra.Network (Host, NodeId (NodeId), PortNumber, readHost) + +import Control.Arrow (left) +import Data.ByteString.Char8 qualified as BSC +import Data.IP (IP (IPv4), toIPv4) +import Data.Text (unpack) +import Data.Text qualified as T +import Data.Time.Clock (nominalDiffTimeToSeconds) +import Options.Applicative.Builder (str) + +import Test.QuickCheck (elements, listOf, oneof, suchThat) + +data ChainConfig = DirectChainConfig -- rename type constructor to directchainconfig + { networkId :: NetworkId + -- ^ Network identifer to which we expect to connect. + , nodeSocket :: SocketPath + -- ^ Path to a domain socket used to connect to the server. + , cardanoSigningKey :: FilePath + -- ^ Path to the cardano signing key of the internal wallet. + , cardanoVerificationKeys :: [FilePath] + -- ^ Paths to other node's verification keys. + , startChainFrom :: Maybe ChainPoint + -- ^ Point at which to start following the chain. + , contestationPeriod :: ContestationPeriod + } + deriving stock (Eq, Show, Generic) + deriving anyclass (ToJSON, FromJSON) + +defaultChainConfig :: ChainConfig +defaultChainConfig = + DirectChainConfig + { networkId = Testnet (NetworkMagic 42) + , nodeSocket = "node.socket" + , cardanoSigningKey = "cardano.sk" + , cardanoVerificationKeys = [] + , startChainFrom = Nothing + , contestationPeriod = defaultContestationPeriod + } + +instance Arbitrary ChainConfig where + arbitrary = do + networkId <- Testnet . NetworkMagic <$> arbitrary + nodeSocket <- File <$> genFilePath "socket" + cardanoSigningKey <- genFilePath ".sk" + cardanoVerificationKeys <- reasonablySized (listOf (genFilePath ".vk")) + startChainFrom <- oneof [pure Nothing, Just <$> genChainPoint] + contestationPeriod <- arbitrary `suchThat` (> UnsafeContestationPeriod 0) + pure $ + DirectChainConfig + { networkId + , nodeSocket + , cardanoSigningKey + , cardanoVerificationKeys + , startChainFrom + , contestationPeriod + } + +chainConfigParser :: Parser ChainConfig +chainConfigParser = + DirectChainConfig + <$> networkIdParser + <*> nodeSocketParser + <*> cardanoSigningKeyFileParser + <*> many cardanoVerificationKeyFileParser + <*> optional startChainFromParser + <*> contestationPeriodParser + +networkIdParser :: Parser NetworkId +networkIdParser = pMainnet <|> fmap Testnet pTestnetMagic + where + pMainnet :: Parser NetworkId + pMainnet = + flag' + Mainnet + ( long "mainnet" + <> help "Use the mainnet magic id." + ) + + pTestnetMagic :: Parser NetworkMagic + pTestnetMagic = + NetworkMagic + <$> option + auto + ( long "testnet-magic" + <> metavar "NATURAL" + <> value 42 + <> showDefault + <> completer (listCompleter ["1", "2", "42"]) + <> help + "Network identifier for a testnet to connect to. We only need to \ + \provide the magic number here. For example: '2' is the 'preview' \ + \network. See https://book.world.dev.cardano.org/environments.html for available networks." + ) + +nodeSocketParser :: Parser SocketPath +nodeSocketParser = + strOption + ( long "node-socket" + <> metavar "FILE" + <> value "node.socket" + <> showDefault + <> help + "Filepath to local unix domain socket used to communicate with \ + \the cardano node." + ) + +peerParser :: Parser Host +peerParser = + option + (maybeReader readHost) + ( long "peer" + <> short 'P' + <> help + ( "A peer address in the form :, where can be an IP \ + \address, or a host name. Can be provided multiple times, once for \ + \each peer (current maximum limit is " + <> show maximumNumberOfParties + <> " peers)." + ) + ) + +nodeIdParser :: Parser NodeId +nodeIdParser = + option + str + ( long "node-id" + <> short 'n' + <> metavar "NODE-ID" + <> help + "The Hydra node identifier used on the Hydra network. It is \ + \important to have a unique identifier in order to be able to \ + \distinguish between connected peers." + ) + +startChainFromParser :: Parser ChainPoint +startChainFromParser = + option + (maybeReader readChainPoint) + ( long "start-chain-from" + <> metavar "SLOT.HEADER_HASH" + <> help + "The id of the block we want to start observing the chain from. \ + \If not given, uses the chain tip at startup. Composed by the slot \ + \number, a separator ('.') and the hash of the block header. \ + \For example: 52970883.d36a9936ae7a07f5f4bdc9ad0b23761cb7b14f35007e54947e27a1510f897f04." + ) + where + readChainPoint :: String -> Maybe ChainPoint + readChainPoint = \case + "0" -> Just ChainPointAtGenesis + chainPointStr -> + case T.splitOn "." (toText chainPointStr) of + [slotNoTxt, headerHashTxt] -> do + slotNo <- SlotNo <$> readMaybe (toString slotNoTxt) + headerHash <- + either (const Nothing) Just $ + deserialiseFromRawBytesHex (proxyToAsType Proxy) (encodeUtf8 headerHashTxt) + pure $ ChainPoint slotNo headerHash + _emptyOrSingularList -> + Nothing + +cardanoSigningKeyFileParser :: Parser FilePath +cardanoSigningKeyFileParser = + strOption + ( long "cardano-signing-key" + <> metavar "FILE" + <> showDefault + <> value "cardano.sk" + <> help + "Cardano signing key of our hydra-node. This will be used to authorize \ + \Hydra protocol transactions for heads the node takes part in and any \ + \funds owned by this key will be used as 'fuel'." + ) + +defaultContestationPeriod :: ContestationPeriod +defaultContestationPeriod = UnsafeContestationPeriod 60 + +contestationPeriodParser :: Parser ContestationPeriod +contestationPeriodParser = + option + (parseNatural <|> parseNominalDiffTime) + ( long "contestation-period" + <> metavar "SECONDS" + <> value defaultContestationPeriod + <> showDefault + <> completer (listCompleter ["60", "180", "300"]) + <> help + "Contestation period for close transaction in seconds. \ + \ If this value is not in sync with other participants hydra-node will ignore the initial tx.\ + \ Additionally, this value needs to make sense compared to the current network we are running." + ) + where + parseNatural = UnsafeContestationPeriod <$> auto + + parseNominalDiffTime = + auto >>= \dt -> do + let s = nominalDiffTimeToSeconds dt + if s <= 0 + then fail "negative contestation period" + else pure $ UnsafeContestationPeriod $ truncate s + +data RunOptions = RunOptions + { verbosity :: Verbosity + , nodeId :: NodeId + , -- NOTE: Why not a 'Host'? + host :: IP + , port :: PortNumber + , peers :: [Host] + , apiHost :: IP + , apiPort :: PortNumber + , monitoringPort :: Maybe PortNumber + , hydraSigningKey :: FilePath + , hydraVerificationKeys :: [FilePath] + , hydraScriptsTxId :: TxId + , persistenceDir :: FilePath + , chainConfig :: ChainConfig + , ledgerConfig :: LedgerConfig + } + deriving stock (Eq, Show, Generic) + deriving anyclass (ToJSON, FromJSON) + +-- | Convert an 'Options' instance into the corresponding list of command-line arguments. +-- +-- This is useful in situations where one wants to programatically define 'Options', providing +-- some measure of type safety, without having to juggle with strings. +toArgs :: RunOptions -> [String] +toArgs + RunOptions + { verbosity + , nodeId + , host + , port + , peers + , apiHost + , apiPort + , monitoringPort + , hydraSigningKey + , hydraVerificationKeys + , hydraScriptsTxId + , persistenceDir + , chainConfig + , ledgerConfig + } = + isVerbose verbosity + <> ["--node-id", unpack nId] + <> ["--host", show host] + <> ["--port", show port] + <> ["--api-host", show apiHost] + <> ["--api-port", show apiPort] + <> ["--hydra-signing-key", hydraSigningKey] + <> concatMap (\vk -> ["--hydra-verification-key", vk]) hydraVerificationKeys + <> concatMap toArgPeer peers + <> maybe [] (\mport -> ["--monitoring-port", show mport]) monitoringPort + <> ["--hydra-scripts-tx-id", toString $ serialiseToRawBytesHexText hydraScriptsTxId] + <> ["--persistence-dir", persistenceDir] + <> argsChainConfig + <> argsLedgerConfig + where + (NodeId nId) = nodeId + isVerbose = \case + Quiet -> ["--quiet"] + _ -> [] + + toArgPeer p = + ["--peer", show p] + + toArgStartChainFrom = \case + Just ChainPointAtGenesis -> + error "ChainPointAtGenesis" + Just (ChainPoint (SlotNo slotNo) headerHash) -> + let headerHashBase16 = toString (serialiseToRawBytesHexText headerHash) + in ["--start-chain-from", show slotNo <> "." <> headerHashBase16] + Nothing -> + [] + + argsChainConfig = + toArgNetworkId networkId + <> ["--node-socket", unFile nodeSocket] + <> ["--cardano-signing-key", cardanoSigningKey] + <> ["--contestation-period", show contestationPeriod] + <> concatMap (\vk -> ["--cardano-verification-key", vk]) cardanoVerificationKeys + <> toArgStartChainFrom startChainFrom + + argsLedgerConfig = + ["--ledger-protocol-parameters", cardanoLedgerProtocolParametersFile] + + CardanoLedgerConfig + { cardanoLedgerProtocolParametersFile + } = ledgerConfig + + DirectChainConfig + { networkId + , nodeSocket + , cardanoSigningKey + , cardanoVerificationKeys + , startChainFrom + , contestationPeriod + } = chainConfig + +-- | Validate cmd line arguments for hydra-node and check if they make sense before actually running the node. +-- Rules we apply: +-- - Check if number of parties is bigger than our hardcoded limit +-- (by looking at loaded hydra or cardano keys and comparing it to the 'maximumNumberOfParties') +-- - Check if number of parties is more than zero when running in offline mode +-- (by looking at loaded hydra or cardano keys and checking if the offline config is set) +-- - Check that number of loaded hydra keys match with the number of loaded cardano keys +-- (by comparing lengths of the two lists) +validateRunOptions :: RunOptions -> Either InvalidOptions () +validateRunOptions RunOptions{hydraVerificationKeys, chainConfig} + | numberOfOtherParties + 1 > maximumNumberOfParties = Left MaximumNumberOfPartiesExceeded + | length (cardanoVerificationKeys chainConfig) /= length hydraVerificationKeys = + Left CardanoAndHydraKeysMissmatch + | otherwise = Right () + where + -- let's take the higher number of loaded cardano/hydra keys + numberOfOtherParties = + max (length hydraVerificationKeys) (length $ cardanoVerificationKeys chainConfig) + +defaultRunOptions :: RunOptions +defaultRunOptions = + RunOptions + { verbosity = Verbose "HydraNode" + , nodeId = NodeId "hydra-node-1" + , host = localhost + , port = 5001 + , peers = [] + , apiHost = localhost + , apiPort = 4001 + , monitoringPort = Nothing + , hydraSigningKey = "hydra.sk" + , hydraVerificationKeys = [] + , hydraScriptsTxId = TxId "0101010101010101010101010101010101010101010101010101010101010101" + , persistenceDir = "./" + , chainConfig = defaultChainConfig + , ledgerConfig = defaultLedgerConfig + } + where + localhost = IPv4 $ toIPv4 [127, 0, 0, 1] + +instance Arbitrary RunOptions where + arbitrary = do + verbosity <- elements [Quiet, Verbose "HydraNode"] + nodeId <- arbitrary + host <- arbitrary + port <- arbitrary + peers <- reasonablySized arbitrary + apiHost <- arbitrary + apiPort <- arbitrary + monitoringPort <- arbitrary + hydraSigningKey <- genFilePath "sk" + hydraVerificationKeys <- reasonablySized (listOf (genFilePath "vk")) + hydraScriptsTxId <- arbitrary + persistenceDir <- genDirPath + chainConfig <- arbitrary + ledgerConfig <- arbitrary + pure $ + RunOptions + { verbosity + , nodeId + , host + , port + , peers + , apiHost + , apiPort + , monitoringPort + , hydraSigningKey + , hydraVerificationKeys + , hydraScriptsTxId + , persistenceDir + , chainConfig + , ledgerConfig + } + + shrink = genericShrink + +hydraScriptsTxIdParser :: Parser TxId +hydraScriptsTxIdParser = + option + (eitherReader $ left show . deserialiseFromRawBytesHex AsTxId . BSC.pack) + ( long "hydra-scripts-tx-id" + <> metavar "TXID" + <> value "0101010101010101010101010101010101010101010101010101010101010101" + <> help + "The transaction which is expected to have published Hydra scripts as \ + \reference scripts in its outputs. Note: All scripts need to be in the \ + \first 10 outputs. See release notes for pre-published versions. You \ + \can use the 'publish-scripts' sub-command to publish them yourself." + ) + +runOptionsParser :: Parser RunOptions +runOptionsParser = + RunOptions + <$> verbosityParser + <*> nodeIdParser + <*> hostParser + <*> portParser + <*> many peerParser + <*> apiHostParser + <*> apiPortParser + <*> optional monitoringPortParser + <*> hydraSigningKeyFileParser + <*> many hydraVerificationKeyFileParser + <*> hydraScriptsTxIdParser + <*> persistenceDirParser + <*> chainConfigParser + <*> ledgerConfigParser + +toArgNetworkId :: NetworkId -> [String] +toArgNetworkId = \case + Mainnet -> ["--mainnet"] + Testnet (NetworkMagic magic) -> ["--testnet-magic", show magic] diff --git a/hydra-node/test/Hydra/Node/RunSpec.hs b/hydra-node/test/Hydra/Node/RunSpec.hs index 55fe5c69f66..1ebd806ad52 100644 --- a/hydra-node/test/Hydra/Node/RunSpec.hs +++ b/hydra-node/test/Hydra/Node/RunSpec.hs @@ -1,7 +1,8 @@ module Hydra.Node.RunSpec where import Hydra.Node.Run (ConfigurationException, run) -import Hydra.Options (ChainConfig (..), RunOptions (..), defaultRunOptions, genFilePath) +import Hydra.Options (ChainConfig (..), RunOptions (..), genFilePath) +import Hydra.Options.Online qualified as OnlineOptions import Hydra.Prelude import Test.Hydra.Prelude import Test.QuickCheck (generate) @@ -11,8 +12,8 @@ spec = it "throws exception given options are invalid" $ do cardanoKeys <- generate $ replicateM 1 (genFilePath "vk") hydraVerificationKeys <- generate $ replicateM 2 (genFilePath "vk") - let chainConfiguration = (chainConfig defaultRunOptions){cardanoVerificationKeys = cardanoKeys} - options = defaultRunOptions{chainConfig = chainConfiguration, hydraVerificationKeys} + let chainConfiguration = (chainConfig OnlineOptions.defaultRunOptions){cardanoVerificationKeys = cardanoKeys} + options = OnlineOptions.defaultRunOptions{chainConfig = chainConfiguration, hydraVerificationKeys} run options `shouldThrow` aConfigurationException diff --git a/hydra-node/test/Hydra/OptionsSpec.hs b/hydra-node/test/Hydra/OptionsSpec.hs index 0beab45dbf2..0b58487982d 100644 --- a/hydra-node/test/Hydra/OptionsSpec.hs +++ b/hydra-node/test/Hydra/OptionsSpec.hs @@ -27,9 +27,9 @@ import Hydra.Options ( outputFile, parseHydraCommandFromArgs, renderFailure, - toArgs, validateRunOptions, ) +import Hydra.Options.Online qualified as OnlineOptions import Test.Aeson.GenericSpecs (roundtripAndGoldenSpecs) import Test.QuickCheck (Property, chooseEnum, counterexample, forAll, property, vectorOf, (===)) import Text.Regex.TDFA ((=~)) @@ -327,7 +327,7 @@ spec = parallel $ canRoundtripRunOptionsAndPrettyPrinting :: RunOptions -> Property canRoundtripRunOptionsAndPrettyPrinting opts = - let args = toArgs opts + let args = OnlineOptions.toArgs opts in counterexample ("args: " <> show args) $ case parseHydraCommandFromArgs args of Success cmd -> cmd === Run opts