From 98dbb399d00bab5d469439d54c482da0cf3f7b2d Mon Sep 17 00:00:00 2001 From: card Date: Tue, 5 Dec 2023 02:23:47 -0500 Subject: [PATCH 01/44] initial untested gummiworm-redacted mostly-cleaned-up offline mode implementation --- hydra-cluster/src/HydraNode.hs | 1 + hydra-node/exe/hydra-node/Main.hs | 2 + hydra-node/src/Hydra/Chain/Direct.hs | 95 +++++++++++++++++-- hydra-node/src/Hydra/Chain/Direct/Handlers.hs | 62 +++++++++++- hydra-node/src/Hydra/Node/Run.hs | 82 ++++++++++++++-- hydra-node/src/Hydra/Options.hs | 55 +++++++++++ hydra-node/test/Hydra/OptionsSpec.hs | 1 + 7 files changed, 284 insertions(+), 14 deletions(-) diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs index e52b28f8443..891eecf2242 100644 --- a/hydra-cluster/src/HydraNode.hs +++ b/hydra-cluster/src/HydraNode.hs @@ -351,6 +351,7 @@ withHydraNode' chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds h , persistenceDir = workDir "state-" <> show hydraNodeId , chainConfig , ledgerConfig + , offlineConfig = Nothing } ) { std_out = maybe CreatePipe UseHandle mGivenStdOut diff --git a/hydra-node/exe/hydra-node/Main.hs b/hydra-node/exe/hydra-node/Main.hs index 6ed42044d63..051468317ae 100644 --- a/hydra-node/exe/hydra-node/Main.hs +++ b/hydra-node/exe/hydra-node/Main.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE TypeApplications #-} module Main where @@ -7,6 +8,7 @@ import Hydra.Prelude hiding (fromList) import Hydra.Cardano.Api ( serialiseToRawBytesHex, ) + import Hydra.Chain.Direct.ScriptRegistry (publishHydraScripts) import Hydra.Chain.Direct.Util (readKeyPair) import Hydra.Logging (Verbosity (..)) diff --git a/hydra-node/src/Hydra/Chain/Direct.hs b/hydra-node/src/Hydra/Chain/Direct.hs index 6fc8c7480a5..501cb31d8c6 100644 --- a/hydra-node/src/Hydra/Chain/Direct.hs +++ b/hydra-node/src/Hydra/Chain/Direct.hs @@ -1,4 +1,8 @@ {-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE DisambiguateRecordFields #-} -- | Chain component implementation which uses directly the Node-to-Client -- protocols to submit "hand-rolled" transactions. @@ -9,8 +13,9 @@ module Hydra.Chain.Direct ( import Hydra.Prelude -import Cardano.Ledger.Shelley.API qualified as Ledger -import Cardano.Ledger.Slot (EpochInfo) + +import qualified Cardano.Ledger.Shelley.API as Ledger +import Cardano.Ledger.Slot (EpochInfo, SlotNo(..)) import Cardano.Slotting.EpochInfo (hoistEpochInfo) import Control.Concurrent.Class.MonadSTM ( newEmptyTMVar, @@ -45,13 +50,13 @@ import Hydra.Cardano.Api ( connectToLocalNode, getTxBody, getTxId, - toLedgerUTxO, + toLedgerUTxO, readFileJSON, ) import Hydra.Chain ( ChainComponent, ChainStateHistory, PostTxError (..), - currentState, + currentState, ChainEvent (Tick, Observation, observedTx), chainTime, chainSlot, initHistory, OnChainTx (OnCommitTx, OnInitTx, headId, contestationPeriod, contestationPeriod, parties), newChainState, committed, party, ) import Hydra.Chain.CardanoClient ( QueryPoint (..), @@ -68,12 +73,12 @@ import Hydra.Chain.Direct.Handlers ( mkChain, newLocalChainState, onRollBackward, - onRollForward, + onRollForward, mkFakeL1Chain, ) import Hydra.Chain.Direct.ScriptRegistry (queryScriptRegistry) import Hydra.Chain.Direct.State ( ChainContext (..), - ChainStateAt (..), + ChainStateAt (..), initialChainState, OpenState (OpenState, headId), ChainState (Idle, Open), openThreadOutput, observeCommit, ) import Hydra.Chain.Direct.TimeHandle (queryTimeHandle) import Hydra.Chain.Direct.Util ( @@ -85,7 +90,7 @@ import Hydra.Chain.Direct.Wallet ( newTinyWallet, ) import Hydra.Logging (Tracer, traceWith) -import Hydra.Options (ChainConfig (..)) +import Hydra.Options (ChainConfig (..), OfflineConfig(..)) import Hydra.Party (Party) import Ouroboros.Consensus.HardFork.History qualified as Consensus import Ouroboros.Network.Magic (NetworkMagic (..)) @@ -100,6 +105,20 @@ import Ouroboros.Network.Protocol.LocalTxSubmission.Client ( LocalTxSubmissionClient (..), SubmitResult (..), ) +import qualified Data.Map as M +import Hydra.Cardano.Api.TxIn (toLedgerTxIn) +import Hydra.Cardano.Api.TxOut (toLedgerTxOut) +import Cardano.Api.UTxO (UTxO'(toMap)) +import qualified Data.Aeson as Aeson +import Hydra.Ledger (UTxOType, ChainSlot (ChainSlot)) +import Data.Time.Clock.POSIX (systemToPOSIXTime, getPOSIXTime, utcTimeToPOSIXSeconds) +import Hydra.Plutus.Extras (posixFromUTCTime) +import Hydra.Chain.Direct.Tx (OpenThreadOutput(OpenThreadOutput, openThreadUTxO)) +import Hydra.Data.ContestationPeriod (contestationPeriodFromDiffTime) +import Hydra.ContestationPeriod (fromChain) +import Hydra.Ledger.Cardano.Configuration (readJsonFileThrow) + +import Hydra.HeadId (HeadId (..)) -- | Build the 'ChainContext' from a 'ChainConfig' and additional information. loadChainContext :: @@ -153,6 +172,68 @@ mkTinyWallet tracer config = do hoistEpochInfo (first show . runExcept) $ Consensus.interpreterToEpochInfo interpreter +withOfflineChain :: + Tracer IO DirectChainLog -> -- TODO(ELAINE): change type maybe ? + -- ChainConfig -> + -- Ledger.Globals -> + OfflineConfig -> + ChainContext -> + HeadId -> + -- Ledger Tx -> --NOTE(Elaine): read from offlineconfig + -- | Last known chain state as loaded from persistence. + ChainStateHistory Tx -> --NOTE(Elaine): discard, or if there's time, make actually resume from disk, for longurnning sessions + ChainComponent Tx IO a +withOfflineChain tracer OfflineConfig{initialUTxOFile} ctx@ChainContext{ownParty} ownHeadId _chainStateHistory callback action = do + + initialUTxO :: UTxOType Tx <- readJsonFileThrow (parseJSON @(UTxOType Tx)) initialUTxOFile + -- let ledgerInitialUtxo = M.fromList . map (bimap toLedgerTxIn toLedgerTxOut) . M.toList . toMap $ initialUTxO + + let emptyChainStateHistory = initHistory initialChainState + -- let chainStateHistory = initHistory ChainStateAt {chainState = Open (OpenState{ + -- headId = ownHeadId, + + -- openThreadOutput = OpenThreadOutput {openThreadUTxO = (mempty, mempty, mempty)} }), recordedAt = Nothing} + + --TODO(Elaine): restore from disk for longrunning sessions having crashes + callback $ Observation { newChainState = initialChainState, observedTx = + OnInitTx + { headId = ownHeadId + , parties = [ownParty] + , contestationPeriod = fromChain $ contestationPeriodFromDiffTime (10) --TODO(Elaine): we should be able to set this to 0 + } } + + --NOTE(Elaine): should be no need to update the chain state, that's L1, there's nothing relevant there + -- observation events are to construct the L2 we want, with the initial utxo + callback $ Observation { newChainState = initialChainState, observedTx = + OnCommitTx + { party = ownParty + , committed = initialUTxO + } } + + localChainState <- newLocalChainState emptyChainStateHistory + let chainHandle = mkFakeL1Chain localChainState tracer ctx ownHeadId callback + + let tickEverySec :: IO () + tickEverySec = forever $ do + --FIXME(Elaine): we can just make our own era history for the L2? + --lets use the actual current posix time as the slot number + --TODO(Elaine): double check this immediately as not having problems + -- otherwise, use an interpreter object, but single era, from genesis params just added back + currentUTCTime <- getCurrentTime + let currentTimeWord64 = truncate $ utcTimeToPOSIXSeconds currentUTCTime + -- let currentSlotNo = SlotNo currentTimeWord64 + callback $ Tick {chainTime = currentUTCTime, chainSlot = ChainSlot $ fromIntegral @Word64 @Natural currentTimeWord64 } + threadDelay 1 + + res <- + race + tickEverySec + (action chainHandle) + + case res of + Left () -> error "'connectTo' cannot terminate but did?" + Right a -> pure a + withDirectChain :: Tracer IO DirectChainLog -> ChainConfig -> diff --git a/hydra-node/src/Hydra/Chain/Direct/Handlers.hs b/hydra-node/src/Hydra/Chain/Direct/Handlers.hs index 1925198ea58..bc0b92201d0 100644 --- a/hydra-node/src/Hydra/Chain/Direct/Handlers.hs +++ b/hydra-node/src/Hydra/Chain/Direct/Handlers.hs @@ -39,7 +39,7 @@ import Hydra.Chain ( PostTxError (..), currentState, pushNewState, - rollbackHistory, + rollbackHistory, OnChainTx (OnInitTx, headId, OnAbortTx, OnCollectComTx, OnCloseTx, parties, contestationDeadline, contestationPeriod, OnContestTx, OnFanoutTx), HeadParameters (HeadParameters), snapshotNumber, ) import Hydra.Chain.Direct.State ( ChainContext (..), @@ -81,6 +81,9 @@ import Hydra.Logging (Tracer, traceWith) import Hydra.Plutus.Extras (posixToUTCTime) import Hydra.Plutus.Orphans () import System.IO.Error (userError) +import Hydra.Snapshot (getSnapshot, Snapshot (number)) + +import Hydra.HeadId (HeadId) -- | Handle of a mutable local chain state that is kept in the direct chain layer. data LocalChainState m tx = LocalChainState @@ -125,6 +128,63 @@ type SubmitTx m = Tx -> m () -- | A way to acquire a 'TimeHandle' type GetTimeHandle m = m TimeHandle +mkFakeL1Chain :: + LocalChainState IO Tx + -- -> IO a + -> Tracer IO DirectChainLog + -> ChainContext + -- -> TinyWallet IO + -> HeadId + -> (ChainEvent Tx -> IO ()) + -> Chain Tx IO +mkFakeL1Chain localChainState tracer ctx ownHeadId callback = + Chain { + submitTx = const $ pure (), + draftCommitTx = \utxoToCommit -> do + ChainStateAt{chainState} <- atomically (getLatest localChainState) + case chainState of + Initial st -> + -- callback $ Observation { newChainState = cst, observedTx = OnCommitTx {party = ownParty ctx, committed = utxoToCommit}} + pure (commit' ctx st utxoToCommit) + _ -> pure $ Left FailedToDraftTxNotInitializing, + postTx = \tx -> do + cst@ChainStateAt{chainState=_chainState} <- atomically (getLatest localChainState) + traceWith tracer $ ToPost{toPost = tx} + + let headId = ownHeadId + _ <- case tx of + InitTx{headParameters=HeadParameters contestationPeriod parties} -> + -- should only be one party, us, since offlinemode + -- _us should == ownParty ctx + -- TODO: need to finish figuring out how the headId is generated, its parsed from tx in headOutput= where block in observeInitTx + -- NOTE: figured this out see the txout datum in initTx that is parsed back + -- FIXME: i have not been able to figure this out its like, just the raw bytestring representation of the "headpolicyid" of the seedtxin which you can get from the wallet via getSeedInput + -- it seems opaque, and since its the hash of something in the first place, i dont think it matters what we set it to + + -- we're not updating the L1 chainstate at all, i think that should be fine + + callback $ Observation { newChainState = cst, observedTx = OnInitTx {headId = headId, parties=parties, contestationPeriod}} + -- (CommitTx{..}) -> + -- -- normally this would be where we handle client sending commit event by initializing the L1 state + -- -- and then that L1 tx would get chainsycned, which we then would parse, and do the next state transition based on a finished commit transition (wait for collectcom) + -- -- but since we're in offline mode, and have no real L1, we just do the next state transition here + -- callback $ Observation { observedTx = OnCommitTx {..}} + AbortTx{} -> + callback $ Observation { newChainState = cst, observedTx = OnAbortTx {}} + CollectComTx{} -> + callback $ Observation { newChainState = cst, observedTx = OnCollectComTx {}} + CloseTx{confirmedSnapshot} -> do + inOneMinute <- addUTCTime 60 <$> getCurrentTime + callback $ Observation { newChainState = cst, observedTx = + OnCloseTx {headId, snapshotNumber = number $ getSnapshot confirmedSnapshot, contestationDeadline=inOneMinute}} -- ELAINE TODO: probably we shouldnt allow the clietn to do contestation in offline mode ? + ContestTx{confirmedSnapshot} -> -- this shouldnt really happen, i dont think we should allow contesting in offline mode + callback $ Observation { newChainState = cst, observedTx = + OnContestTx{snapshotNumber = number $ getSnapshot confirmedSnapshot}} + FanoutTx{} -> + callback $ Observation { newChainState = cst, observedTx = + OnFanoutTx{}} + pure ()} + -- | Create a `Chain` component for posting "real" cardano transactions. -- -- This component does not actually interact with a cardano-node, but creates diff --git a/hydra-node/src/Hydra/Node/Run.hs b/hydra-node/src/Hydra/Node/Run.hs index 70b325030df..08b7cdceb74 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -4,16 +4,22 @@ 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, 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 (loadChainContext, mkTinyWallet, withDirectChain, withOfflineChain) import Hydra.Chain.Direct.State (initialChainState) import Hydra.HeadLogic ( Environment (..), @@ -46,11 +52,14 @@ import Hydra.Options ( ChainConfig (..), InvalidOptions (..), LedgerConfig (..), + OfflineConfig (OfflineConfig, initialUTxOFile, ledgerGenesisFile), RunOptions (..), validateRunOptions, ) import Hydra.Persistence (createPersistenceIncremental) +import Hydra.HeadId (HeadId (..)) + data ConfigurationException = ConfigurationException ProtocolParametersConversionError | InvalidOptionException InvalidOptions @@ -69,7 +78,7 @@ explain = \case run :: RunOptions -> IO () run opts = do either (throwIO . InvalidOptionException) pure $ validateRunOptions opts - let RunOptions{verbosity, monitoringPort, persistenceDir} = opts + let RunOptions{verbosity, monitoringPort, persistenceDir, offlineConfig} = opts env@Environment{party, otherParties, signingKey} <- initEnvironment opts withTracer verbosity $ \tracer' -> withMonitoring monitoringPort tracer' $ \tracer -> do @@ -80,15 +89,19 @@ run opts = do pparams <- case toLedgerPParams ShelleyBasedEraBabbage protocolParams of Left err -> throwIO (ConfigurationException err) Right bpparams -> pure bpparams - withCardanoLedger chainConfig pparams $ \ledger -> do + let onlineOrOfflineConfig = case offlineConfig of + Nothing -> Right chainConfig + Just offlineConfig' -> Left offlineConfig' + + withCardanoLedger onlineOrOfflineConfig pparams $ \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 headId = HeadId "FIXME(Elaine): headId" + withChain onlineOrOfflineConfig tracer ctx signingKey chainStateHistory headId (putEvent . OnChainEvent) $ \chain -> do -- API let RunOptions{host, port, peers, nodeId} = opts putNetworkEvent (Authenticated msg otherParty) = putEvent $ NetworkEvent defaultTTL otherParty msg @@ -115,7 +128,26 @@ run opts = do Connected nodeid -> sendOutput $ PeerConnected nodeid Disconnected nodeid -> sendOutput $ PeerDisconnected nodeid - withCardanoLedger chainConfig protocolParams action = do + withChain onlineOrOfflineConfig tracer ctx signingKey chainStateHistory headId putEvent cont = case onlineOrOfflineConfig of + Left offlineConfig -> withOfflineChain (contramap DirectChain tracer) offlineConfig ctx headId chainStateHistory (putEvent . OnChainEvent) cont + Right onlineConfig -> do + wallet <- mkTinyWallet (contramap DirectChain tracer) onlineConfig + withDirectChain (contramap DirectChain tracer) onlineConfig ctx wallet chainStateHistory (putEvent . OnChainEvent) cont + + withCardanoLedger onlineOrOfflineConfig protocolParams action = case onlineOrOfflineConfig of + Left offlineConfig -> withCardanoLedgerOffline offlineConfig protocolParams action + Right onlineConfig -> withCardanoLedgerOnline onlineConfig protocolParams action + + withCardanoLedgerOffline OfflineConfig{ledgerGenesisFile} protocolParams action = do + -- TODO(Elaine): double check previous messy branch for any other places where we query node + genesisParameters <- readJsonFileThrow (parseJSON @(Ledger.ShelleyGenesis StandardCrypto)) ledgerGenesisFile + globals <- newGlobals $ fromShelleyGenesis genesisParameters + -- NOTE(Elaine): we need globals here to call Cardano.Ledger.Shelley.API.Mempool.applyTxs ultimately + -- that function could probably take less info but it's upstream of hydra itself i believe + let ledgerEnv = newLedgerEnv protocolParams + action (Ledger.cardanoLedger globals ledgerEnv) + + withCardanoLedgerOnline chainConfig protocolParams action = do let DirectChainConfig{networkId, nodeSocket} = chainConfig globals <- newGlobals =<< queryGenesisParameters networkId nodeSocket QueryTip let ledgerEnv = newLedgerEnv protocolParams @@ -124,3 +156,41 @@ run opts = do identifyNode :: RunOptions -> RunOptions identifyNode opt@RunOptions{verbosity = Verbose "HydraNode", nodeId} = opt{verbosity = Verbose $ "HydraNode-" <> show nodeId} identifyNode opt = opt + +-- TODO(ELAINE): figure out a less strange way to do this + +-- | 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..fcb1470df15 100644 --- a/hydra-node/src/Hydra/Options.hs +++ b/hydra-node/src/Hydra/Options.hs @@ -134,6 +134,43 @@ publishOptionsParser = <$> networkIdParser <*> nodeSocketParser <*> cardanoSigningKeyFileParser + +initialUTxOFileParser :: Parser FilePath +initialUTxOFileParser = + option + str + ( long "initial-utxo" + <> metavar "FILE" + <> value "utxo.json" + <> showDefault + <> help "File containing initial UTxO for the L2 chain." + ) + +--NOTE(Elaine): we need globals here to call Cardano.Ledger.Shelley.API.Mempool.applyTxs ultimately +-- that function could probably take less info but it's upstream of hydra itself i believe +ledgerGenesisFileParser :: Parser FilePath +ledgerGenesisFileParser = + option + str + ( long "ledger-genesis" + <> metavar "FILE" + <> value "genesis.json" + <> showDefault + <> help "File containing ledger genesis parameters." + ) + +data OfflineConfig = OfflineConfig + { + initialUTxOFile :: FilePath + , ledgerGenesisFile :: FilePath + -- TODO(Elaine): need option to dump final utxo to file without going thru snapshot + } deriving (Eq, Show, Generic, FromJSON, ToJSON) + +offlineOptionsParser :: Parser OfflineConfig +offlineOptionsParser = + OfflineConfig + <$> initialUTxOFileParser + <*> ledgerGenesisFileParser data RunOptions = RunOptions { verbosity :: Verbosity @@ -151,6 +188,7 @@ data RunOptions = RunOptions , persistenceDir :: FilePath , chainConfig :: ChainConfig , ledgerConfig :: LedgerConfig + , offlineConfig :: Maybe OfflineConfig --TODO(Elaine): nicer type ? Nothing = online mode, but thats a bit weird } deriving stock (Eq, Show, Generic) deriving anyclass (ToJSON, FromJSON) @@ -192,10 +230,25 @@ instance Arbitrary RunOptions where , persistenceDir , chainConfig , ledgerConfig + , offlineConfig = Nothing --TODO(Elaine): should we change this? } shrink = genericShrink +--FIXME(Elaine): this instance doesn't do stuff correctly but was necessary during rebasing +instance Arbitrary OfflineConfig where + arbitrary = do + ledgerGenesisFile <- genFilePath "ledgerGenesis" + initialUTxOFile <- genFilePath "utxo.json" + -- writeFileBS initialUTxOFile "{}" + + pure $ + OfflineConfig { + initialUTxOFile + , ledgerGenesisFile + } + shrink = genericShrink + runOptionsParser :: Parser RunOptions runOptionsParser = RunOptions @@ -213,6 +266,7 @@ runOptionsParser = <*> persistenceDirParser <*> chainConfigParser <*> ledgerConfigParser + <*> optional offlineOptionsParser newtype GenerateKeyPair = GenerateKeyPair { outputFile :: FilePath @@ -753,6 +807,7 @@ defaultRunOptions = , persistenceDir = "./" , chainConfig = defaultChainConfig , ledgerConfig = defaultLedgerConfig + , offlineConfig = Nothing --TODO(Elaine) } where localhost = IPv4 $ toIPv4 [127, 0, 0, 1] diff --git a/hydra-node/test/Hydra/OptionsSpec.hs b/hydra-node/test/Hydra/OptionsSpec.hs index 0beab45dbf2..7c36e29ae8a 100644 --- a/hydra-node/test/Hydra/OptionsSpec.hs +++ b/hydra-node/test/Hydra/OptionsSpec.hs @@ -364,4 +364,5 @@ defaultRunOptions = , persistenceDir = "./" , chainConfig = defaultChainConfig , ledgerConfig = defaultLedgerConfig + , offlineConfig = Nothing --TODO(Elaine) } From 6424b29a21a8acef13ad931b7940d7707a1f0543 Mon Sep 17 00:00:00 2001 From: card Date: Thu, 19 Oct 2023 12:19:47 -0400 Subject: [PATCH 02/44] validate offlinemode 0 peers, tick according to genesis, allow using persistence when offline, cleanup --- hydra-node/src/Hydra/Chain/Direct.hs | 103 ++++++++++++++++----------- hydra-node/src/Hydra/Node.hs | 2 +- hydra-node/src/Hydra/Node/Run.hs | 2 + hydra-node/src/Hydra/Options.hs | 5 +- 4 files changed, 69 insertions(+), 43 deletions(-) diff --git a/hydra-node/src/Hydra/Chain/Direct.hs b/hydra-node/src/Hydra/Chain/Direct.hs index 501cb31d8c6..2b96fd0fd0a 100644 --- a/hydra-node/src/Hydra/Chain/Direct.hs +++ b/hydra-node/src/Hydra/Chain/Direct.hs @@ -16,7 +16,7 @@ import Hydra.Prelude import qualified Cardano.Ledger.Shelley.API as Ledger import Cardano.Ledger.Slot (EpochInfo, SlotNo(..)) -import Cardano.Slotting.EpochInfo (hoistEpochInfo) +import Cardano.Slotting.EpochInfo (hoistEpochInfo, fixedEpochInfo, epochInfoSlotToUTCTime) import Control.Concurrent.Class.MonadSTM ( newEmptyTMVar, newTQueueIO, @@ -50,13 +50,13 @@ import Hydra.Cardano.Api ( connectToLocalNode, getTxBody, getTxId, - toLedgerUTxO, readFileJSON, + toLedgerUTxO, readFileJSON, StandardCrypto, ) import Hydra.Chain ( ChainComponent, ChainStateHistory, PostTxError (..), - currentState, ChainEvent (Tick, Observation, observedTx), chainTime, chainSlot, initHistory, OnChainTx (OnCommitTx, OnInitTx, headId, contestationPeriod, contestationPeriod, parties), newChainState, committed, party, + currentState, ChainEvent (Tick, Observation, observedTx), chainTime, chainSlot, initHistory, OnChainTx (OnCommitTx, OnInitTx, headId, contestationPeriod, contestationPeriod, parties, OnCollectComTx), newChainState, committed, party, ) import Hydra.Chain.CardanoClient ( QueryPoint (..), @@ -117,6 +117,10 @@ import Hydra.Chain.Direct.Tx (OpenThreadOutput(OpenThreadOutput, openThreadUTxO) import Hydra.Data.ContestationPeriod (contestationPeriodFromDiffTime) import Hydra.ContestationPeriod (fromChain) import Hydra.Ledger.Cardano.Configuration (readJsonFileThrow) +import Cardano.Slotting.Time (mkSlotLength, toRelativeTime, SystemStart (SystemStart)) +import Cardano.Ledger.Shelley.API (fromNominalDiffTimeMicro) +import Ouroboros.Consensus.HardFork.History (neverForksSummary, mkInterpreter, wallclockToSlot, interpretQuery) +import Ouroboros.Consensus.Util.Time (nominalDelay) import Hydra.HeadId (HeadId (..)) @@ -174,60 +178,77 @@ mkTinyWallet tracer config = do withOfflineChain :: Tracer IO DirectChainLog -> -- TODO(ELAINE): change type maybe ? - -- ChainConfig -> - -- Ledger.Globals -> OfflineConfig -> ChainContext -> HeadId -> - -- Ledger Tx -> --NOTE(Elaine): read from offlineconfig -- | Last known chain state as loaded from persistence. - ChainStateHistory Tx -> --NOTE(Elaine): discard, or if there's time, make actually resume from disk, for longurnning sessions + ChainStateHistory Tx -> ChainComponent Tx IO a -withOfflineChain tracer OfflineConfig{initialUTxOFile} ctx@ChainContext{ownParty} ownHeadId _chainStateHistory callback action = do +withOfflineChain tracer OfflineConfig{initialUTxOFile, ledgerGenesisFile} ctx@ChainContext{ownParty} ownHeadId chainStateHistory callback action = do initialUTxO :: UTxOType Tx <- readJsonFileThrow (parseJSON @(UTxOType Tx)) initialUTxOFile - -- let ledgerInitialUtxo = M.fromList . map (bimap toLedgerTxIn toLedgerTxOut) . M.toList . toMap $ initialUTxO - + let emptyChainStateHistory = initHistory initialChainState - -- let chainStateHistory = initHistory ChainStateAt {chainState = Open (OpenState{ - -- headId = ownHeadId, - - -- openThreadOutput = OpenThreadOutput {openThreadUTxO = (mempty, mempty, mempty)} }), recordedAt = Nothing} - --TODO(Elaine): restore from disk for longrunning sessions having crashes - callback $ Observation { newChainState = initialChainState, observedTx = - OnInitTx - { headId = ownHeadId - , parties = [ownParty] - , contestationPeriod = fromChain $ contestationPeriodFromDiffTime (10) --TODO(Elaine): we should be able to set this to 0 - } } - - --NOTE(Elaine): should be no need to update the chain state, that's L1, there's nothing relevant there - -- observation events are to construct the L2 we want, with the initial utxo - callback $ Observation { newChainState = initialChainState, observedTx = - OnCommitTx - { party = ownParty - , committed = initialUTxO - } } + -- 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 + , parties = [ownParty] + , contestationPeriod = fromChain $ contestationPeriodFromDiffTime (10) --TODO(Elaine): we should be able to set this to 0 + } } + + --NOTE(Elaine): should be no need to update the chain state, that's L1, there's nothing relevant there + -- observation events are to construct the L2 we want, with the initial utxo + callback $ Observation { newChainState = initialChainState, observedTx = + OnCommitTx + { party = ownParty + , committed = initialUTxO + } } + + -- TODO(Elaine): I think onInitialChainCommitTx in update will take care of posting a collectcom transaction since we shouldn't have any peers + -- callback $ Observation { newChainState = initialChainState, observedTx = OnCollectComTx } localChainState <- newLocalChainState emptyChainStateHistory let chainHandle = mkFakeL1Chain localChainState tracer ctx ownHeadId callback - let tickEverySec :: IO () - tickEverySec = forever $ do - --FIXME(Elaine): we can just make our own era history for the L2? - --lets use the actual current posix time as the slot number - --TODO(Elaine): double check this immediately as not having problems - -- otherwise, use an interpreter object, but single era, from genesis params just added back - currentUTCTime <- getCurrentTime - let currentTimeWord64 = truncate $ utcTimeToPOSIXSeconds currentUTCTime - -- let currentSlotNo = SlotNo currentTimeWord64 - callback $ Tick {chainTime = currentUTCTime, chainSlot = ChainSlot $ fromIntegral @Word64 @Natural currentTimeWord64 } - threadDelay 1 + -- 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 + + + Ledger.ShelleyGenesis{ sgSystemStart, sgSlotLength, sgEpochLength } <- + readJsonFileThrow (parseJSON @(Ledger.ShelleyGenesis StandardCrypto)) ledgerGenesisFile + + let slotLengthNominalDiffTime = fromNominalDiffTimeMicro sgSlotLength + slotLength = mkSlotLength slotLengthNominalDiffTime + let systemStart = SystemStart sgSystemStart + + let interpreter = mkInterpreter $ neverForksSummary sgEpochLength slotLength + + let slotFromUTCTime :: HasCallStack => UTCTime -> Either Consensus.PastHorizonException ChainSlot + slotFromUTCTime utcTime = do + let relativeTime = toRelativeTime systemStart utcTime + case interpretQuery interpreter (wallclockToSlot relativeTime) of + Left pastHorizonEx -> + Left pastHorizonEx + Right (SlotNo slotNoWord64, _timeSpentInSlot, _timeLeftInSlot) -> + Right . ChainSlot . fromIntegral @Word64 @Natural $ slotNoWord64 + + let tickForever :: IO () + tickForever = forever $ do + + chainTime <- getCurrentTime + -- NOTE(Elaine): this shouldn't happen in offline mode, we should not construct an era history that ever ends + chainSlot <- either throwIO pure . slotFromUTCTime $ chainTime + callback $ Tick { chainTime = chainTime, chainSlot } + + --NOTE(Elaine): this is just realToFrac, not sure if better etiquette to import or use directly + threadDelay $ nominalDelay slotLengthNominalDiffTime res <- race - tickEverySec + tickForever (action chainHandle) case res of diff --git a/hydra-node/src/Hydra/Node.hs b/hydra-node/src/Hydra/Node.hs index 313d84111e0..b9c2e080bb8 100644 --- a/hydra-node/src/Hydra/Node.hs +++ b/hydra-node/src/Hydra/Node.hs @@ -52,7 +52,7 @@ 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 (..), RunOptions (..), OfflineConfig) import Hydra.Party (Party (..), deriveParty) import Hydra.Persistence (PersistenceIncremental (..), loadAll) diff --git a/hydra-node/src/Hydra/Node/Run.hs b/hydra-node/src/Hydra/Node/Run.hs index 08b7cdceb74..b39c29500e5 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -140,6 +140,8 @@ run opts = do withCardanoLedgerOffline OfflineConfig{ledgerGenesisFile} protocolParams action = do -- TODO(Elaine): double check previous messy branch for any other places where we query node + -- TODO(Elaine): instead of reading file, we can embed our own defaults with shelleyGenesisDefaults + -- that would be more convenient, but offer less control genesisParameters <- readJsonFileThrow (parseJSON @(Ledger.ShelleyGenesis StandardCrypto)) ledgerGenesisFile globals <- newGlobals $ fromShelleyGenesis genesisParameters -- NOTE(Elaine): we need globals here to call Cardano.Ledger.Shelley.API.Mempool.applyTxs ultimately diff --git a/hydra-node/src/Hydra/Options.hs b/hydra-node/src/Hydra/Options.hs index fcb1470df15..1419740d6fb 100644 --- a/hydra-node/src/Hydra/Options.hs +++ b/hydra-node/src/Hydra/Options.hs @@ -691,11 +691,14 @@ data InvalidOptions -- 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} +validateRunOptions RunOptions{hydraVerificationKeys, chainConfig, offlineConfig} | numberOfOtherParties + 1 > maximumNumberOfParties = Left MaximumNumberOfPartiesExceeded + | isJust offlineConfig && numberOfOtherParties > 0 = Left MaximumNumberOfPartiesExceeded | length (cardanoVerificationKeys chainConfig) /= length hydraVerificationKeys = Left CardanoAndHydraKeysMissmatch | otherwise = Right () From 299bfb2017bc6b6f33f58cf49e21065406f612e6 Mon Sep 17 00:00:00 2001 From: card Date: Thu, 19 Oct 2023 06:53:49 -0400 Subject: [PATCH 03/44] remove redundant comment --- .DS_Store | Bin 6148 -> 0 bytes hydra-node/src/Hydra/Chain/Direct/Handlers.hs | 14 -------------- hydra-node/test/Hydra/OptionsSpec.hs | 2 +- 3 files changed, 1 insertion(+), 15 deletions(-) delete mode 100644 .DS_Store diff --git a/.DS_Store b/.DS_Store deleted file mode 100644 index e2389c5b698d9487dbd069670132adedad70b236..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 6148 zcmeHK-AcnS6i&A4I)=~-1@S82?Zg!s8+cRZd;u$Zp)y-Lv{;+5cJ^Wn`T+VuK8Vlb zIY}xG=dFl42a@mnCd~)U4`YlEW|7O7!x*!nA#zk!2)b8>Y9<+x;}~I)O~OQmV85Bz zUkChli$zSbJC=R@{&14SS>EZq^IF~7*lgGhyJg?_53=y{AfIJ}V0wktxs*v*=|OlA zkBgDBeInC5h|}>@6~xgPQm!xKG?K+Y&eAATwZ0D6O}jaA_U3c9+jraIz&+|L+G5`8 zb=#uX?=BWiduRXf_-yo;Jf-qQQ_6vHC0hn7cm?HiMbG{;O=NlxzAC@UBP0fh0b+m{ zSXTzjiD0+Zl>k~dF+dFb$N=sS0ve)cu+*rw4(RaujByJQ1$2B%APR$?!BQhcK)5ai z)TP`!F}N-Vzc6{8!BV3xXI#w;sDOaJbO`_h_mN!{)Nz42 - -- should only be one party, us, since offlinemode - -- _us should == ownParty ctx - -- TODO: need to finish figuring out how the headId is generated, its parsed from tx in headOutput= where block in observeInitTx - -- NOTE: figured this out see the txout datum in initTx that is parsed back - -- FIXME: i have not been able to figure this out its like, just the raw bytestring representation of the "headpolicyid" of the seedtxin which you can get from the wallet via getSeedInput - -- it seems opaque, and since its the hash of something in the first place, i dont think it matters what we set it to - - -- we're not updating the L1 chainstate at all, i think that should be fine - callback $ Observation { newChainState = cst, observedTx = OnInitTx {headId = headId, parties=parties, contestationPeriod}} - -- (CommitTx{..}) -> - -- -- normally this would be where we handle client sending commit event by initializing the L1 state - -- -- and then that L1 tx would get chainsycned, which we then would parse, and do the next state transition based on a finished commit transition (wait for collectcom) - -- -- but since we're in offline mode, and have no real L1, we just do the next state transition here - -- callback $ Observation { observedTx = OnCommitTx {..}} AbortTx{} -> callback $ Observation { newChainState = cst, observedTx = OnAbortTx {}} CollectComTx{} -> diff --git a/hydra-node/test/Hydra/OptionsSpec.hs b/hydra-node/test/Hydra/OptionsSpec.hs index 7c36e29ae8a..6f677edf3d6 100644 --- a/hydra-node/test/Hydra/OptionsSpec.hs +++ b/hydra-node/test/Hydra/OptionsSpec.hs @@ -364,5 +364,5 @@ defaultRunOptions = , persistenceDir = "./" , chainConfig = defaultChainConfig , ledgerConfig = defaultLedgerConfig - , offlineConfig = Nothing --TODO(Elaine) + , offlineConfig = Nothing } From 54ab84abae127abcff2011f7d9e7555dc2d81e35 Mon Sep 17 00:00:00 2001 From: card Date: Fri, 20 Oct 2023 07:05:12 -0400 Subject: [PATCH 04/44] allow configuring writing utxo state to file --- hydra-node/src/Hydra/Node/Run.hs | 43 ++++++++++++++++++++++++++++++-- hydra-node/src/Hydra/Options.hs | 30 ++++++++++++++++++++++ 2 files changed, 71 insertions(+), 2 deletions(-) diff --git a/hydra-node/src/Hydra/Node/Run.hs b/hydra-node/src/Hydra/Node/Run.hs index b39c29500e5..fa7840f9f59 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -14,6 +14,7 @@ import Hydra.Cardano.Api ( ProtocolParametersConversionError, ShelleyBasedEra (..), StandardCrypto, + Tx, toLedgerPParams, ) import Hydra.Cardano.Api qualified as Shelley @@ -24,6 +25,7 @@ import Hydra.Chain.Direct.State (initialChainState) import Hydra.HeadLogic ( Environment (..), Event (..), + StateChanged (..), defaultTTL, ) import Hydra.Ledger.Cardano qualified as Ledger @@ -52,7 +54,8 @@ import Hydra.Options ( ChainConfig (..), InvalidOptions (..), LedgerConfig (..), - OfflineConfig (OfflineConfig, initialUTxOFile, ledgerGenesisFile), + OfflineConfig (OfflineConfig, initialUTxOFile, ledgerGenesisFile, utxoWriteBack), + OfflineUTxOWriteBackConfig (..), RunOptions (..), validateRunOptions, ) @@ -60,6 +63,11 @@ import Hydra.Persistence (createPersistenceIncremental) import Hydra.HeadId (HeadId (..)) +import Data.Aeson qualified as Aeson +import Hydra.Persistence (PersistenceIncremental (PersistenceIncremental, append, loadAll)) +import Hydra.Snapshot (Snapshot (Snapshot), utxo) +import UnliftIO.IO.File (writeBinaryFileDurableAtomic) + data ConfigurationException = ConfigurationException ProtocolParametersConversionError | InvalidOptionException InvalidOptions @@ -94,7 +102,7 @@ run opts = do Just offlineConfig' -> Left offlineConfig' withCardanoLedger onlineOrOfflineConfig pparams $ \ledger -> do - persistence <- createPersistenceIncremental $ persistenceDir <> "/state" + persistence <- createStateChangePersistence (persistenceDir <> "/state") (leftToMaybe onlineOrOfflineConfig) (hs, chainStateHistory) <- loadState (contramap Node tracer) persistence initialChainState checkHeadState (contramap Node tracer) env hs nodeState <- createNodeState hs @@ -159,6 +167,37 @@ identifyNode :: RunOptions -> RunOptions identifyNode opt@RunOptions{verbosity = Verbose "HydraNode", nodeId} = opt{verbosity = Verbose $ "HydraNode-" <> show nodeId} identifyNode opt = opt +createStateChangePersistence :: (MonadIO m, MonadThrow m) => FilePath -> Maybe OfflineConfig -> m (PersistenceIncremental (StateChanged Tx) m) +createStateChangePersistence persistenceFilePath = \case + Just OfflineConfig{initialUTxOFile, utxoWriteBack = Just writeBackConfig} -> + createPersistenceWithUTxOWriteBack persistenceFilePath $ case writeBackConfig of + WriteBackToInitialUTxO -> initialUTxOFile + WriteBackToUTxOFile customFile -> customFile + _ -> createPersistenceIncremental persistenceFilePath + +-- TODO(Elaine): move this elsewhere +createPersistenceWithUTxOWriteBack :: + (MonadIO m, MonadThrow m) => + FilePath -> + FilePath -> + m (PersistenceIncremental (StateChanged Tx) m) +createPersistenceWithUTxOWriteBack persistenceFilePath utxoFilePath = do + PersistenceIncremental{append, loadAll} <- createPersistenceIncremental persistenceFilePath + pure + PersistenceIncremental + { loadAll + , append = \stateChange -> do + append stateChange + case stateChange of + -- TODO(Elaine): do we want to do this on snapshot confirmation or on transaction over local utxo + -- see onOpenNetworkReqTx + -- TransactionAppliedToLocalUTxO{tx, newLocalUTxO} -> + -- writeBinaryFileDurableAtomic utxoFilePath . toStrict $ Aeson.encode newLocalUTxO + Hydra.HeadLogic.SnapshotConfirmed{snapshot = Snapshot{utxo}} -> + writeBinaryFileDurableAtomic utxoFilePath . toStrict $ Aeson.encode utxo + _ -> pure () + } + -- TODO(ELAINE): figure out a less strange way to do this -- | Taken from Cardano.Api.GenesisParameters, a private module in cardano-api diff --git a/hydra-node/src/Hydra/Options.hs b/hydra-node/src/Hydra/Options.hs index 1419740d6fb..11757123292 100644 --- a/hydra-node/src/Hydra/Options.hs +++ b/hydra-node/src/Hydra/Options.hs @@ -159,18 +159,41 @@ ledgerGenesisFileParser = <> help "File containing ledger genesis parameters." ) +data OfflineUTxOWriteBackConfig = WriteBackToInitialUTxO | WriteBackToUTxOFile FilePath + deriving (Eq, Show, Generic, FromJSON, ToJSON) + data OfflineConfig = OfflineConfig { initialUTxOFile :: FilePath , ledgerGenesisFile :: FilePath -- TODO(Elaine): need option to dump final utxo to file without going thru snapshot + , utxoWriteBack :: Maybe OfflineUTxOWriteBackConfig } deriving (Eq, Show, Generic, FromJSON, ToJSON) +-- TODO(Elaine): name this +offlineUTxOWriteBackOptionsParser :: Parser (Maybe OfflineUTxOWriteBackConfig) +offlineUTxOWriteBackOptionsParser = + optional $ + asum + [ flag' WriteBackToInitialUTxO + ( long "write-back-to-initial-utxo" + <> help "Write back to initial UTxO file." + ) + , WriteBackToUTxOFile + <$> option + str + ( long "write-back-to-utxo-file" + <> metavar "FILE" + <> help "Write back to given UTxO file." + ) + ] + offlineOptionsParser :: Parser OfflineConfig offlineOptionsParser = OfflineConfig <$> initialUTxOFileParser <*> ledgerGenesisFileParser + <*> offlineUTxOWriteBackOptionsParser data RunOptions = RunOptions { verbosity :: Verbosity @@ -240,15 +263,22 @@ instance Arbitrary OfflineConfig where arbitrary = do ledgerGenesisFile <- genFilePath "ledgerGenesis" initialUTxOFile <- genFilePath "utxo.json" + utxoWriteBack <- arbitrary -- writeFileBS initialUTxOFile "{}" pure $ OfflineConfig { initialUTxOFile , ledgerGenesisFile + , utxoWriteBack } shrink = genericShrink +instance Arbitrary OfflineUTxOWriteBackConfig where + arbitrary = pure $ WriteBackToInitialUTxO --FIXME(Elaine): this wont be used so theres no need to fix during rebase + + shrink = genericShrink + runOptionsParser :: Parser RunOptions runOptionsParser = RunOptions From 5e7595d5284967cd2b9bedd59a78efb5e8e6c9d6 Mon Sep 17 00:00:00 2001 From: card Date: Wed, 25 Oct 2023 03:54:20 -0400 Subject: [PATCH 05/44] do not require globals file to run offline mode --- hydra-node/src/Hydra/Chain/Direct.hs | 173 ++++++++++++++------------- hydra-node/src/Hydra/Node/Run.hs | 42 ++++--- hydra-node/src/Hydra/Options.hs | 8 +- 3 files changed, 122 insertions(+), 101 deletions(-) diff --git a/hydra-node/src/Hydra/Chain/Direct.hs b/hydra-node/src/Hydra/Chain/Direct.hs index 2b96fd0fd0a..5dff1f91687 100644 --- a/hydra-node/src/Hydra/Chain/Direct.hs +++ b/hydra-node/src/Hydra/Chain/Direct.hs @@ -1,8 +1,8 @@ +{-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -{-# LANGUAGE DisambiguateRecordFields #-} -- | Chain component implementation which uses directly the Node-to-Client -- protocols to submit "hand-rolled" transactions. @@ -13,10 +13,13 @@ module Hydra.Chain.Direct ( import Hydra.Prelude - -import qualified Cardano.Ledger.Shelley.API as Ledger -import Cardano.Ledger.Slot (EpochInfo, SlotNo(..)) -import Cardano.Slotting.EpochInfo (hoistEpochInfo, fixedEpochInfo, epochInfoSlotToUTCTime) +import Cardano.Api.UTxO (UTxO' (toMap)) +import Cardano.Ledger.BaseTypes (epochInfoPure) +import Cardano.Ledger.Shelley.API (fromNominalDiffTimeMicro) +import Cardano.Ledger.Shelley.API qualified as Ledger +import Cardano.Ledger.Slot (EpochInfo, SlotNo (..)) +import Cardano.Slotting.EpochInfo (EpochInfo (EpochInfo), epochInfoFirst, epochInfoSlotToUTCTime, fixedEpochInfo, hoistEpochInfo) +import Cardano.Slotting.Time (SystemStart (SystemStart), mkSlotLength, toRelativeTime) import Control.Concurrent.Class.MonadSTM ( newEmptyTMVar, newTQueueIO, @@ -27,6 +30,8 @@ import Control.Concurrent.Class.MonadSTM ( ) import Control.Exception (IOException) import Control.Monad.Trans.Except (runExcept) +import Data.Aeson qualified as Aeson +import Data.Time.Clock.POSIX (getPOSIXTime, systemToPOSIXTime, utcTimeToPOSIXSeconds) import Hydra.Cardano.Api ( Block (..), BlockInMode (..), @@ -42,6 +47,7 @@ import Hydra.Cardano.Api ( LocalNodeConnectInfo (..), NetworkId, SocketPath, + StandardCrypto, Tx, TxId, TxInMode (..), @@ -50,13 +56,24 @@ import Hydra.Cardano.Api ( connectToLocalNode, getTxBody, getTxId, - toLedgerUTxO, readFileJSON, StandardCrypto, + readFileJSON, + toLedgerUTxO, ) +import Hydra.Cardano.Api.TxIn (toLedgerTxIn) +import Hydra.Cardano.Api.TxOut (toLedgerTxOut) import Hydra.Chain ( ChainComponent, + ChainEvent (Observation, Tick, observedTx), ChainStateHistory, + OnChainTx (OnCollectComTx, OnCommitTx, OnInitTx, contestationPeriod, headId, parties), PostTxError (..), - currentState, ChainEvent (Tick, Observation, observedTx), chainTime, chainSlot, initHistory, OnChainTx (OnCommitTx, OnInitTx, headId, contestationPeriod, contestationPeriod, parties, OnCollectComTx), newChainState, committed, party, + chainSlot, + chainTime, + committed, + currentState, + initHistory, + newChainState, + party, ) import Hydra.Chain.CardanoClient ( QueryPoint (..), @@ -71,16 +88,23 @@ import Hydra.Chain.Direct.Handlers ( DirectChainLog (..), chainSyncHandler, mkChain, + mkFakeL1Chain, newLocalChainState, onRollBackward, - onRollForward, mkFakeL1Chain, + onRollForward, ) import Hydra.Chain.Direct.ScriptRegistry (queryScriptRegistry) import Hydra.Chain.Direct.State ( ChainContext (..), - ChainStateAt (..), initialChainState, OpenState (OpenState, headId), ChainState (Idle, Open), openThreadOutput, observeCommit, + ChainState (Idle, Open), + ChainStateAt (..), + OpenState (OpenState, headId), + initialChainState, + observeCommit, + openThreadOutput, ) import Hydra.Chain.Direct.TimeHandle (queryTimeHandle) +import Hydra.Chain.Direct.Tx (OpenThreadOutput (OpenThreadOutput, openThreadUTxO)) import Hydra.Chain.Direct.Util ( readKeyPair, ) @@ -89,10 +113,16 @@ import Hydra.Chain.Direct.Wallet ( WalletInfoOnChain (..), newTinyWallet, ) +import Hydra.Data.ContestationPeriod (contestationPeriodFromDiffTime) +import Hydra.Ledger (ChainSlot (ChainSlot), UTxOType) +import Hydra.Ledger.Cardano.Configuration (readJsonFileThrow) import Hydra.Logging (Tracer, traceWith) -import Hydra.Options (ChainConfig (..), OfflineConfig(..)) +import Hydra.Options (ChainConfig (..), OfflineConfig (..)) import Hydra.Party (Party) +import Hydra.Plutus.Extras (posixFromUTCTime) +import Ouroboros.Consensus.HardFork.History (interpretQuery, mkInterpreter, neverForksSummary, wallclockToSlot) import Ouroboros.Consensus.HardFork.History qualified as Consensus +import Ouroboros.Consensus.Util.Time (nominalDelay) import Ouroboros.Network.Magic (NetworkMagic (..)) import Ouroboros.Network.Protocol.ChainSync.Client ( ChainSyncClient (..), @@ -105,22 +135,6 @@ import Ouroboros.Network.Protocol.LocalTxSubmission.Client ( LocalTxSubmissionClient (..), SubmitResult (..), ) -import qualified Data.Map as M -import Hydra.Cardano.Api.TxIn (toLedgerTxIn) -import Hydra.Cardano.Api.TxOut (toLedgerTxOut) -import Cardano.Api.UTxO (UTxO'(toMap)) -import qualified Data.Aeson as Aeson -import Hydra.Ledger (UTxOType, ChainSlot (ChainSlot)) -import Data.Time.Clock.POSIX (systemToPOSIXTime, getPOSIXTime, utcTimeToPOSIXSeconds) -import Hydra.Plutus.Extras (posixFromUTCTime) -import Hydra.Chain.Direct.Tx (OpenThreadOutput(OpenThreadOutput, openThreadUTxO)) -import Hydra.Data.ContestationPeriod (contestationPeriodFromDiffTime) -import Hydra.ContestationPeriod (fromChain) -import Hydra.Ledger.Cardano.Configuration (readJsonFileThrow) -import Cardano.Slotting.Time (mkSlotLength, toRelativeTime, SystemStart (SystemStart)) -import Cardano.Ledger.Shelley.API (fromNominalDiffTimeMicro) -import Ouroboros.Consensus.HardFork.History (neverForksSummary, mkInterpreter, wallclockToSlot, interpretQuery) -import Ouroboros.Consensus.Util.Time (nominalDelay) import Hydra.HeadId (HeadId (..)) @@ -179,76 +193,69 @@ mkTinyWallet tracer config = do withOfflineChain :: Tracer IO DirectChainLog -> -- TODO(ELAINE): change type maybe ? OfflineConfig -> + _ -> ChainContext -> HeadId -> -- | Last known chain state as loaded from persistence. ChainStateHistory Tx -> ChainComponent Tx IO a -withOfflineChain tracer OfflineConfig{initialUTxOFile, ledgerGenesisFile} ctx@ChainContext{ownParty} ownHeadId chainStateHistory callback action = do - - initialUTxO :: UTxOType Tx <- readJsonFileThrow (parseJSON @(UTxOType Tx)) initialUTxOFile - - 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 - , parties = [ownParty] - , contestationPeriod = fromChain $ contestationPeriodFromDiffTime (10) --TODO(Elaine): we should be able to set this to 0 - } } - - --NOTE(Elaine): should be no need to update the chain state, that's L1, there's nothing relevant there - -- observation events are to construct the L2 we want, with the initial utxo - callback $ Observation { newChainState = initialChainState, observedTx = - OnCommitTx - { party = ownParty - , committed = initialUTxO - } } - - -- TODO(Elaine): I think onInitialChainCommitTx in update will take care of posting a collectcom transaction since we shouldn't have any peers - -- callback $ Observation { newChainState = initialChainState, observedTx = OnCollectComTx } - - localChainState <- newLocalChainState emptyChainStateHistory +withOfflineChain tracer OfflineConfig{initialUTxOFile, ledgerGenesisFile} globals@Ledger.Globals{systemStart} ctx@ChainContext{ownParty} ownHeadId chainStateHistory callback action = do + localChainState <- newLocalChainState chainStateHistory let chainHandle = mkFakeL1Chain localChainState tracer ctx 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 - - Ledger.ShelleyGenesis{ sgSystemStart, sgSlotLength, sgEpochLength } <- - readJsonFileThrow (parseJSON @(Ledger.ShelleyGenesis StandardCrypto)) ledgerGenesisFile - - let slotLengthNominalDiffTime = fromNominalDiffTimeMicro sgSlotLength - slotLength = mkSlotLength slotLengthNominalDiffTime - let systemStart = SystemStart sgSystemStart - - let interpreter = mkInterpreter $ neverForksSummary sgEpochLength slotLength - - let slotFromUTCTime :: HasCallStack => UTCTime -> Either Consensus.PastHorizonException ChainSlot - slotFromUTCTime utcTime = do - let relativeTime = toRelativeTime systemStart utcTime - case interpretQuery interpreter (wallclockToSlot relativeTime) of - Left pastHorizonEx -> - Left pastHorizonEx - Right (SlotNo slotNoWord64, _timeSpentInSlot, _timeLeftInSlot) -> - Right . ChainSlot . fromIntegral @Word64 @Natural $ slotNoWord64 - - let tickForever :: IO () - tickForever = forever $ do - - chainTime <- getCurrentTime - -- NOTE(Elaine): this shouldn't happen in offline mode, we should not construct an era history that ever ends - chainSlot <- either throwIO pure . slotFromUTCTime $ chainTime - callback $ Tick { chainTime = chainTime, chainSlot } - - --NOTE(Elaine): this is just realToFrac, not sure if better etiquette to import or use directly - threadDelay $ nominalDelay slotLengthNominalDiffTime + tickForeverAction <- case ledgerGenesisFile of + Just filePath -> do + -- TODO(Elaine): confirm the latter approach in the case of empty genesis file is better + Ledger.ShelleyGenesis{sgSystemStart, sgSlotLength, sgEpochLength} <- + readJsonFileThrow (parseJSON @(Ledger.ShelleyGenesis StandardCrypto)) filePath + let slotLengthNominalDiffTime = 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 + + let tickForever :: IO () + tickForever = forever $ do + chainTime <- getCurrentTime + -- NOTE(Elaine): this shouldn't happen in offline mode, we should not construct an era history that ever ends + chainSlot <- either throwIO pure . slotFromUTCTime $ chainTime + callback $ Tick{chainTime = chainTime, chainSlot} + + -- NOTE(Elaine): this is just realToFrac, not sure if better etiquette to import or use directly + threadDelay $ nominalDelay slotLengthNominalDiffTime + 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 - tickForever + tickForeverAction (action chainHandle) case res of diff --git a/hydra-node/src/Hydra/Node/Run.hs b/hydra-node/src/Hydra/Node/Run.hs index fa7840f9f59..29b8c185126 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -14,11 +14,12 @@ import Hydra.Cardano.Api ( ProtocolParametersConversionError, ShelleyBasedEra (..), StandardCrypto, + SystemStart (SystemStart), Tx, toLedgerPParams, ) import Hydra.Cardano.Api qualified as Shelley -import Hydra.Chain (maximumNumberOfParties) +import Hydra.Chain (ChainEvent (..), OnChainTx (..), initHistory, maximumNumberOfParties) import Hydra.Chain.CardanoClient (QueryPoint (..), queryGenesisParameters) import Hydra.Chain.Direct (loadChainContext, mkTinyWallet, withDirectChain, withOfflineChain) import Hydra.Chain.Direct.State (initialChainState) @@ -64,6 +65,10 @@ import Hydra.Persistence (createPersistenceIncremental) import Hydra.HeadId (HeadId (..)) import Data.Aeson qualified as Aeson +import Hydra.Chain.Direct.Fixture (defaultGlobals) +import Hydra.ContestationPeriod (fromChain) +import Hydra.Data.ContestationPeriod (contestationPeriodFromDiffTime) +import Hydra.Ledger (IsTx (UTxOType)) import Hydra.Persistence (PersistenceIncremental (PersistenceIncremental, append, loadAll)) import Hydra.Snapshot (Snapshot (Snapshot), utxo) import UnliftIO.IO.File (writeBinaryFileDurableAtomic) @@ -101,15 +106,27 @@ run opts = do Nothing -> Right chainConfig Just offlineConfig' -> Left offlineConfig' - withCardanoLedger onlineOrOfflineConfig pparams $ \ledger -> do + let DirectChainConfig{networkId, nodeSocket} = chainConfig + + globals <- case offlineConfig of + Nothing -> + -- online + newGlobals =<< queryGenesisParameters networkId nodeSocket QueryTip + Just _ -> do + -- offline + systemStart <- SystemStart <$> getCurrentTime + pure $ defaultGlobals{Ledger.systemStart = systemStart} + + withCardanoLedger onlineOrOfflineConfig pparams globals $ \ledger -> do persistence <- createStateChangePersistence (persistenceDir <> "/state") (leftToMaybe onlineOrOfflineConfig) (hs, chainStateHistory) <- loadState (contramap Node tracer) persistence initialChainState checkHeadState (contramap Node tracer) env hs nodeState <- createNodeState hs -- Chain ctx <- loadChainContext chainConfig party hydraScriptsTxId - let headId = HeadId "FIXME(Elaine): headId" - withChain onlineOrOfflineConfig tracer ctx signingKey chainStateHistory headId (putEvent . OnChainEvent) $ \chain -> do + let headId = HeadId "HeadId" + + withChain onlineOrOfflineConfig tracer globals ctx signingKey chainStateHistory headId (putEvent . OnChainEvent) $ \chain -> do -- API let RunOptions{host, port, peers, nodeId} = opts putNetworkEvent (Authenticated msg otherParty) = putEvent $ NetworkEvent defaultTTL otherParty msg @@ -136,30 +153,27 @@ run opts = do Connected nodeid -> sendOutput $ PeerConnected nodeid Disconnected nodeid -> sendOutput $ PeerDisconnected nodeid - withChain onlineOrOfflineConfig tracer ctx signingKey chainStateHistory headId putEvent cont = case onlineOrOfflineConfig of - Left offlineConfig -> withOfflineChain (contramap DirectChain tracer) offlineConfig ctx headId chainStateHistory (putEvent . OnChainEvent) cont + withChain onlineOrOfflineConfig tracer globals ctx signingKey chainStateHistory headId putEvent cont = case onlineOrOfflineConfig of + Left offlineConfig -> withOfflineChain (contramap DirectChain tracer) offlineConfig globals ctx headId chainStateHistory (putEvent . OnChainEvent) cont Right onlineConfig -> do wallet <- mkTinyWallet (contramap DirectChain tracer) onlineConfig withDirectChain (contramap DirectChain tracer) onlineConfig ctx wallet chainStateHistory (putEvent . OnChainEvent) cont - withCardanoLedger onlineOrOfflineConfig protocolParams action = case onlineOrOfflineConfig of - Left offlineConfig -> withCardanoLedgerOffline offlineConfig protocolParams action - Right onlineConfig -> withCardanoLedgerOnline onlineConfig protocolParams action + withCardanoLedger onlineOrOfflineConfig protocolParams globals action = case onlineOrOfflineConfig of + Left offlineConfig -> withCardanoLedgerOffline offlineConfig protocolParams globals action + Right onlineConfig -> withCardanoLedgerOnline onlineConfig protocolParams globals action - withCardanoLedgerOffline OfflineConfig{ledgerGenesisFile} protocolParams action = do + withCardanoLedgerOffline OfflineConfig{} protocolParams globals action = do -- TODO(Elaine): double check previous messy branch for any other places where we query node -- TODO(Elaine): instead of reading file, we can embed our own defaults with shelleyGenesisDefaults -- that would be more convenient, but offer less control - genesisParameters <- readJsonFileThrow (parseJSON @(Ledger.ShelleyGenesis StandardCrypto)) ledgerGenesisFile - globals <- newGlobals $ fromShelleyGenesis genesisParameters -- NOTE(Elaine): we need globals here to call Cardano.Ledger.Shelley.API.Mempool.applyTxs ultimately -- that function could probably take less info but it's upstream of hydra itself i believe let ledgerEnv = newLedgerEnv protocolParams action (Ledger.cardanoLedger globals ledgerEnv) - withCardanoLedgerOnline chainConfig protocolParams action = do + withCardanoLedgerOnline chainConfig protocolParams globals action = do let DirectChainConfig{networkId, nodeSocket} = chainConfig - globals <- newGlobals =<< queryGenesisParameters networkId nodeSocket QueryTip let ledgerEnv = newLedgerEnv protocolParams action (Ledger.cardanoLedger globals ledgerEnv) diff --git a/hydra-node/src/Hydra/Options.hs b/hydra-node/src/Hydra/Options.hs index 11757123292..cbd0252acbd 100644 --- a/hydra-node/src/Hydra/Options.hs +++ b/hydra-node/src/Hydra/Options.hs @@ -148,9 +148,9 @@ initialUTxOFileParser = --NOTE(Elaine): we need globals here to call Cardano.Ledger.Shelley.API.Mempool.applyTxs ultimately -- that function could probably take less info but it's upstream of hydra itself i believe -ledgerGenesisFileParser :: Parser FilePath +ledgerGenesisFileParser :: Parser (Maybe FilePath) ledgerGenesisFileParser = - option + optional $ option str ( long "ledger-genesis" <> metavar "FILE" @@ -165,7 +165,7 @@ data OfflineUTxOWriteBackConfig = WriteBackToInitialUTxO | WriteBackToUTxOFile F data OfflineConfig = OfflineConfig { initialUTxOFile :: FilePath - , ledgerGenesisFile :: FilePath + , ledgerGenesisFile :: Maybe FilePath -- TODO(Elaine): need option to dump final utxo to file without going thru snapshot , utxoWriteBack :: Maybe OfflineUTxOWriteBackConfig } deriving (Eq, Show, Generic, FromJSON, ToJSON) @@ -261,7 +261,7 @@ instance Arbitrary RunOptions where --FIXME(Elaine): this instance doesn't do stuff correctly but was necessary during rebasing instance Arbitrary OfflineConfig where arbitrary = do - ledgerGenesisFile <- genFilePath "ledgerGenesis" + ledgerGenesisFile <- oneof [pure Nothing, Just <$> genFilePath "ledgerGenesis"] initialUTxOFile <- genFilePath "utxo.json" utxoWriteBack <- arbitrary -- writeFileBS initialUTxOFile "{}" From 8d8ae6ef2c58df9d83d1643d845330c7bcaa372f Mon Sep 17 00:00:00 2001 From: card Date: Mon, 30 Oct 2023 13:42:40 -0400 Subject: [PATCH 06/44] fix tests, offline mode is offline, many changes this commit might later be split up into several for readability --- hydra-node/exe/hydra-node/Main.hs | 1 + hydra-node/src/Hydra/Chain/Direct.hs | 3 +- hydra-node/src/Hydra/Node/Run.hs | 5 +++- hydra-node/src/Hydra/Options.hs | 44 ++++++++++++++++++---------- hydra-node/test/Hydra/OptionsSpec.hs | 2 ++ 5 files changed, 36 insertions(+), 19 deletions(-) diff --git a/hydra-node/exe/hydra-node/Main.hs b/hydra-node/exe/hydra-node/Main.hs index 051468317ae..0a4d47e1b83 100644 --- a/hydra-node/exe/hydra-node/Main.hs +++ b/hydra-node/exe/hydra-node/Main.hs @@ -38,6 +38,7 @@ main = do txId <- publishHydraScripts networkId publishNodeSocket sk putStr (decodeUtf8 (serialiseToRawBytesHex txId)) + identifyNode :: RunOptions -> RunOptions identifyNode opt@RunOptions{verbosity = Verbose "HydraNode", nodeId} = opt{verbosity = Verbose $ "HydraNode-" <> show nodeId} identifyNode opt = opt diff --git a/hydra-node/src/Hydra/Chain/Direct.hs b/hydra-node/src/Hydra/Chain/Direct.hs index 5dff1f91687..546355556cc 100644 --- a/hydra-node/src/Hydra/Chain/Direct.hs +++ b/hydra-node/src/Hydra/Chain/Direct.hs @@ -199,7 +199,7 @@ withOfflineChain :: -- | Last known chain state as loaded from persistence. ChainStateHistory Tx -> ChainComponent Tx IO a -withOfflineChain tracer OfflineConfig{initialUTxOFile, ledgerGenesisFile} globals@Ledger.Globals{systemStart} ctx@ChainContext{ownParty} ownHeadId chainStateHistory callback action = do +withOfflineChain tracer OfflineConfig{initialUTxOFile, ledgerGenesisFile} globals@Ledger.Globals{systemStart} ctx ownHeadId chainStateHistory callback action = do localChainState <- newLocalChainState chainStateHistory let chainHandle = mkFakeL1Chain localChainState tracer ctx ownHeadId callback @@ -208,7 +208,6 @@ withOfflineChain tracer OfflineConfig{initialUTxOFile, ledgerGenesisFile} global tickForeverAction <- case ledgerGenesisFile of Just filePath -> do - -- TODO(Elaine): confirm the latter approach in the case of empty genesis file is better Ledger.ShelleyGenesis{sgSystemStart, sgSlotLength, sgEpochLength} <- readJsonFileThrow (parseJSON @(Ledger.ShelleyGenesis StandardCrypto)) filePath let slotLengthNominalDiffTime = fromNominalDiffTimeMicro sgSlotLength diff --git a/hydra-node/src/Hydra/Node/Run.hs b/hydra-node/src/Hydra/Node/Run.hs index 29b8c185126..8ae38168a83 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -123,8 +123,11 @@ run opts = do checkHeadState (contramap Node tracer) env hs nodeState <- createNodeState hs -- Chain - ctx <- loadChainContext chainConfig party hydraScriptsTxId + ctx <- case onlineOrOfflineConfig of + Left _ -> pure (error "error: shouldnt be forced") -- this is only used in draftCommitTx in mkFakeL1Chain, which should be unused, so we can probably get rid of this in offline mode + Right _ -> loadChainContext chainConfig party hydraScriptsTxId let headId = HeadId "HeadId" + initializeStateIfOffline chainStateHistory headId party (putEvent . OnChainEvent) offlineConfig withChain onlineOrOfflineConfig tracer globals ctx signingKey chainStateHistory headId (putEvent . OnChainEvent) $ \chain -> do -- API diff --git a/hydra-node/src/Hydra/Options.hs b/hydra-node/src/Hydra/Options.hs index cbd0252acbd..6236675595d 100644 --- a/hydra-node/src/Hydra/Options.hs +++ b/hydra-node/src/Hydra/Options.hs @@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wno-orphans #-} +{-# LANGUAGE RecordWildCards #-} module Hydra.Options ( module Hydra.Options, @@ -146,15 +147,13 @@ initialUTxOFileParser = <> help "File containing initial UTxO for the L2 chain." ) ---NOTE(Elaine): we need globals here to call Cardano.Ledger.Shelley.API.Mempool.applyTxs ultimately --- that function could probably take less info but it's upstream of hydra itself i believe ledgerGenesisFileParser :: Parser (Maybe FilePath) ledgerGenesisFileParser = - optional $ option - str - ( long "ledger-genesis" + option + (optional str) + (long "ledger-genesis" <> metavar "FILE" - <> value "genesis.json" + <> value Nothing <> showDefault <> help "File containing ledger genesis parameters." ) @@ -166,7 +165,6 @@ data OfflineConfig = OfflineConfig { initialUTxOFile :: FilePath , ledgerGenesisFile :: Maybe FilePath - -- TODO(Elaine): need option to dump final utxo to file without going thru snapshot , utxoWriteBack :: Maybe OfflineUTxOWriteBackConfig } deriving (Eq, Show, Generic, FromJSON, ToJSON) @@ -175,25 +173,29 @@ offlineUTxOWriteBackOptionsParser :: Parser (Maybe OfflineUTxOWriteBackConfig) offlineUTxOWriteBackOptionsParser = optional $ asum - [ flag' WriteBackToInitialUTxO - ( long "write-back-to-initial-utxo" - <> help "Write back to initial UTxO file." - ) - , WriteBackToUTxOFile + [ WriteBackToUTxOFile <$> option str ( long "write-back-to-utxo-file" <> metavar "FILE" <> help "Write back to given UTxO file." ) + , flag' WriteBackToInitialUTxO + ( long "write-back-to-initial-utxo" + <> help "Write back to initial UTxO file." + ) + ] offlineOptionsParser :: Parser OfflineConfig offlineOptionsParser = - OfflineConfig - <$> initialUTxOFileParser - <*> ledgerGenesisFileParser - <*> offlineUTxOWriteBackOptionsParser + subparser . command "offline" $ + info (OfflineConfig + <$> initialUTxOFileParser + <*> ledgerGenesisFileParser + <*> offlineUTxOWriteBackOptionsParser) + (progDesc "Run Hydra in offline mode") + data RunOptions = RunOptions { verbosity :: Verbosity @@ -766,6 +768,7 @@ toArgs , persistenceDir , chainConfig , ledgerConfig + , offlineConfig } = isVerbose verbosity <> ["--node-id", unpack nId] @@ -781,6 +784,7 @@ toArgs <> ["--persistence-dir", persistenceDir] <> argsChainConfig <> argsLedgerConfig + <> maybe [] (\oc -> ["--offline-config", show oc]) offlineConfig --TODO(Elaine): nicer formatting where (NodeId nId) = nodeId isVerbose = \case @@ -809,6 +813,9 @@ toArgs argsLedgerConfig = ["--ledger-protocol-parameters", cardanoLedgerProtocolParametersFile] + + -- argsOfflineConfig = + -- ["--ut", initialUTxOFile] CardanoLedgerConfig { cardanoLedgerProtocolParametersFile @@ -822,6 +829,11 @@ toArgs , startChainFrom , contestationPeriod } = chainConfig + -- OfflineConfig + -- { initialUTxOFile + -- , ledgerGenesisFile + -- , utxoWriteBack + -- } = offlineConfig defaultRunOptions :: RunOptions defaultRunOptions = diff --git a/hydra-node/test/Hydra/OptionsSpec.hs b/hydra-node/test/Hydra/OptionsSpec.hs index 6f677edf3d6..b433e3cc37f 100644 --- a/hydra-node/test/Hydra/OptionsSpec.hs +++ b/hydra-node/test/Hydra/OptionsSpec.hs @@ -33,6 +33,7 @@ import Hydra.Options ( import Test.Aeson.GenericSpecs (roundtripAndGoldenSpecs) import Test.QuickCheck (Property, chooseEnum, counterexample, forAll, property, vectorOf, (===)) import Text.Regex.TDFA ((=~)) +import Hydra.Options (OfflineConfig(OfflineConfig), initialUTxOFile, ledgerGenesisFile, utxoWriteBack) spec :: Spec spec = parallel $ @@ -365,4 +366,5 @@ defaultRunOptions = , chainConfig = defaultChainConfig , ledgerConfig = defaultLedgerConfig , offlineConfig = Nothing + -- Just (OfflineConfig {initialUTxOFile = "utxo.json", ledgerGenesisFile = Just "genesis.json", utxoWriteBack = Nothing}) } From 22273687b1d282a3303d808b70de72cc87849d31 Mon Sep 17 00:00:00 2001 From: card Date: Wed, 1 Nov 2023 07:02:25 -0400 Subject: [PATCH 07/44] refactor offline chain into Hydra.Chain.Offline, cleanup --- hydra-node/hydra-node.cabal | 2 + hydra-node/src/Hydra/Chain/Direct.hs | 110 +------------- hydra-node/src/Hydra/Chain/Direct/Handlers.hs | 45 +----- hydra-node/src/Hydra/Chain/Offline.hs | 138 ++++++++++++++++++ .../src/Hydra/Chain/Offline/Handlers.hs | 58 ++++++++ hydra-node/src/Hydra/Node/Run.hs | 8 +- 6 files changed, 208 insertions(+), 153 deletions(-) create mode 100644 hydra-node/src/Hydra/Chain/Offline.hs create mode 100644 hydra-node/src/Hydra/Chain/Offline/Handlers.hs diff --git a/hydra-node/hydra-node.cabal b/hydra-node/hydra-node.cabal index 584726cbef0..3f99f305b47 100644 --- a/hydra-node/hydra-node.cabal +++ b/hydra-node/hydra-node.cabal @@ -64,6 +64,8 @@ library Hydra.Chain.Direct.Tx Hydra.Chain.Direct.Util Hydra.Chain.Direct.Wallet + Hydra.Chain.Offline + Hydra.Chain.Offline.Handlers Hydra.ContestationPeriod Hydra.Crypto Hydra.HeadId diff --git a/hydra-node/src/Hydra/Chain/Direct.hs b/hydra-node/src/Hydra/Chain/Direct.hs index 546355556cc..9ecd69d8e21 100644 --- a/hydra-node/src/Hydra/Chain/Direct.hs +++ b/hydra-node/src/Hydra/Chain/Direct.hs @@ -13,13 +13,9 @@ module Hydra.Chain.Direct ( import Hydra.Prelude -import Cardano.Api.UTxO (UTxO' (toMap)) -import Cardano.Ledger.BaseTypes (epochInfoPure) -import Cardano.Ledger.Shelley.API (fromNominalDiffTimeMicro) import Cardano.Ledger.Shelley.API qualified as Ledger -import Cardano.Ledger.Slot (EpochInfo, SlotNo (..)) -import Cardano.Slotting.EpochInfo (EpochInfo (EpochInfo), epochInfoFirst, epochInfoSlotToUTCTime, fixedEpochInfo, hoistEpochInfo) -import Cardano.Slotting.Time (SystemStart (SystemStart), mkSlotLength, toRelativeTime) +import Cardano.Ledger.Slot (EpochInfo) +import Cardano.Slotting.EpochInfo (hoistEpochInfo) import Control.Concurrent.Class.MonadSTM ( newEmptyTMVar, newTQueueIO, @@ -30,8 +26,6 @@ import Control.Concurrent.Class.MonadSTM ( ) import Control.Exception (IOException) import Control.Monad.Trans.Except (runExcept) -import Data.Aeson qualified as Aeson -import Data.Time.Clock.POSIX (getPOSIXTime, systemToPOSIXTime, utcTimeToPOSIXSeconds) import Hydra.Cardano.Api ( Block (..), BlockInMode (..), @@ -47,7 +41,6 @@ import Hydra.Cardano.Api ( LocalNodeConnectInfo (..), NetworkId, SocketPath, - StandardCrypto, Tx, TxId, TxInMode (..), @@ -56,24 +49,13 @@ import Hydra.Cardano.Api ( connectToLocalNode, getTxBody, getTxId, - readFileJSON, toLedgerUTxO, ) -import Hydra.Cardano.Api.TxIn (toLedgerTxIn) -import Hydra.Cardano.Api.TxOut (toLedgerTxOut) import Hydra.Chain ( ChainComponent, - ChainEvent (Observation, Tick, observedTx), ChainStateHistory, - OnChainTx (OnCollectComTx, OnCommitTx, OnInitTx, contestationPeriod, headId, parties), PostTxError (..), - chainSlot, - chainTime, - committed, currentState, - initHistory, - newChainState, - party, ) import Hydra.Chain.CardanoClient ( QueryPoint (..), @@ -88,23 +70,18 @@ import Hydra.Chain.Direct.Handlers ( DirectChainLog (..), chainSyncHandler, mkChain, - mkFakeL1Chain, newLocalChainState, onRollBackward, onRollForward, ) + import Hydra.Chain.Direct.ScriptRegistry (queryScriptRegistry) import Hydra.Chain.Direct.State ( ChainContext (..), - ChainState (Idle, Open), ChainStateAt (..), - OpenState (OpenState, headId), - initialChainState, - observeCommit, openThreadOutput, ) import Hydra.Chain.Direct.TimeHandle (queryTimeHandle) -import Hydra.Chain.Direct.Tx (OpenThreadOutput (OpenThreadOutput, openThreadUTxO)) import Hydra.Chain.Direct.Util ( readKeyPair, ) @@ -113,16 +90,10 @@ import Hydra.Chain.Direct.Wallet ( WalletInfoOnChain (..), newTinyWallet, ) -import Hydra.Data.ContestationPeriod (contestationPeriodFromDiffTime) -import Hydra.Ledger (ChainSlot (ChainSlot), UTxOType) -import Hydra.Ledger.Cardano.Configuration (readJsonFileThrow) import Hydra.Logging (Tracer, traceWith) -import Hydra.Options (ChainConfig (..), OfflineConfig (..)) +import Hydra.Options (ChainConfig (..)) import Hydra.Party (Party) -import Hydra.Plutus.Extras (posixFromUTCTime) -import Ouroboros.Consensus.HardFork.History (interpretQuery, mkInterpreter, neverForksSummary, wallclockToSlot) import Ouroboros.Consensus.HardFork.History qualified as Consensus -import Ouroboros.Consensus.Util.Time (nominalDelay) import Ouroboros.Network.Magic (NetworkMagic (..)) import Ouroboros.Network.Protocol.ChainSync.Client ( ChainSyncClient (..), @@ -136,8 +107,6 @@ import Ouroboros.Network.Protocol.LocalTxSubmission.Client ( SubmitResult (..), ) -import Hydra.HeadId (HeadId (..)) - -- | Build the 'ChainContext' from a 'ChainConfig' and additional information. loadChainContext :: ChainConfig -> @@ -190,77 +159,6 @@ mkTinyWallet tracer config = do hoistEpochInfo (first show . runExcept) $ Consensus.interpreterToEpochInfo interpreter -withOfflineChain :: - Tracer IO DirectChainLog -> -- TODO(ELAINE): change type maybe ? - OfflineConfig -> - _ -> - ChainContext -> - HeadId -> - -- | Last known chain state as loaded from persistence. - ChainStateHistory Tx -> - ChainComponent Tx IO a -withOfflineChain tracer OfflineConfig{initialUTxOFile, ledgerGenesisFile} globals@Ledger.Globals{systemStart} ctx ownHeadId chainStateHistory callback action = do - localChainState <- newLocalChainState chainStateHistory - let chainHandle = mkFakeL1Chain localChainState tracer ctx 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 = 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 - - let tickForever :: IO () - tickForever = forever $ do - chainTime <- getCurrentTime - -- NOTE(Elaine): this shouldn't happen in offline mode, we should not construct an era history that ever ends - chainSlot <- either throwIO pure . slotFromUTCTime $ chainTime - callback $ Tick{chainTime = chainTime, chainSlot} - - -- NOTE(Elaine): this is just realToFrac, not sure if better etiquette to import or use directly - threadDelay $ nominalDelay slotLengthNominalDiffTime - 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 - withDirectChain :: Tracer IO DirectChainLog -> ChainConfig -> diff --git a/hydra-node/src/Hydra/Chain/Direct/Handlers.hs b/hydra-node/src/Hydra/Chain/Direct/Handlers.hs index 273d6da177a..62de8adcdba 100644 --- a/hydra-node/src/Hydra/Chain/Direct/Handlers.hs +++ b/hydra-node/src/Hydra/Chain/Direct/Handlers.hs @@ -39,7 +39,7 @@ import Hydra.Chain ( PostTxError (..), currentState, pushNewState, - rollbackHistory, OnChainTx (OnInitTx, headId, OnAbortTx, OnCollectComTx, OnCloseTx, parties, contestationDeadline, contestationPeriod, OnContestTx, OnFanoutTx), HeadParameters (HeadParameters), snapshotNumber, + rollbackHistory, ) import Hydra.Chain.Direct.State ( ChainContext (..), @@ -128,48 +128,7 @@ type SubmitTx m = Tx -> m () -- | A way to acquire a 'TimeHandle' type GetTimeHandle m = m TimeHandle -mkFakeL1Chain :: - LocalChainState IO Tx - -- -> IO a - -> Tracer IO DirectChainLog - -> ChainContext - -- -> TinyWallet IO - -> HeadId - -> (ChainEvent Tx -> IO ()) - -> Chain Tx IO -mkFakeL1Chain localChainState tracer ctx ownHeadId callback = - Chain { - submitTx = const $ pure (), - draftCommitTx = \utxoToCommit -> do - ChainStateAt{chainState} <- atomically (getLatest localChainState) - case chainState of - Initial st -> - -- callback $ Observation { newChainState = cst, observedTx = OnCommitTx {party = ownParty ctx, committed = utxoToCommit}} - pure (commit' ctx st utxoToCommit) - _ -> pure $ Left FailedToDraftTxNotInitializing, - postTx = \tx -> do - cst@ChainStateAt{chainState=_chainState} <- atomically (getLatest localChainState) - traceWith tracer $ ToPost{toPost = tx} - - let headId = ownHeadId - _ <- case tx of - InitTx{headParameters=HeadParameters contestationPeriod parties} -> - callback $ Observation { newChainState = cst, observedTx = OnInitTx {headId = headId, parties=parties, contestationPeriod}} - AbortTx{} -> - callback $ Observation { newChainState = cst, observedTx = OnAbortTx {}} - CollectComTx{} -> - callback $ Observation { newChainState = cst, observedTx = OnCollectComTx {}} - CloseTx{confirmedSnapshot} -> do - inOneMinute <- addUTCTime 60 <$> getCurrentTime - callback $ Observation { newChainState = cst, observedTx = - OnCloseTx {headId, snapshotNumber = number $ getSnapshot confirmedSnapshot, contestationDeadline=inOneMinute}} -- ELAINE TODO: probably we shouldnt allow the clietn to do contestation in offline mode ? - ContestTx{confirmedSnapshot} -> -- this shouldnt really happen, i dont think we should allow contesting in offline mode - callback $ Observation { newChainState = cst, observedTx = - OnContestTx{snapshotNumber = number $ getSnapshot confirmedSnapshot}} - FanoutTx{} -> - callback $ Observation { newChainState = cst, observedTx = - OnFanoutTx{}} - pure ()} + -- | Create a `Chain` component for posting "real" cardano transactions. -- diff --git a/hydra-node/src/Hydra/Chain/Offline.hs b/hydra-node/src/Hydra/Chain/Offline.hs new file mode 100644 index 00000000000..15ec104d44b --- /dev/null +++ b/hydra-node/src/Hydra/Chain/Offline.hs @@ -0,0 +1,138 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE DisambiguateRecordFields #-} + +module Hydra.Chain.Offline ( + withOfflineChain +) where + +import Hydra.Prelude + +import Hydra.Chain.Offline.Handlers (mkFakeL1Chain) + +import Hydra.Logging (Tracer) + +import Hydra.Chain ( + ChainComponent, + ChainStateHistory, ChainEvent (Tick), chainTime, chainSlot, + ) +import Hydra.HeadId (HeadId) + +import Hydra.Chain.Direct.State ( + ChainContext (..), openThreadOutput, + ) + +import Hydra.Chain.Direct.Handlers ( + DirectChainLog (), --TODO(Elaine): make imports explicit, sort these etc + newLocalChainState, + ) + +import Hydra.Ledger (ChainSlot (ChainSlot)) +import Hydra.Ledger.Cardano.Configuration (readJsonFileThrow) + +import Hydra.Options (OfflineConfig(OfflineConfig, ledgerGenesisFile)) + +import qualified Cardano.Ledger.Shelley.API as Ledger + +import qualified Ouroboros.Consensus.HardFork.History as Consensus +import Ouroboros.Consensus.HardFork.History (neverForksSummary, mkInterpreter, wallclockToSlot, interpretQuery, slotToWallclock) + +import Cardano.Ledger.Slot (SlotNo(SlotNo, unSlotNo)) + +import qualified Cardano.Slotting.Time as Slotting +import Cardano.Slotting.Time (mkSlotLength, toRelativeTime, SystemStart (SystemStart)) + +import Cardano.Ledger.BaseTypes (epochInfoPure) + +import Cardano.Slotting.EpochInfo (epochInfoSlotToUTCTime, EpochInfo (EpochInfo), epochInfoFirst) + + +import Ouroboros.Consensus.Util.Time (nominalDelay) + +import Hydra.Cardano.Api ( + Tx, StandardCrypto, + ) + +withOfflineChain :: + Tracer IO DirectChainLog -> -- TODO(ELAINE): change type to indicate offline mode maybe? + OfflineConfig -> + Ledger.Globals -> + ChainContext -> + HeadId -> + -- | Last known chain state as loaded from persistence. + ChainStateHistory Tx -> + ChainComponent Tx IO a +withOfflineChain tracer OfflineConfig{ledgerGenesisFile} globals@Ledger.Globals{systemStart} ctx ownHeadId chainStateHistory callback action = do + + + localChainState <- newLocalChainState chainStateHistory + let chainHandle = mkFakeL1Chain localChainState tracer ctx 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 + + --TODO(Elaine): make sure ledgerGenesisFile is dry/consolidated, factor out + 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 \ No newline at end of file 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..921f9c1457f --- /dev/null +++ b/hydra-node/src/Hydra/Chain/Offline/Handlers.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE DisambiguateRecordFields#-} +module Hydra.Chain.Offline.Handlers ( + mkFakeL1Chain +) where + +import Hydra.Prelude +import Hydra.Chain.Direct.State (ChainStateAt(ChainStateAt), chainState, ChainState (Initial), ChainContext, commit') +import Hydra.Chain.Direct.Handlers (DirectChainLog(ToPost, toPost), LocalChainState, getLatest) +import Hydra.Chain (PostChainTx(headParameters, InitTx, AbortTx, CollectComTx, CloseTx, ContestTx, confirmedSnapshot, FanoutTx), ChainEvent (Observation, newChainState, observedTx), snapshotNumber, confirmedSnapshot, headId, HeadParameters (HeadParameters), Chain (postTx, draftCommitTx, submitTx, Chain), contestationDeadline, OnChainTx (OnInitTx, headId, OnAbortTx, OnCollectComTx, OnCloseTx, parties, contestationDeadline, contestationPeriod, OnContestTx, OnFanoutTx), HeadParameters (HeadParameters), snapshotNumber, PostTxError (FailedToDraftTxNotInitializing)) +import Hydra.Snapshot (getSnapshot, Snapshot (number)) +import Hydra.Logging (Tracer, traceWith) +import Hydra.Ledger.Cardano (Tx) + +import Hydra.HeadId(HeadId) + +mkFakeL1Chain :: + LocalChainState IO Tx + -> Tracer IO DirectChainLog + -> ChainContext + -> HeadId + -> (ChainEvent Tx -> IO ()) + -> Chain Tx IO +mkFakeL1Chain localChainState tracer ctx ownHeadId callback = + Chain { + submitTx = const $ pure (), + -- TODO(Elaine): this won't succeed currently because ctx will be bottom + -- it doesn't make much sense in offline mode in general, so we should refactor it out + draftCommitTx = \utxoToCommit -> do + ChainStateAt{chainState} <- atomically (getLatest localChainState) + case chainState of + Initial st -> + -- callback $ Observation { newChainState = cst, observedTx = OnCommitTx {party = ownParty ctx, committed = utxoToCommit}} + pure (commit' ctx st utxoToCommit) + _ -> pure $ Left FailedToDraftTxNotInitializing, + postTx = \tx -> do + cst@ChainStateAt{chainState=_chainState} <- atomically (getLatest localChainState) + traceWith tracer $ ToPost{toPost = tx} + + let headId = ownHeadId + _ <- case tx of + InitTx{headParameters=HeadParameters contestationPeriod parties} -> + callback $ Observation { newChainState = cst, observedTx = OnInitTx {headId = headId, parties=parties, contestationPeriod}} + AbortTx{} -> + callback $ Observation { newChainState = cst, observedTx = OnAbortTx {}} + CollectComTx{} -> + callback $ Observation { newChainState = cst, observedTx = OnCollectComTx {}} + CloseTx{confirmedSnapshot} -> do + inOneMinute <- addUTCTime 60 <$> getCurrentTime + callback $ Observation { newChainState = cst, observedTx = + OnCloseTx {headId, snapshotNumber = number $ getSnapshot confirmedSnapshot, contestationDeadline=inOneMinute}} -- ELAINE TODO: probably we shouldnt allow the clietn to do contestation in offline mode ? + ContestTx{confirmedSnapshot} -> -- this shouldnt really happen, i dont think we should allow contesting in offline mode + callback $ Observation { newChainState = cst, observedTx = + OnContestTx{snapshotNumber = number $ getSnapshot confirmedSnapshot}} + FanoutTx{} -> + callback $ Observation { newChainState = cst, observedTx = + OnFanoutTx{}} + pure ()} \ No newline at end of file diff --git a/hydra-node/src/Hydra/Node/Run.hs b/hydra-node/src/Hydra/Node/Run.hs index 8ae38168a83..1f49df0b2a6 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -21,8 +21,9 @@ import Hydra.Cardano.Api ( import Hydra.Cardano.Api qualified as Shelley import Hydra.Chain (ChainEvent (..), OnChainTx (..), initHistory, maximumNumberOfParties) import Hydra.Chain.CardanoClient (QueryPoint (..), queryGenesisParameters) -import Hydra.Chain.Direct (loadChainContext, mkTinyWallet, withDirectChain, withOfflineChain) +import Hydra.Chain.Direct (loadChainContext, mkTinyWallet, withDirectChain) import Hydra.Chain.Direct.State (initialChainState) +import Hydra.Chain.Offline (withOfflineChain) import Hydra.HeadLogic ( Environment (..), Event (..), @@ -164,7 +165,7 @@ run opts = do withCardanoLedger onlineOrOfflineConfig protocolParams globals action = case onlineOrOfflineConfig of Left offlineConfig -> withCardanoLedgerOffline offlineConfig protocolParams globals action - Right onlineConfig -> withCardanoLedgerOnline onlineConfig protocolParams globals action + Right _onlineConfig -> withCardanoLedgerOnline protocolParams globals action withCardanoLedgerOffline OfflineConfig{} protocolParams globals action = do -- TODO(Elaine): double check previous messy branch for any other places where we query node @@ -175,8 +176,7 @@ run opts = do let ledgerEnv = newLedgerEnv protocolParams action (Ledger.cardanoLedger globals ledgerEnv) - withCardanoLedgerOnline chainConfig protocolParams globals action = do - let DirectChainConfig{networkId, nodeSocket} = chainConfig + withCardanoLedgerOnline protocolParams globals action = do let ledgerEnv = newLedgerEnv protocolParams action (Ledger.cardanoLedger globals ledgerEnv) From 96e7beb2a2ef55e0149d7024fdcf6efddc1fcdad Mon Sep 17 00:00:00 2001 From: card Date: Wed, 1 Nov 2023 08:03:10 -0400 Subject: [PATCH 08/44] organize and cleanup more offlinemode --- hydra-node/exe/hydra-node/Main.hs | 1 - hydra-node/hydra-node.cabal | 1 + hydra-node/src/Hydra/Chain/Offline.hs | 3 +- .../src/Hydra/Chain/Offline/Persistence.hs | 70 +++++++++++++++++++ hydra-node/src/Hydra/Node/Run.hs | 14 ++-- 5 files changed, 82 insertions(+), 7 deletions(-) create mode 100644 hydra-node/src/Hydra/Chain/Offline/Persistence.hs diff --git a/hydra-node/exe/hydra-node/Main.hs b/hydra-node/exe/hydra-node/Main.hs index 0a4d47e1b83..051468317ae 100644 --- a/hydra-node/exe/hydra-node/Main.hs +++ b/hydra-node/exe/hydra-node/Main.hs @@ -38,7 +38,6 @@ main = do txId <- publishHydraScripts networkId publishNodeSocket sk putStr (decodeUtf8 (serialiseToRawBytesHex txId)) - identifyNode :: RunOptions -> RunOptions identifyNode opt@RunOptions{verbosity = Verbose "HydraNode", nodeId} = opt{verbosity = Verbose $ "HydraNode-" <> show nodeId} identifyNode opt = opt diff --git a/hydra-node/hydra-node.cabal b/hydra-node/hydra-node.cabal index 3f99f305b47..8834ea57bee 100644 --- a/hydra-node/hydra-node.cabal +++ b/hydra-node/hydra-node.cabal @@ -66,6 +66,7 @@ library Hydra.Chain.Direct.Wallet Hydra.Chain.Offline Hydra.Chain.Offline.Handlers + Hydra.Chain.Offline.Persistence Hydra.ContestationPeriod Hydra.Crypto Hydra.HeadId diff --git a/hydra-node/src/Hydra/Chain/Offline.hs b/hydra-node/src/Hydra/Chain/Offline.hs index 15ec104d44b..ee4d59806b0 100644 --- a/hydra-node/src/Hydra/Chain/Offline.hs +++ b/hydra-node/src/Hydra/Chain/Offline.hs @@ -18,7 +18,7 @@ import Hydra.Chain ( import Hydra.HeadId (HeadId) import Hydra.Chain.Direct.State ( - ChainContext (..), openThreadOutput, + ChainContext (..), initialChainState ) import Hydra.Chain.Direct.Handlers ( @@ -45,7 +45,6 @@ import Cardano.Ledger.BaseTypes (epochInfoPure) import Cardano.Slotting.EpochInfo (epochInfoSlotToUTCTime, EpochInfo (EpochInfo), epochInfoFirst) - import Ouroboros.Consensus.Util.Time (nominalDelay) import Hydra.Cardano.Api ( 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..60a28066f18 --- /dev/null +++ b/hydra-node/src/Hydra/Chain/Offline/Persistence.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE DisambiguateRecordFields #-} +module Hydra.Chain.Offline.Persistence ( + initializeStateIfOffline +, createPersistenceWithUTxOWriteBack) where + +import Hydra.Prelude + +import Hydra.Chain ( + ChainStateHistory, ChainEvent (observedTx, Observation), newChainState, committed, party, initHistory, OnChainTx (OnInitTx, OnCommitTx, headId, contestationPeriod, parties), + ) +import Hydra.Ledger (IsTx(UTxOType)) +import Hydra.Cardano.Api (Tx) +import Hydra.Chain.Direct.State (initialChainState) +import Hydra.Data.ContestationPeriod (contestationPeriodFromDiffTime) +import Hydra.ContestationPeriod (fromChain) +import Hydra.HeadId (HeadId) +import Hydra.Party (Party) +import Hydra.Persistence (PersistenceIncremental(PersistenceIncremental, append, loadAll), createPersistenceIncremental) +import Hydra.HeadLogic (StateChanged(SnapshotConfirmed, snapshot)) +import Hydra.Snapshot (Snapshot(Snapshot, utxo)) +import UnliftIO.IO.File (writeBinaryFileDurableAtomic) +import qualified Data.Aeson as Aeson + +initializeStateIfOffline :: ChainStateHistory Tx + -> UTxOType Tx + -> HeadId + -> Party + -> (ChainEvent Tx -> IO ()) + -> IO () +initializeStateIfOffline chainStateHistory initialUTxO ownHeadId ownParty 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 + , parties = [ownParty] + , contestationPeriod = fromChain $ contestationPeriodFromDiffTime (10) --TODO(Elaine): we should be able to set this to 0 + } } + + --NOTE(Elaine): should be no need to update the chain state, that's L1, there's nothing relevant there + -- observation events are to construct the L2 we want, with the initial utxo + callback $ Observation { newChainState = initialChainState, observedTx = + OnCommitTx + { party = ownParty + , committed = initialUTxO + } } + + -- TODO(Elaine): I think onInitialChainCommitTx in update will take care of posting a collectcom transaction since we shouldn't have any peers + -- callback $ Observation { newChainState = initialChainState, observedTx = OnCollectComTx } + +createPersistenceWithUTxOWriteBack :: + (MonadIO m, MonadThrow m) => + FilePath -> + FilePath -> + m (PersistenceIncremental (StateChanged Tx) m) +createPersistenceWithUTxOWriteBack persistenceFilePath utxoFilePath = do + PersistenceIncremental{append, loadAll} <- createPersistenceIncremental persistenceFilePath + pure PersistenceIncremental { loadAll, append = \stateChange -> do + append stateChange + case stateChange of + --TODO(Elaine): do we want to do this on snapshot confirmation or on transaction over local utxo + -- see onOpenNetworkReqTx + -- TransactionAppliedToLocalUTxO{tx, newLocalUTxO} -> + -- writeBinaryFileDurableAtomic utxoFilePath . toStrict $ Aeson.encode newLocalUTxO + SnapshotConfirmed { snapshot = Snapshot{utxo} } -> + writeBinaryFileDurableAtomic utxoFilePath . toStrict $ Aeson.encode utxo + _ -> pure () + } \ No newline at end of file diff --git a/hydra-node/src/Hydra/Node/Run.hs b/hydra-node/src/Hydra/Node/Run.hs index 1f49df0b2a6..8da9a361934 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -24,6 +24,7 @@ import Hydra.Chain.CardanoClient (QueryPoint (..), queryGenesisParameters) import Hydra.Chain.Direct (loadChainContext, mkTinyWallet, withDirectChain) import Hydra.Chain.Direct.State (initialChainState) import Hydra.Chain.Offline (withOfflineChain) +import Hydra.Chain.Offline.Persistence (initializeStateIfOffline) import Hydra.HeadLogic ( Environment (..), Event (..), @@ -121,15 +122,21 @@ run opts = do withCardanoLedger onlineOrOfflineConfig pparams globals $ \ledger -> do persistence <- createStateChangePersistence (persistenceDir <> "/state") (leftToMaybe onlineOrOfflineConfig) (hs, chainStateHistory) <- loadState (contramap Node tracer) persistence initialChainState + + let headId = HeadId "HeadId" + case offlineConfig of + Nothing -> pure () + Just (OfflineConfig{initialUTxOFile}) -> do + initialUTxO :: UTxOType Tx <- readJsonFileThrow (parseJSON @(UTxOType Tx)) initialUTxOFile + initializeStateIfOffline chainStateHistory initialUTxO headId party (putEvent . OnChainEvent) + checkHeadState (contramap Node tracer) env hs nodeState <- createNodeState hs -- Chain ctx <- case onlineOrOfflineConfig of Left _ -> pure (error "error: shouldnt be forced") -- this is only used in draftCommitTx in mkFakeL1Chain, which should be unused, so we can probably get rid of this in offline mode + -- chaincontext is normally Right _ -> loadChainContext chainConfig party hydraScriptsTxId - let headId = HeadId "HeadId" - initializeStateIfOffline chainStateHistory headId party (putEvent . OnChainEvent) offlineConfig - withChain onlineOrOfflineConfig tracer globals ctx signingKey chainStateHistory headId (putEvent . OnChainEvent) $ \chain -> do -- API let RunOptions{host, port, peers, nodeId} = opts @@ -175,7 +182,6 @@ run opts = do -- that function could probably take less info but it's upstream of hydra itself i believe let ledgerEnv = newLedgerEnv protocolParams action (Ledger.cardanoLedger globals ledgerEnv) - withCardanoLedgerOnline protocolParams globals action = do let ledgerEnv = newLedgerEnv protocolParams action (Ledger.cardanoLedger globals ledgerEnv) From e55a1cf32b61113e561bee53f404306e5929dfcc Mon Sep 17 00:00:00 2001 From: card Date: Fri, 3 Nov 2023 02:16:28 -0400 Subject: [PATCH 09/44] commit small todos i forgot to push earlier --- hydra-node/src/Hydra/Chain/Offline.hs | 4 +- .../src/Hydra/Chain/Offline/Persistence.hs | 14 +++--- hydra-node/src/Hydra/Node/Run.hs | 45 +++---------------- hydra-node/src/Hydra/Options.hs | 38 ++++++++++------ hydra-node/test/Hydra/OptionsSpec.hs | 1 - 5 files changed, 42 insertions(+), 60 deletions(-) diff --git a/hydra-node/src/Hydra/Chain/Offline.hs b/hydra-node/src/Hydra/Chain/Offline.hs index ee4d59806b0..4e65bb4fbb5 100644 --- a/hydra-node/src/Hydra/Chain/Offline.hs +++ b/hydra-node/src/Hydra/Chain/Offline.hs @@ -18,11 +18,11 @@ import Hydra.Chain ( import Hydra.HeadId (HeadId) import Hydra.Chain.Direct.State ( - ChainContext (..), initialChainState + ChainContext (), ) import Hydra.Chain.Direct.Handlers ( - DirectChainLog (), --TODO(Elaine): make imports explicit, sort these etc + DirectChainLog (), newLocalChainState, ) diff --git a/hydra-node/src/Hydra/Chain/Offline/Persistence.hs b/hydra-node/src/Hydra/Chain/Offline/Persistence.hs index 60a28066f18..f68d468b9c2 100644 --- a/hydra-node/src/Hydra/Chain/Offline/Persistence.hs +++ b/hydra-node/src/Hydra/Chain/Offline/Persistence.hs @@ -1,7 +1,8 @@ {-# LANGUAGE DisambiguateRecordFields #-} module Hydra.Chain.Offline.Persistence ( initializeStateIfOffline -, createPersistenceWithUTxOWriteBack) where +, createPersistenceWithUTxOWriteBack +, createStateChangePersistence) where import Hydra.Prelude @@ -60,11 +61,12 @@ createPersistenceWithUTxOWriteBack persistenceFilePath utxoFilePath = do pure PersistenceIncremental { loadAll, append = \stateChange -> do append stateChange case stateChange of - --TODO(Elaine): do we want to do this on snapshot confirmation or on transaction over local utxo - -- see onOpenNetworkReqTx - -- TransactionAppliedToLocalUTxO{tx, newLocalUTxO} -> - -- writeBinaryFileDurableAtomic utxoFilePath . toStrict $ Aeson.encode newLocalUTxO SnapshotConfirmed { snapshot = Snapshot{utxo} } -> writeBinaryFileDurableAtomic utxoFilePath . toStrict $ Aeson.encode utxo _ -> pure () - } \ No newline at end of file + } + +createStateChangePersistence :: (MonadIO m, MonadThrow m) => FilePath -> Maybe FilePath -> m (PersistenceIncremental (StateChanged Tx) m) +createStateChangePersistence persistenceFilePath = \case + Just utxoWriteBackFilePath -> createPersistenceWithUTxOWriteBack persistenceFilePath utxoWriteBackFilePath + _ -> createPersistenceIncremental persistenceFilePath \ No newline at end of file diff --git a/hydra-node/src/Hydra/Node/Run.hs b/hydra-node/src/Hydra/Node/Run.hs index 8da9a361934..242209732bf 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -24,7 +24,7 @@ import Hydra.Chain.CardanoClient (QueryPoint (..), queryGenesisParameters) import Hydra.Chain.Direct (loadChainContext, mkTinyWallet, withDirectChain) import Hydra.Chain.Direct.State (initialChainState) import Hydra.Chain.Offline (withOfflineChain) -import Hydra.Chain.Offline.Persistence (initializeStateIfOffline) +import Hydra.Chain.Offline.Persistence (createStateChangePersistence, initializeStateIfOffline) import Hydra.HeadLogic ( Environment (..), Event (..), @@ -60,6 +60,7 @@ import Hydra.Options ( OfflineConfig (OfflineConfig, initialUTxOFile, ledgerGenesisFile, utxoWriteBack), OfflineUTxOWriteBackConfig (..), RunOptions (..), + offlineOptionsNormalizedUtxoWriteBackFilePath, validateRunOptions, ) import Hydra.Persistence (createPersistenceIncremental) @@ -119,8 +120,8 @@ run opts = do systemStart <- SystemStart <$> getCurrentTime pure $ defaultGlobals{Ledger.systemStart = systemStart} - withCardanoLedger onlineOrOfflineConfig pparams globals $ \ledger -> do - persistence <- createStateChangePersistence (persistenceDir <> "/state") (leftToMaybe onlineOrOfflineConfig) + withCardanoLedger pparams globals $ \ledger -> do + persistence <- createStateChangePersistence (persistenceDir <> "/state") (offlineOptionsNormalizedUtxoWriteBackFilePath =<< leftToMaybe onlineOrOfflineConfig) (hs, chainStateHistory) <- loadState (contramap Node tracer) persistence initialChainState let headId = HeadId "HeadId" @@ -135,7 +136,6 @@ run opts = do -- Chain ctx <- case onlineOrOfflineConfig of Left _ -> pure (error "error: shouldnt be forced") -- this is only used in draftCommitTx in mkFakeL1Chain, which should be unused, so we can probably get rid of this in offline mode - -- chaincontext is normally Right _ -> loadChainContext chainConfig party hydraScriptsTxId withChain onlineOrOfflineConfig tracer globals ctx signingKey chainStateHistory headId (putEvent . OnChainEvent) $ \chain -> do -- API @@ -170,9 +170,9 @@ run opts = do wallet <- mkTinyWallet (contramap DirectChain tracer) onlineConfig withDirectChain (contramap DirectChain tracer) onlineConfig ctx wallet chainStateHistory (putEvent . OnChainEvent) cont - withCardanoLedger onlineOrOfflineConfig protocolParams globals action = case onlineOrOfflineConfig of - Left offlineConfig -> withCardanoLedgerOffline offlineConfig protocolParams globals action - Right _onlineConfig -> withCardanoLedgerOnline protocolParams globals action + withCardanoLedger protocolParams globals action = + let ledgerEnv = newLedgerEnv protocolParams + in action (Ledger.cardanoLedger globals ledgerEnv) withCardanoLedgerOffline OfflineConfig{} protocolParams globals action = do -- TODO(Elaine): double check previous messy branch for any other places where we query node @@ -190,37 +190,6 @@ identifyNode :: RunOptions -> RunOptions identifyNode opt@RunOptions{verbosity = Verbose "HydraNode", nodeId} = opt{verbosity = Verbose $ "HydraNode-" <> show nodeId} identifyNode opt = opt -createStateChangePersistence :: (MonadIO m, MonadThrow m) => FilePath -> Maybe OfflineConfig -> m (PersistenceIncremental (StateChanged Tx) m) -createStateChangePersistence persistenceFilePath = \case - Just OfflineConfig{initialUTxOFile, utxoWriteBack = Just writeBackConfig} -> - createPersistenceWithUTxOWriteBack persistenceFilePath $ case writeBackConfig of - WriteBackToInitialUTxO -> initialUTxOFile - WriteBackToUTxOFile customFile -> customFile - _ -> createPersistenceIncremental persistenceFilePath - --- TODO(Elaine): move this elsewhere -createPersistenceWithUTxOWriteBack :: - (MonadIO m, MonadThrow m) => - FilePath -> - FilePath -> - m (PersistenceIncremental (StateChanged Tx) m) -createPersistenceWithUTxOWriteBack persistenceFilePath utxoFilePath = do - PersistenceIncremental{append, loadAll} <- createPersistenceIncremental persistenceFilePath - pure - PersistenceIncremental - { loadAll - , append = \stateChange -> do - append stateChange - case stateChange of - -- TODO(Elaine): do we want to do this on snapshot confirmation or on transaction over local utxo - -- see onOpenNetworkReqTx - -- TransactionAppliedToLocalUTxO{tx, newLocalUTxO} -> - -- writeBinaryFileDurableAtomic utxoFilePath . toStrict $ Aeson.encode newLocalUTxO - Hydra.HeadLogic.SnapshotConfirmed{snapshot = Snapshot{utxo}} -> - writeBinaryFileDurableAtomic utxoFilePath . toStrict $ Aeson.encode utxo - _ -> pure () - } - -- TODO(ELAINE): figure out a less strange way to do this -- | Taken from Cardano.Api.GenesisParameters, a private module in cardano-api diff --git a/hydra-node/src/Hydra/Options.hs b/hydra-node/src/Hydra/Options.hs index 6236675595d..ef9ce9caff7 100644 --- a/hydra-node/src/Hydra/Options.hs +++ b/hydra-node/src/Hydra/Options.hs @@ -1,5 +1,6 @@ {-# OPTIONS_GHC -Wno-orphans #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ApplicativeDo #-} module Hydra.Options ( module Hydra.Options, @@ -195,7 +196,14 @@ offlineOptionsParser = <*> ledgerGenesisFileParser <*> offlineUTxOWriteBackOptionsParser) (progDesc "Run Hydra in offline mode") - + +offlineOptionsNormalizedUtxoWriteBackFilePath :: OfflineConfig -> Maybe FilePath +offlineOptionsNormalizedUtxoWriteBackFilePath OfflineConfig{initialUTxOFile, utxoWriteBack} = + case utxoWriteBack of + Just (WriteBackToUTxOFile path) -> Just path + Just (WriteBackToInitialUTxO) -> Just initialUTxOFile + Nothing -> Nothing + data RunOptions = RunOptions { verbosity :: Verbosity @@ -213,7 +221,7 @@ data RunOptions = RunOptions , persistenceDir :: FilePath , chainConfig :: ChainConfig , ledgerConfig :: LedgerConfig - , offlineConfig :: Maybe OfflineConfig --TODO(Elaine): nicer type ? Nothing = online mode, but thats a bit weird + , offlineConfig :: Maybe OfflineConfig } deriving stock (Eq, Show, Generic) deriving anyclass (ToJSON, FromJSON) @@ -255,7 +263,7 @@ instance Arbitrary RunOptions where , persistenceDir , chainConfig , ledgerConfig - , offlineConfig = Nothing --TODO(Elaine): should we change this? + , offlineConfig = Nothing } shrink = genericShrink @@ -784,7 +792,7 @@ toArgs <> ["--persistence-dir", persistenceDir] <> argsChainConfig <> argsLedgerConfig - <> maybe [] (\oc -> ["--offline-config", show oc]) offlineConfig --TODO(Elaine): nicer formatting + <> argsOfflineConfig --TODO(Elaine): nicer formatting where (NodeId nId) = nodeId isVerbose = \case @@ -814,9 +822,6 @@ toArgs argsLedgerConfig = ["--ledger-protocol-parameters", cardanoLedgerProtocolParametersFile] - -- argsOfflineConfig = - -- ["--ut", initialUTxOFile] - CardanoLedgerConfig { cardanoLedgerProtocolParametersFile } = ledgerConfig @@ -829,11 +834,18 @@ toArgs , startChainFrom , contestationPeriod } = chainConfig - -- OfflineConfig - -- { initialUTxOFile - -- , ledgerGenesisFile - -- , utxoWriteBack - -- } = offlineConfig + + argsOfflineConfig = case offlineConfig of + Nothing -> [] + Just OfflineConfig{initialUTxOFile, ledgerGenesisFile, utxoWriteBack} -> + ["offline"] + <> ["--initial-utxo-file", initialUTxOFile] + <> maybe [] (\s -> ["--ledger-genesis-file", s]) ledgerGenesisFile + <> maybe [] (\case + WriteBackToInitialUTxO -> ["--write-back-to-initial-utxo"] + WriteBackToUTxOFile s -> ["--write-back-to-utxo-file", s] + ) + utxoWriteBack defaultRunOptions :: RunOptions defaultRunOptions = @@ -852,7 +864,7 @@ defaultRunOptions = , persistenceDir = "./" , chainConfig = defaultChainConfig , ledgerConfig = defaultLedgerConfig - , offlineConfig = Nothing --TODO(Elaine) + , offlineConfig = Nothing } where localhost = IPv4 $ toIPv4 [127, 0, 0, 1] diff --git a/hydra-node/test/Hydra/OptionsSpec.hs b/hydra-node/test/Hydra/OptionsSpec.hs index b433e3cc37f..63d98851b4d 100644 --- a/hydra-node/test/Hydra/OptionsSpec.hs +++ b/hydra-node/test/Hydra/OptionsSpec.hs @@ -366,5 +366,4 @@ defaultRunOptions = , chainConfig = defaultChainConfig , ledgerConfig = defaultLedgerConfig , offlineConfig = Nothing - -- Just (OfflineConfig {initialUTxOFile = "utxo.json", ledgerGenesisFile = Just "genesis.json", utxoWriteBack = Nothing}) } From 50ce8467ab12ef085f39d893ff333bfd921e0f67 Mon Sep 17 00:00:00 2001 From: card Date: Fri, 3 Nov 2023 21:50:17 -0400 Subject: [PATCH 10/44] clean up draftCommitTx --- hydra-node/src/Hydra/Chain.hs | 2 ++ hydra-node/src/Hydra/Chain/Offline.hs | 8 ++------ hydra-node/src/Hydra/Chain/Offline/Handlers.hs | 15 +++------------ hydra-node/src/Hydra/Node/Run.hs | 14 +------------- 4 files changed, 8 insertions(+), 31 deletions(-) diff --git a/hydra-node/src/Hydra/Chain.hs b/hydra-node/src/Hydra/Chain.hs index 8e9a9d7ecdc..90f0d4af2a3 100644 --- a/hydra-node/src/Hydra/Chain.hs +++ b/hydra-node/src/Hydra/Chain.hs @@ -147,6 +147,8 @@ data PostTxError tx CommittedTooMuchADAForMainnet {userCommittedLovelace :: Lovelace, mainnetLimitLovelace :: Lovelace} | -- | We can only draft commit tx for the user when in Initializing state FailedToDraftTxNotInitializing + | -- | We cannot draft a commit tx in offline mode + FailedToDraftTxOffline | -- | Committing UTxO addressed to the internal wallet is forbidden. SpendingNodeUtxoForbidden | FailedToConstructAbortTx diff --git a/hydra-node/src/Hydra/Chain/Offline.hs b/hydra-node/src/Hydra/Chain/Offline.hs index 4e65bb4fbb5..806eac55205 100644 --- a/hydra-node/src/Hydra/Chain/Offline.hs +++ b/hydra-node/src/Hydra/Chain/Offline.hs @@ -17,9 +17,6 @@ import Hydra.Chain ( ) import Hydra.HeadId (HeadId) -import Hydra.Chain.Direct.State ( - ChainContext (), - ) import Hydra.Chain.Direct.Handlers ( DirectChainLog (), @@ -55,16 +52,15 @@ withOfflineChain :: Tracer IO DirectChainLog -> -- TODO(ELAINE): change type to indicate offline mode maybe? OfflineConfig -> Ledger.Globals -> - ChainContext -> HeadId -> -- | Last known chain state as loaded from persistence. ChainStateHistory Tx -> ChainComponent Tx IO a -withOfflineChain tracer OfflineConfig{ledgerGenesisFile} globals@Ledger.Globals{systemStart} ctx ownHeadId chainStateHistory callback action = do +withOfflineChain tracer OfflineConfig{ledgerGenesisFile} globals@Ledger.Globals{systemStart} ownHeadId chainStateHistory callback action = do localChainState <- newLocalChainState chainStateHistory - let chainHandle = mkFakeL1Chain localChainState tracer ctx ownHeadId callback + let chainHandle = mkFakeL1Chain 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 diff --git a/hydra-node/src/Hydra/Chain/Offline/Handlers.hs b/hydra-node/src/Hydra/Chain/Offline/Handlers.hs index 921f9c1457f..fc783f2fb25 100644 --- a/hydra-node/src/Hydra/Chain/Offline/Handlers.hs +++ b/hydra-node/src/Hydra/Chain/Offline/Handlers.hs @@ -5,7 +5,7 @@ module Hydra.Chain.Offline.Handlers ( ) where import Hydra.Prelude -import Hydra.Chain.Direct.State (ChainStateAt(ChainStateAt), chainState, ChainState (Initial), ChainContext, commit') +import Hydra.Chain.Direct.State (ChainStateAt(ChainStateAt), chainState) import Hydra.Chain.Direct.Handlers (DirectChainLog(ToPost, toPost), LocalChainState, getLatest) import Hydra.Chain (PostChainTx(headParameters, InitTx, AbortTx, CollectComTx, CloseTx, ContestTx, confirmedSnapshot, FanoutTx), ChainEvent (Observation, newChainState, observedTx), snapshotNumber, confirmedSnapshot, headId, HeadParameters (HeadParameters), Chain (postTx, draftCommitTx, submitTx, Chain), contestationDeadline, OnChainTx (OnInitTx, headId, OnAbortTx, OnCollectComTx, OnCloseTx, parties, contestationDeadline, contestationPeriod, OnContestTx, OnFanoutTx), HeadParameters (HeadParameters), snapshotNumber, PostTxError (FailedToDraftTxNotInitializing)) import Hydra.Snapshot (getSnapshot, Snapshot (number)) @@ -17,22 +17,13 @@ import Hydra.HeadId(HeadId) mkFakeL1Chain :: LocalChainState IO Tx -> Tracer IO DirectChainLog - -> ChainContext -> HeadId -> (ChainEvent Tx -> IO ()) -> Chain Tx IO -mkFakeL1Chain localChainState tracer ctx ownHeadId callback = +mkFakeL1Chain localChainState tracer ownHeadId callback = Chain { submitTx = const $ pure (), - -- TODO(Elaine): this won't succeed currently because ctx will be bottom - -- it doesn't make much sense in offline mode in general, so we should refactor it out - draftCommitTx = \utxoToCommit -> do - ChainStateAt{chainState} <- atomically (getLatest localChainState) - case chainState of - Initial st -> - -- callback $ Observation { newChainState = cst, observedTx = OnCommitTx {party = ownParty ctx, committed = utxoToCommit}} - pure (commit' ctx st utxoToCommit) - _ -> pure $ Left FailedToDraftTxNotInitializing, + draftCommitTx = const . pure $ Left FailedToDraftTxNotInitializing, postTx = \tx -> do cst@ChainStateAt{chainState=_chainState} <- atomically (getLatest localChainState) traceWith tracer $ ToPost{toPost = tx} diff --git a/hydra-node/src/Hydra/Node/Run.hs b/hydra-node/src/Hydra/Node/Run.hs index 242209732bf..219fdcb1ada 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -165,7 +165,7 @@ run opts = do Disconnected nodeid -> sendOutput $ PeerDisconnected nodeid withChain onlineOrOfflineConfig tracer globals ctx signingKey chainStateHistory headId putEvent cont = case onlineOrOfflineConfig of - Left offlineConfig -> withOfflineChain (contramap DirectChain tracer) offlineConfig globals ctx headId chainStateHistory (putEvent . OnChainEvent) cont + Left offlineConfig -> withOfflineChain (contramap DirectChain tracer) offlineConfig globals headId chainStateHistory (putEvent . OnChainEvent) cont Right onlineConfig -> do wallet <- mkTinyWallet (contramap DirectChain tracer) onlineConfig withDirectChain (contramap DirectChain tracer) onlineConfig ctx wallet chainStateHistory (putEvent . OnChainEvent) cont @@ -174,18 +174,6 @@ run opts = do let ledgerEnv = newLedgerEnv protocolParams in action (Ledger.cardanoLedger globals ledgerEnv) - withCardanoLedgerOffline OfflineConfig{} protocolParams globals action = do - -- TODO(Elaine): double check previous messy branch for any other places where we query node - -- TODO(Elaine): instead of reading file, we can embed our own defaults with shelleyGenesisDefaults - -- that would be more convenient, but offer less control - -- NOTE(Elaine): we need globals here to call Cardano.Ledger.Shelley.API.Mempool.applyTxs ultimately - -- that function could probably take less info but it's upstream of hydra itself i believe - let ledgerEnv = newLedgerEnv protocolParams - action (Ledger.cardanoLedger globals ledgerEnv) - withCardanoLedgerOnline protocolParams globals action = do - let ledgerEnv = newLedgerEnv protocolParams - action (Ledger.cardanoLedger globals ledgerEnv) - identifyNode :: RunOptions -> RunOptions identifyNode opt@RunOptions{verbosity = Verbose "HydraNode", nodeId} = opt{verbosity = Verbose $ "HydraNode-" <> show nodeId} identifyNode opt = opt From fa1308bd6d77c3e790b9c5040f6c2260e06f8c9b Mon Sep 17 00:00:00 2001 From: card Date: Sat, 4 Nov 2023 05:55:35 -0400 Subject: [PATCH 11/44] fix remaining todos --- hydra-node/src/Hydra/Chain/Offline.hs | 1 - .../src/Hydra/Chain/Offline/Persistence.hs | 20 +++-- hydra-node/src/Hydra/Node.hs | 81 ++++++++++++++++++- hydra-node/src/Hydra/Node/Run.hs | 22 +++-- hydra-node/src/Hydra/Options.hs | 3 +- 5 files changed, 101 insertions(+), 26 deletions(-) diff --git a/hydra-node/src/Hydra/Chain/Offline.hs b/hydra-node/src/Hydra/Chain/Offline.hs index 806eac55205..df86d79c6ef 100644 --- a/hydra-node/src/Hydra/Chain/Offline.hs +++ b/hydra-node/src/Hydra/Chain/Offline.hs @@ -65,7 +65,6 @@ withOfflineChain tracer OfflineConfig{ledgerGenesisFile} globals@Ledger.Globals{ -- 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 - --TODO(Elaine): make sure ledgerGenesisFile is dry/consolidated, factor out tickForeverAction <- case ledgerGenesisFile of Just filePath -> do Ledger.ShelleyGenesis{ sgSystemStart, sgSlotLength, sgEpochLength } <- diff --git a/hydra-node/src/Hydra/Chain/Offline/Persistence.hs b/hydra-node/src/Hydra/Chain/Offline/Persistence.hs index f68d468b9c2..819b917ed6d 100644 --- a/hydra-node/src/Hydra/Chain/Offline/Persistence.hs +++ b/hydra-node/src/Hydra/Chain/Offline/Persistence.hs @@ -12,8 +12,6 @@ import Hydra.Chain ( import Hydra.Ledger (IsTx(UTxOType)) import Hydra.Cardano.Api (Tx) import Hydra.Chain.Direct.State (initialChainState) -import Hydra.Data.ContestationPeriod (contestationPeriodFromDiffTime) -import Hydra.ContestationPeriod (fromChain) import Hydra.HeadId (HeadId) import Hydra.Party (Party) import Hydra.Persistence (PersistenceIncremental(PersistenceIncremental, append, loadAll), createPersistenceIncremental) @@ -21,14 +19,16 @@ import Hydra.HeadLogic (StateChanged(SnapshotConfirmed, snapshot)) import Hydra.Snapshot (Snapshot(Snapshot, utxo)) import UnliftIO.IO.File (writeBinaryFileDurableAtomic) import qualified Data.Aeson as Aeson +import Hydra.ContestationPeriod (ContestationPeriod) initializeStateIfOffline :: ChainStateHistory Tx -> UTxOType Tx -> HeadId -> Party + -> ContestationPeriod -> (ChainEvent Tx -> IO ()) -> IO () -initializeStateIfOffline chainStateHistory initialUTxO ownHeadId ownParty callback = do +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 @@ -37,7 +37,7 @@ initializeStateIfOffline chainStateHistory initialUTxO ownHeadId ownParty callba OnInitTx { headId = ownHeadId , parties = [ownParty] - , contestationPeriod = fromChain $ contestationPeriodFromDiffTime (10) --TODO(Elaine): we should be able to set this to 0 + , contestationPeriod = contestationPeriod } } --NOTE(Elaine): should be no need to update the chain state, that's L1, there's nothing relevant there @@ -48,12 +48,11 @@ initializeStateIfOffline chainStateHistory initialUTxO ownHeadId ownParty callba , committed = initialUTxO } } - -- TODO(Elaine): I think onInitialChainCommitTx in update will take care of posting a collectcom transaction since we shouldn't have any peers - -- callback $ Observation { newChainState = initialChainState, observedTx = OnCollectComTx } - createPersistenceWithUTxOWriteBack :: (MonadIO m, MonadThrow m) => + -- The filepath to write the main state change event persistence to FilePath -> + -- The filepath to write UTxO to. UTxO is written after every confirmed snapshot. FilePath -> m (PersistenceIncremental (StateChanged Tx) m) createPersistenceWithUTxOWriteBack persistenceFilePath utxoFilePath = do @@ -66,7 +65,12 @@ createPersistenceWithUTxOWriteBack persistenceFilePath utxoFilePath = do _ -> pure () } -createStateChangePersistence :: (MonadIO m, MonadThrow m) => FilePath -> Maybe FilePath -> m (PersistenceIncremental (StateChanged Tx) m) +createStateChangePersistence :: (MonadIO m, MonadThrow m) => + -- The filepath to write the main state change event persistence to + FilePath -> + -- The optional filepath to write UTxO to. UTxO is written after every confirmed snapshot. + Maybe FilePath -> + m (PersistenceIncremental (StateChanged Tx) m) createStateChangePersistence persistenceFilePath = \case Just utxoWriteBackFilePath -> createPersistenceWithUTxOWriteBack persistenceFilePath utxoWriteBackFilePath _ -> createPersistenceIncremental persistenceFilePath \ No newline at end of file diff --git a/hydra-node/src/Hydra/Node.hs b/hydra-node/src/Hydra/Node.hs index b9c2e080bb8..7dbaa62e8cd 100644 --- a/hydra-node/src/Hydra/Node.hs +++ b/hydra-node/src/Hydra/Node.hs @@ -10,6 +10,10 @@ module Hydra.Node where import Hydra.Prelude +import Cardano.Ledger.BaseTypes (Globals) +import Cardano.Ledger.BaseTypes qualified as Ledger +import Cardano.Ledger.Crypto qualified as Ledger +import Cardano.Ledger.Shelley.API qualified as Shelley import Control.Concurrent.Class.MonadSTM ( MonadLabelledSTM, labelTVarIO, @@ -18,7 +22,8 @@ import Control.Concurrent.Class.MonadSTM ( ) import Control.Monad.Trans.Writer (execWriter, tell) import Hydra.API.Server (Server, sendOutput) -import Hydra.Cardano.Api (AsType (AsPaymentKey, AsSigningKey, AsVerificationKey), getVerificationKey) +import Hydra.Cardano.Api (AsType (AsPaymentKey, AsSigningKey, AsVerificationKey), GenesisParameters (..), ShelleyEra, StandardCrypto, SystemStart (..), getVerificationKey) +import Hydra.Cardano.Api qualified as Shelley import Hydra.Chain ( Chain (..), ChainStateHistory, @@ -27,6 +32,7 @@ import Hydra.Chain ( IsChainState, PostTxError, ) +import Hydra.Chain.Direct.Fixture (defaultGlobals) import Hydra.Chain.Direct.Tx (verificationKeyToOnChainId) import Hydra.Chain.Direct.Util (readFileTextEnvelopeThrow) import Hydra.Crypto (AsType (AsHydraKey)) @@ -46,13 +52,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.Ledger.Cardano qualified as Ledger +import Hydra.Ledger.Cardano.Configuration (newGlobals, readJsonFileThrow) 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 (..), OfflineConfig) +import Hydra.Options (ChainConfig (..), OfflineConfig, RunOptions (..)) import Hydra.Party (Party (..), deriveParty) import Hydra.Persistence (PersistenceIncremental (..), loadAll) @@ -282,3 +290,70 @@ loadState tracer persistence defaultChainState = do pure (headState, chainStateHistory) where initialState = Idle IdleState{chainState = defaultChainState} + +loadGlobalsFromGenesis :: Maybe FilePath -> IO 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 + +-- loadStateOffline :: +-- (MonadThrow m, IsChainState tx) => +-- Tracer m (HydraNodeLog tx) -> +-- PersistenceIncremental (StateChanged tx) m -> +-- ChainStateType tx -> +-- HeadId -> +-- UTxOType tx -> + +-- m (HeadState tx, ChainStateHistory tx) +-- loadStateOffline tracer persistence defaultChainState defaultHeadId defaultUtxo = do +-- loadState tracer persistence defaultChainState + +-- TODO(ELAINE): figure out a less strange way to do this + +-- | Taken from Cardano.Api.GenesisParameters, a private module in cardano-api +fromShelleyGenesis :: Shelley.ShelleyGenesis Ledger.StandardCrypto -> GenesisParameters 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/Node/Run.hs b/hydra-node/src/Hydra/Node/Run.hs index 219fdcb1ada..3bb8be42687 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -95,7 +95,7 @@ run :: RunOptions -> IO () run opts = do either (throwIO . InvalidOptionException) pure $ validateRunOptions opts let RunOptions{verbosity, monitoringPort, persistenceDir, offlineConfig} = opts - env@Environment{party, otherParties, signingKey} <- initEnvironment opts + env@Environment{party, otherParties, signingKey, contestationPeriod} <- initEnvironment opts withTracer verbosity $ \tracer' -> withMonitoring monitoringPort tracer' $ \tracer -> do traceWith tracer (NodeOptions opts) @@ -129,15 +129,19 @@ run opts = do Nothing -> pure () Just (OfflineConfig{initialUTxOFile}) -> do initialUTxO :: UTxOType Tx <- readJsonFileThrow (parseJSON @(UTxOType Tx)) initialUTxOFile - initializeStateIfOffline chainStateHistory initialUTxO headId party (putEvent . OnChainEvent) + initializeStateIfOffline chainStateHistory initialUTxO headId party contestationPeriod (putEvent . OnChainEvent) checkHeadState (contramap Node tracer) env hs nodeState <- createNodeState hs -- Chain - ctx <- case onlineOrOfflineConfig of - Left _ -> pure (error "error: shouldnt be forced") -- this is only used in draftCommitTx in mkFakeL1Chain, which should be unused, so we can probably get rid of this in offline mode - Right _ -> loadChainContext chainConfig party hydraScriptsTxId - withChain onlineOrOfflineConfig tracer globals ctx signingKey chainStateHistory headId (putEvent . OnChainEvent) $ \chain -> do + let withChain cont = case onlineOrOfflineConfig of + Left offlineConfig' -> + withOfflineChain (contramap DirectChain tracer) offlineConfig' globals headId chainStateHistory (putEvent . OnChainEvent) cont + Right onlineConfig -> do + ctx <- loadChainContext chainConfig party hydraScriptsTxId + wallet <- mkTinyWallet (contramap DirectChain tracer) onlineConfig + withDirectChain (contramap DirectChain tracer) onlineConfig 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 @@ -164,12 +168,6 @@ run opts = do Connected nodeid -> sendOutput $ PeerConnected nodeid Disconnected nodeid -> sendOutput $ PeerDisconnected nodeid - withChain onlineOrOfflineConfig tracer globals ctx signingKey chainStateHistory headId putEvent cont = case onlineOrOfflineConfig of - Left offlineConfig -> withOfflineChain (contramap DirectChain tracer) offlineConfig globals headId chainStateHistory (putEvent . OnChainEvent) cont - Right onlineConfig -> do - wallet <- mkTinyWallet (contramap DirectChain tracer) onlineConfig - withDirectChain (contramap DirectChain tracer) onlineConfig ctx wallet chainStateHistory (putEvent . OnChainEvent) cont - withCardanoLedger protocolParams globals action = let ledgerEnv = newLedgerEnv protocolParams in action (Ledger.cardanoLedger globals ledgerEnv) diff --git a/hydra-node/src/Hydra/Options.hs b/hydra-node/src/Hydra/Options.hs index ef9ce9caff7..7bad4b8b2bc 100644 --- a/hydra-node/src/Hydra/Options.hs +++ b/hydra-node/src/Hydra/Options.hs @@ -169,7 +169,6 @@ data OfflineConfig = OfflineConfig , utxoWriteBack :: Maybe OfflineUTxOWriteBackConfig } deriving (Eq, Show, Generic, FromJSON, ToJSON) --- TODO(Elaine): name this offlineUTxOWriteBackOptionsParser :: Parser (Maybe OfflineUTxOWriteBackConfig) offlineUTxOWriteBackOptionsParser = optional $ @@ -792,7 +791,7 @@ toArgs <> ["--persistence-dir", persistenceDir] <> argsChainConfig <> argsLedgerConfig - <> argsOfflineConfig --TODO(Elaine): nicer formatting + <> argsOfflineConfig where (NodeId nId) = nodeId isVerbose = \case From 615b95c8add03c87ce63db1b72d3e3114083f7d7 Mon Sep 17 00:00:00 2001 From: card Date: Wed, 8 Nov 2023 05:04:35 -0500 Subject: [PATCH 12/44] various pr feedback --- hydra-node/exe/hydra-node/Main.hs | 1 + hydra-node/src/Hydra/Chain/Direct.hs | 3 +-- hydra-node/src/Hydra/Chain/Direct/Handlers.hs | 1 - hydra-node/src/Hydra/Chain/Offline.hs | 13 +++++++--- .../src/Hydra/Chain/Offline/Handlers.hs | 2 +- hydra-node/src/Hydra/Node/Run.hs | 25 ++++++++----------- hydra-node/test/Hydra/OptionsSpec.hs | 1 - 7 files changed, 23 insertions(+), 23 deletions(-) diff --git a/hydra-node/exe/hydra-node/Main.hs b/hydra-node/exe/hydra-node/Main.hs index 051468317ae..fd12b161879 100644 --- a/hydra-node/exe/hydra-node/Main.hs +++ b/hydra-node/exe/hydra-node/Main.hs @@ -7,6 +7,7 @@ import Hydra.Prelude hiding (fromList) import Hydra.Cardano.Api ( serialiseToRawBytesHex, + toLedgerPParams ) import Hydra.Chain.Direct.ScriptRegistry (publishHydraScripts) diff --git a/hydra-node/src/Hydra/Chain/Direct.hs b/hydra-node/src/Hydra/Chain/Direct.hs index 9ecd69d8e21..cf7654e2e94 100644 --- a/hydra-node/src/Hydra/Chain/Direct.hs +++ b/hydra-node/src/Hydra/Chain/Direct.hs @@ -54,7 +54,7 @@ import Hydra.Cardano.Api ( import Hydra.Chain ( ChainComponent, ChainStateHistory, - PostTxError (..), + PostTxError (FailedToPostTx, failureReason), currentState, ) import Hydra.Chain.CardanoClient ( @@ -79,7 +79,6 @@ import Hydra.Chain.Direct.ScriptRegistry (queryScriptRegistry) import Hydra.Chain.Direct.State ( ChainContext (..), ChainStateAt (..), - openThreadOutput, ) import Hydra.Chain.Direct.TimeHandle (queryTimeHandle) import Hydra.Chain.Direct.Util ( diff --git a/hydra-node/src/Hydra/Chain/Direct/Handlers.hs b/hydra-node/src/Hydra/Chain/Direct/Handlers.hs index 62de8adcdba..11ba6dc119e 100644 --- a/hydra-node/src/Hydra/Chain/Direct/Handlers.hs +++ b/hydra-node/src/Hydra/Chain/Direct/Handlers.hs @@ -81,7 +81,6 @@ import Hydra.Logging (Tracer, traceWith) import Hydra.Plutus.Extras (posixToUTCTime) import Hydra.Plutus.Orphans () import System.IO.Error (userError) -import Hydra.Snapshot (getSnapshot, Snapshot (number)) import Hydra.HeadId (HeadId) diff --git a/hydra-node/src/Hydra/Chain/Offline.hs b/hydra-node/src/Hydra/Chain/Offline.hs index df86d79c6ef..aa6fbb9b7ab 100644 --- a/hydra-node/src/Hydra/Chain/Offline.hs +++ b/hydra-node/src/Hydra/Chain/Offline.hs @@ -23,10 +23,10 @@ import Hydra.Chain.Direct.Handlers ( newLocalChainState, ) -import Hydra.Ledger (ChainSlot (ChainSlot)) +import Hydra.Ledger (ChainSlot (ChainSlot), IsTx (UTxOType)) import Hydra.Ledger.Cardano.Configuration (readJsonFileThrow) -import Hydra.Options (OfflineConfig(OfflineConfig, ledgerGenesisFile)) +import Hydra.Options (OfflineConfig(OfflineConfig, ledgerGenesisFile, initialUTxOFile)) import qualified Cardano.Ledger.Shelley.API as Ledger @@ -47,17 +47,24 @@ import Ouroboros.Consensus.Util.Time (nominalDelay) import Hydra.Cardano.Api ( Tx, StandardCrypto, ) +import Hydra.Chain.Offline.Persistence (initializeStateIfOffline) +import Hydra.Party (Party) +import Hydra.ContestationPeriod (ContestationPeriod) withOfflineChain :: Tracer IO DirectChainLog -> -- TODO(ELAINE): change type to indicate offline mode maybe? OfflineConfig -> Ledger.Globals -> HeadId -> + Party -> + ContestationPeriod -> -- | Last known chain state as loaded from persistence. ChainStateHistory Tx -> ChainComponent Tx IO a -withOfflineChain tracer OfflineConfig{ledgerGenesisFile} globals@Ledger.Globals{systemStart} ownHeadId chainStateHistory callback action = do +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 localChainState tracer ownHeadId callback diff --git a/hydra-node/src/Hydra/Chain/Offline/Handlers.hs b/hydra-node/src/Hydra/Chain/Offline/Handlers.hs index fc783f2fb25..d21bd92cc23 100644 --- a/hydra-node/src/Hydra/Chain/Offline/Handlers.hs +++ b/hydra-node/src/Hydra/Chain/Offline/Handlers.hs @@ -7,7 +7,7 @@ module Hydra.Chain.Offline.Handlers ( import Hydra.Prelude import Hydra.Chain.Direct.State (ChainStateAt(ChainStateAt), chainState) import Hydra.Chain.Direct.Handlers (DirectChainLog(ToPost, toPost), LocalChainState, getLatest) -import Hydra.Chain (PostChainTx(headParameters, InitTx, AbortTx, CollectComTx, CloseTx, ContestTx, confirmedSnapshot, FanoutTx), ChainEvent (Observation, newChainState, observedTx), snapshotNumber, confirmedSnapshot, headId, HeadParameters (HeadParameters), Chain (postTx, draftCommitTx, submitTx, Chain), contestationDeadline, OnChainTx (OnInitTx, headId, OnAbortTx, OnCollectComTx, OnCloseTx, parties, contestationDeadline, contestationPeriod, OnContestTx, OnFanoutTx), HeadParameters (HeadParameters), snapshotNumber, PostTxError (FailedToDraftTxNotInitializing)) +import Hydra.Chain (PostChainTx(headParameters, InitTx, AbortTx, CollectComTx, CloseTx, ContestTx, confirmedSnapshot, FanoutTx), ChainEvent (Observation, newChainState, observedTx), snapshotNumber, confirmedSnapshot, HeadParameters (HeadParameters), Chain (postTx, draftCommitTx, submitTx, Chain), contestationDeadline, OnChainTx (OnInitTx, headId, OnAbortTx, OnCollectComTx, OnCloseTx, parties, contestationPeriod, OnContestTx, OnFanoutTx), HeadParameters (HeadParameters), snapshotNumber, PostTxError (FailedToDraftTxNotInitializing)) import Hydra.Snapshot (getSnapshot, Snapshot (number)) import Hydra.Logging (Tracer, traceWith) import Hydra.Ledger.Cardano (Tx) diff --git a/hydra-node/src/Hydra/Node/Run.hs b/hydra-node/src/Hydra/Node/Run.hs index 3bb8be42687..1eb897fa7c1 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -19,12 +19,12 @@ import Hydra.Cardano.Api ( toLedgerPParams, ) import Hydra.Cardano.Api qualified as Shelley -import Hydra.Chain (ChainEvent (..), OnChainTx (..), initHistory, maximumNumberOfParties) +import Hydra.Chain (ChainEvent (..), OnChainTx (..), maximumNumberOfParties) import Hydra.Chain.CardanoClient (QueryPoint (..), queryGenesisParameters) import Hydra.Chain.Direct (loadChainContext, mkTinyWallet, withDirectChain) import Hydra.Chain.Direct.State (initialChainState) import Hydra.Chain.Offline (withOfflineChain) -import Hydra.Chain.Offline.Persistence (createStateChangePersistence, initializeStateIfOffline) +import Hydra.Chain.Offline.Persistence (createStateChangePersistence) import Hydra.HeadLogic ( Environment (..), Event (..), @@ -48,6 +48,7 @@ import Hydra.Node ( checkHeadState, createNodeState, initEnvironment, + loadGlobalsFromGenesis, loadState, runHydraNode, ) @@ -112,31 +113,25 @@ run opts = do let DirectChainConfig{networkId, nodeSocket} = chainConfig globals <- case offlineConfig of - Nothing -> + Nothing -> do -- online - newGlobals =<< queryGenesisParameters networkId nodeSocket QueryTip - Just _ -> do + globals' <- newGlobals =<< queryGenesisParameters networkId nodeSocket QueryTip + pure globals' + Just OfflineConfig{ledgerGenesisFile} -> do -- offline - systemStart <- SystemStart <$> getCurrentTime - pure $ defaultGlobals{Ledger.systemStart = systemStart} + loadGlobalsFromGenesis ledgerGenesisFile withCardanoLedger pparams globals $ \ledger -> do persistence <- createStateChangePersistence (persistenceDir <> "/state") (offlineOptionsNormalizedUtxoWriteBackFilePath =<< leftToMaybe onlineOrOfflineConfig) (hs, chainStateHistory) <- loadState (contramap Node tracer) persistence initialChainState - let headId = HeadId "HeadId" - case offlineConfig of - Nothing -> pure () - Just (OfflineConfig{initialUTxOFile}) -> do - initialUTxO :: UTxOType Tx <- readJsonFileThrow (parseJSON @(UTxOType Tx)) initialUTxOFile - initializeStateIfOffline chainStateHistory initialUTxO headId party contestationPeriod (putEvent . OnChainEvent) - checkHeadState (contramap Node tracer) env hs nodeState <- createNodeState hs -- Chain let withChain cont = case onlineOrOfflineConfig of Left offlineConfig' -> - withOfflineChain (contramap DirectChain tracer) offlineConfig' globals headId chainStateHistory (putEvent . OnChainEvent) cont + let headId = HeadId "HeadId" + in withOfflineChain (contramap DirectChain tracer) offlineConfig' globals headId party contestationPeriod chainStateHistory (putEvent . OnChainEvent) cont Right onlineConfig -> do ctx <- loadChainContext chainConfig party hydraScriptsTxId wallet <- mkTinyWallet (contramap DirectChain tracer) onlineConfig diff --git a/hydra-node/test/Hydra/OptionsSpec.hs b/hydra-node/test/Hydra/OptionsSpec.hs index 63d98851b4d..6f677edf3d6 100644 --- a/hydra-node/test/Hydra/OptionsSpec.hs +++ b/hydra-node/test/Hydra/OptionsSpec.hs @@ -33,7 +33,6 @@ import Hydra.Options ( import Test.Aeson.GenericSpecs (roundtripAndGoldenSpecs) import Test.QuickCheck (Property, chooseEnum, counterexample, forAll, property, vectorOf, (===)) import Text.Regex.TDFA ((=~)) -import Hydra.Options (OfflineConfig(OfflineConfig), initialUTxOFile, ledgerGenesisFile, utxoWriteBack) spec :: Spec spec = parallel $ From 97f64c20040367e88eeed412f0099a610e3b0b15 Mon Sep 17 00:00:00 2001 From: card Date: Wed, 8 Nov 2023 05:07:56 -0500 Subject: [PATCH 13/44] code standard --- hydra-node/exe/hydra-node/Main.hs | 7 +- hydra-node/src/Hydra/Chain.hs | 2 +- hydra-node/src/Hydra/Chain/Direct/Handlers.hs | 4 - hydra-node/src/Hydra/Chain/Offline.hs | 58 +++++----- .../src/Hydra/Chain/Offline/Handlers.hs | 83 ++++++++------ .../src/Hydra/Chain/Offline/Persistence.hs | 106 +++++++++++------- hydra-node/src/Hydra/Node.hs | 2 +- hydra-node/src/Hydra/Options.hs | 43 +++---- 8 files changed, 177 insertions(+), 128 deletions(-) diff --git a/hydra-node/exe/hydra-node/Main.hs b/hydra-node/exe/hydra-node/Main.hs index fd12b161879..d05804d0abd 100644 --- a/hydra-node/exe/hydra-node/Main.hs +++ b/hydra-node/exe/hydra-node/Main.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE TypeApplications #-} @@ -7,7 +8,7 @@ import Hydra.Prelude hiding (fromList) import Hydra.Cardano.Api ( serialiseToRawBytesHex, - toLedgerPParams + toLedgerPParams, ) import Hydra.Chain.Direct.ScriptRegistry (publishHydraScripts) @@ -19,6 +20,10 @@ import Hydra.Options ( PublishOptions (..), RunOptions (..), parseHydraCommand, + LedgerConfig (..), + OfflineConfig (..), + offlineOptionsNormalizedUtxoWriteBackFilePath, + validateRunOptions, ) import Hydra.Utils (genHydraKeys) diff --git a/hydra-node/src/Hydra/Chain.hs b/hydra-node/src/Hydra/Chain.hs index 90f0d4af2a3..ee544446d83 100644 --- a/hydra-node/src/Hydra/Chain.hs +++ b/hydra-node/src/Hydra/Chain.hs @@ -148,7 +148,7 @@ data PostTxError tx | -- | We can only draft commit tx for the user when in Initializing state FailedToDraftTxNotInitializing | -- | We cannot draft a commit tx in offline mode - FailedToDraftTxOffline + FailedToDraftTxOffline | -- | Committing UTxO addressed to the internal wallet is forbidden. SpendingNodeUtxoForbidden | FailedToConstructAbortTx diff --git a/hydra-node/src/Hydra/Chain/Direct/Handlers.hs b/hydra-node/src/Hydra/Chain/Direct/Handlers.hs index 11ba6dc119e..1925198ea58 100644 --- a/hydra-node/src/Hydra/Chain/Direct/Handlers.hs +++ b/hydra-node/src/Hydra/Chain/Direct/Handlers.hs @@ -82,8 +82,6 @@ import Hydra.Plutus.Extras (posixToUTCTime) import Hydra.Plutus.Orphans () import System.IO.Error (userError) -import Hydra.HeadId (HeadId) - -- | Handle of a mutable local chain state that is kept in the direct chain layer. data LocalChainState m tx = LocalChainState { getLatest :: STM m (ChainStateType tx) @@ -127,8 +125,6 @@ type SubmitTx m = Tx -> m () -- | A way to acquire a 'TimeHandle' type GetTimeHandle m = m TimeHandle - - -- | Create a `Chain` component for posting "real" cardano transactions. -- -- This component does not actually interact with a cardano-node, but creates diff --git a/hydra-node/src/Hydra/Chain/Offline.hs b/hydra-node/src/Hydra/Chain/Offline.hs index aa6fbb9b7ab..0938778204d 100644 --- a/hydra-node/src/Hydra/Chain/Offline.hs +++ b/hydra-node/src/Hydra/Chain/Offline.hs @@ -1,8 +1,8 @@ -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE TypeApplications #-} module Hydra.Chain.Offline ( - withOfflineChain + withOfflineChain, ) where import Hydra.Prelude @@ -13,11 +13,13 @@ import Hydra.Logging (Tracer) import Hydra.Chain ( ChainComponent, - ChainStateHistory, ChainEvent (Tick), chainTime, chainSlot, + ChainEvent (Tick), + ChainStateHistory, + chainSlot, + chainTime, ) import Hydra.HeadId (HeadId) - import Hydra.Chain.Direct.Handlers ( DirectChainLog (), newLocalChainState, @@ -26,30 +28,31 @@ import Hydra.Chain.Direct.Handlers ( import Hydra.Ledger (ChainSlot (ChainSlot), IsTx (UTxOType)) import Hydra.Ledger.Cardano.Configuration (readJsonFileThrow) -import Hydra.Options (OfflineConfig(OfflineConfig, ledgerGenesisFile, initialUTxOFile)) +import Hydra.Options (OfflineConfig (OfflineConfig, initialUTxOFile, ledgerGenesisFile)) -import qualified Cardano.Ledger.Shelley.API as Ledger +import Cardano.Ledger.Shelley.API qualified as Ledger -import qualified Ouroboros.Consensus.HardFork.History as Consensus -import Ouroboros.Consensus.HardFork.History (neverForksSummary, mkInterpreter, wallclockToSlot, interpretQuery, slotToWallclock) +import Ouroboros.Consensus.HardFork.History (interpretQuery, mkInterpreter, neverForksSummary, slotToWallclock, wallclockToSlot) +import Ouroboros.Consensus.HardFork.History qualified as Consensus -import Cardano.Ledger.Slot (SlotNo(SlotNo, unSlotNo)) +import Cardano.Ledger.Slot (SlotNo (SlotNo, unSlotNo)) -import qualified Cardano.Slotting.Time as Slotting -import Cardano.Slotting.Time (mkSlotLength, toRelativeTime, SystemStart (SystemStart)) +import Cardano.Slotting.Time (SystemStart (SystemStart), mkSlotLength, toRelativeTime) +import Cardano.Slotting.Time qualified as Slotting import Cardano.Ledger.BaseTypes (epochInfoPure) -import Cardano.Slotting.EpochInfo (epochInfoSlotToUTCTime, EpochInfo (EpochInfo), epochInfoFirst) +import Cardano.Slotting.EpochInfo (EpochInfo (EpochInfo), epochInfoFirst, epochInfoSlotToUTCTime) import Ouroboros.Consensus.Util.Time (nominalDelay) import Hydra.Cardano.Api ( - Tx, StandardCrypto, + StandardCrypto, + Tx, ) import Hydra.Chain.Offline.Persistence (initializeStateIfOffline) -import Hydra.Party (Party) import Hydra.ContestationPeriod (ContestationPeriod) +import Hydra.Party (Party) withOfflineChain :: Tracer IO DirectChainLog -> -- TODO(ELAINE): change type to indicate offline mode maybe? @@ -62,7 +65,6 @@ withOfflineChain :: 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 @@ -73,12 +75,12 @@ withOfflineChain tracer OfflineConfig{ledgerGenesisFile, initialUTxOFile} global -- 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 } <- + 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 @@ -103,13 +105,13 @@ withOfflineChain tracer OfflineConfig{ledgerGenesisFile, initialUTxOFile} global threadDelay $ nominalDelay sleepDelay callback $ Tick - { chainTime = timeToSleepUntil - , chainSlot = ChainSlot . fromIntegral @Word64 @Natural $ upcomingSlotWord64 - } + { 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..] + let tickForever = traverse_ nextTick [initialSlot ..] pure tickForever Nothing -> do let epochInfo@EpochInfo{} = epochInfoPure globals @@ -121,12 +123,12 @@ withOfflineChain tracer OfflineConfig{ledgerGenesisFile, initialUTxOFile} global threadDelay $ nominalDelay sleepDelay callback $ Tick - { chainTime = timeToSleepUntil - , chainSlot = ChainSlot . fromIntegral @Word64 @Natural $ unSlotNo upcomingSlot - } + { chainTime = timeToSleepUntil + , chainSlot = ChainSlot . fromIntegral @Word64 @Natural $ unSlotNo upcomingSlot + } + + tickForever = traverse_ nextTick [initialSlot ..] - tickForever = traverse_ nextTick [initialSlot..] - pure tickForever res <- @@ -136,4 +138,4 @@ withOfflineChain tracer OfflineConfig{ledgerGenesisFile, initialUTxOFile} global case res of Left () -> error "'connectTo' cannot terminate but did?" - Right a -> pure a \ No newline at end of file + Right a -> pure a diff --git a/hydra-node/src/Hydra/Chain/Offline/Handlers.hs b/hydra-node/src/Hydra/Chain/Offline/Handlers.hs index d21bd92cc23..0a963976a32 100644 --- a/hydra-node/src/Hydra/Chain/Offline/Handlers.hs +++ b/hydra-node/src/Hydra/Chain/Offline/Handlers.hs @@ -1,7 +1,8 @@ +{-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE TypeApplications #-} -{-# LANGUAGE DisambiguateRecordFields#-} + module Hydra.Chain.Offline.Handlers ( - mkFakeL1Chain + mkFakeL1Chain, ) where import Hydra.Prelude @@ -9,41 +10,55 @@ import Hydra.Chain.Direct.State (ChainStateAt(ChainStateAt), chainState) import Hydra.Chain.Direct.Handlers (DirectChainLog(ToPost, toPost), LocalChainState, getLatest) import Hydra.Chain (PostChainTx(headParameters, InitTx, AbortTx, CollectComTx, CloseTx, ContestTx, confirmedSnapshot, FanoutTx), ChainEvent (Observation, newChainState, observedTx), snapshotNumber, confirmedSnapshot, HeadParameters (HeadParameters), Chain (postTx, draftCommitTx, submitTx, Chain), contestationDeadline, OnChainTx (OnInitTx, headId, OnAbortTx, OnCollectComTx, OnCloseTx, parties, contestationPeriod, OnContestTx, OnFanoutTx), HeadParameters (HeadParameters), snapshotNumber, PostTxError (FailedToDraftTxNotInitializing)) import Hydra.Snapshot (getSnapshot, Snapshot (number)) -import Hydra.Logging (Tracer, traceWith) import Hydra.Ledger.Cardano (Tx) +import Hydra.Logging (Tracer, traceWith) import Hydra.HeadId(HeadId) mkFakeL1Chain :: - LocalChainState IO Tx - -> Tracer IO DirectChainLog - -> HeadId - -> (ChainEvent Tx -> IO ()) - -> Chain Tx IO + LocalChainState IO Tx -> + Tracer IO DirectChainLog -> + HeadId -> + (ChainEvent Tx -> IO ()) -> + Chain Tx IO mkFakeL1Chain localChainState tracer ownHeadId callback = - Chain { - submitTx = const $ pure (), - draftCommitTx = const . pure $ Left FailedToDraftTxNotInitializing, - postTx = \tx -> do - cst@ChainStateAt{chainState=_chainState} <- atomically (getLatest localChainState) - traceWith tracer $ ToPost{toPost = tx} - - let headId = ownHeadId - _ <- case tx of - InitTx{headParameters=HeadParameters contestationPeriod parties} -> - callback $ Observation { newChainState = cst, observedTx = OnInitTx {headId = headId, parties=parties, contestationPeriod}} - AbortTx{} -> - callback $ Observation { newChainState = cst, observedTx = OnAbortTx {}} - CollectComTx{} -> - callback $ Observation { newChainState = cst, observedTx = OnCollectComTx {}} - CloseTx{confirmedSnapshot} -> do - inOneMinute <- addUTCTime 60 <$> getCurrentTime - callback $ Observation { newChainState = cst, observedTx = - OnCloseTx {headId, snapshotNumber = number $ getSnapshot confirmedSnapshot, contestationDeadline=inOneMinute}} -- ELAINE TODO: probably we shouldnt allow the clietn to do contestation in offline mode ? - ContestTx{confirmedSnapshot} -> -- this shouldnt really happen, i dont think we should allow contesting in offline mode - callback $ Observation { newChainState = cst, observedTx = - OnContestTx{snapshotNumber = number $ getSnapshot confirmedSnapshot}} - FanoutTx{} -> - callback $ Observation { newChainState = cst, observedTx = - OnFanoutTx{}} - pure ()} \ No newline at end of file + Chain + { submitTx = const $ pure () + , draftCommitTx = const . pure $ Left FailedToDraftTxNotInitializing + , postTx = \tx -> do + cst@ChainStateAt{chainState = _chainState} <- atomically (getLatest localChainState) + traceWith tracer $ ToPost{toPost = tx} + + let headId = ownHeadId + _ <- case tx of + InitTx{headParameters = HeadParameters contestationPeriod parties} -> + callback $ Observation{newChainState = cst, observedTx = OnInitTx{headId = headId, parties = parties, contestationPeriod}} + AbortTx{} -> + callback $ Observation{newChainState = cst, observedTx = OnAbortTx{}} + CollectComTx{} -> + callback $ Observation{newChainState = cst, observedTx = OnCollectComTx{}} + CloseTx{confirmedSnapshot} -> do + inOneMinute <- addUTCTime 60 <$> getCurrentTime + callback $ + Observation + { newChainState = cst + , observedTx = + OnCloseTx{headId, snapshotNumber = number $ getSnapshot confirmedSnapshot, contestationDeadline = inOneMinute} -- ELAINE TODO: probably we shouldnt allow the clietn to do contestation in offline mode ? + } + ContestTx{confirmedSnapshot} -> + -- this shouldnt really happen, i dont think we should allow contesting in offline mode + callback $ + Observation + { newChainState = cst + , observedTx = + OnContestTx{snapshotNumber = number $ getSnapshot confirmedSnapshot} + } + FanoutTx{} -> + callback $ + Observation + { newChainState = cst + , observedTx = + OnFanoutTx{} + } + pure () + } diff --git a/hydra-node/src/Hydra/Chain/Offline/Persistence.hs b/hydra-node/src/Hydra/Chain/Offline/Persistence.hs index 819b917ed6d..c75d08f1dba 100644 --- a/hydra-node/src/Hydra/Chain/Offline/Persistence.hs +++ b/hydra-node/src/Hydra/Chain/Offline/Persistence.hs @@ -1,16 +1,25 @@ {-# LANGUAGE DisambiguateRecordFields #-} + module Hydra.Chain.Offline.Persistence ( - initializeStateIfOffline -, createPersistenceWithUTxOWriteBack -, createStateChangePersistence) where + initializeStateIfOffline, + createPersistenceWithUTxOWriteBack, + createStateChangePersistence, +) where import Hydra.Prelude -import Hydra.Chain ( - ChainStateHistory, ChainEvent (observedTx, Observation), newChainState, committed, party, initHistory, OnChainTx (OnInitTx, OnCommitTx, headId, contestationPeriod, parties), - ) import Hydra.Ledger (IsTx(UTxOType)) +import Data.Aeson qualified as Aeson import Hydra.Cardano.Api (Tx) +import Hydra.Chain ( + ChainEvent (Observation, observedTx), + ChainStateHistory, + OnChainTx (OnCommitTx, OnInitTx, contestationPeriod, headId, parties), + committed, + initHistory, + newChainState, + party, + ) import Hydra.Chain.Direct.State (initialChainState) import Hydra.HeadId (HeadId) import Hydra.Party (Party) @@ -20,33 +29,48 @@ import Hydra.Snapshot (Snapshot(Snapshot, utxo)) import UnliftIO.IO.File (writeBinaryFileDurableAtomic) import qualified Data.Aeson as Aeson import Hydra.ContestationPeriod (ContestationPeriod) +import Hydra.HeadLogic (StateChanged (SnapshotConfirmed, snapshot)) +import Hydra.Ledger (IsTx (UTxOType)) +import Hydra.Party (Party) +import Hydra.Persistence (PersistenceIncremental (PersistenceIncremental, append, loadAll), createPersistenceIncremental) +import Hydra.Snapshot (Snapshot (Snapshot, utxo)) +import UnliftIO.IO.File (writeBinaryFileDurableAtomic) -initializeStateIfOffline :: ChainStateHistory Tx - -> UTxOType Tx - -> HeadId - -> Party - -> ContestationPeriod - -> (ChainEvent Tx -> IO ()) - -> IO () +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 - , parties = [ownParty] - , contestationPeriod = contestationPeriod - } } + let emptyChainStateHistory = initHistory initialChainState - --NOTE(Elaine): should be no need to update the chain state, that's L1, there's nothing relevant there - -- observation events are to construct the L2 we want, with the initial utxo - callback $ Observation { newChainState = initialChainState, observedTx = - OnCommitTx - { party = ownParty - , committed = initialUTxO - } } + -- 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 + , parties = [ownParty] + , contestationPeriod = contestationPeriod + } + } + + -- NOTE(Elaine): should be no need to update the chain state, that's L1, there's nothing relevant there + -- observation events are to construct the L2 we want, with the initial utxo + callback $ + Observation + { newChainState = initialChainState + , observedTx = + OnCommitTx + { party = ownParty + , committed = initialUTxO + } + } createPersistenceWithUTxOWriteBack :: (MonadIO m, MonadThrow m) => @@ -57,15 +81,19 @@ createPersistenceWithUTxOWriteBack :: m (PersistenceIncremental (StateChanged Tx) m) createPersistenceWithUTxOWriteBack persistenceFilePath utxoFilePath = do PersistenceIncremental{append, loadAll} <- createPersistenceIncremental persistenceFilePath - pure PersistenceIncremental { loadAll, append = \stateChange -> do - append stateChange - case stateChange of - SnapshotConfirmed { snapshot = Snapshot{utxo} } -> - writeBinaryFileDurableAtomic utxoFilePath . toStrict $ Aeson.encode utxo - _ -> pure () - } + pure + PersistenceIncremental + { loadAll + , append = \stateChange -> do + append stateChange + case stateChange of + SnapshotConfirmed{snapshot = Snapshot{utxo}} -> + writeBinaryFileDurableAtomic utxoFilePath . toStrict $ Aeson.encode utxo + _ -> pure () + } -createStateChangePersistence :: (MonadIO m, MonadThrow m) => +createStateChangePersistence :: + (MonadIO m, MonadThrow m) => -- The filepath to write the main state change event persistence to FilePath -> -- The optional filepath to write UTxO to. UTxO is written after every confirmed snapshot. @@ -73,4 +101,4 @@ createStateChangePersistence :: (MonadIO m, MonadThrow m) => m (PersistenceIncremental (StateChanged Tx) m) createStateChangePersistence persistenceFilePath = \case Just utxoWriteBackFilePath -> createPersistenceWithUTxOWriteBack persistenceFilePath utxoWriteBackFilePath - _ -> createPersistenceIncremental persistenceFilePath \ No newline at end of file + _ -> createPersistenceIncremental persistenceFilePath diff --git a/hydra-node/src/Hydra/Node.hs b/hydra-node/src/Hydra/Node.hs index 7dbaa62e8cd..772c328523e 100644 --- a/hydra-node/src/Hydra/Node.hs +++ b/hydra-node/src/Hydra/Node.hs @@ -60,7 +60,7 @@ 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 (..), OfflineConfig, RunOptions (..)) +import Hydra.Options (ChainConfig (..), RunOptions (..)) import Hydra.Party (Party (..), deriveParty) import Hydra.Persistence (PersistenceIncremental (..), loadAll) diff --git a/hydra-node/src/Hydra/Options.hs b/hydra-node/src/Hydra/Options.hs index 7bad4b8b2bc..a65ce4854bc 100644 --- a/hydra-node/src/Hydra/Options.hs +++ b/hydra-node/src/Hydra/Options.hs @@ -1,6 +1,6 @@ -{-# OPTIONS_GHC -Wno-orphans #-} +{-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ApplicativeDo #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Hydra.Options ( module Hydra.Options, @@ -136,7 +136,7 @@ publishOptionsParser = <$> networkIdParser <*> nodeSocketParser <*> cardanoSigningKeyFileParser - + initialUTxOFileParser :: Parser FilePath initialUTxOFileParser = option @@ -152,7 +152,7 @@ ledgerGenesisFileParser :: Parser (Maybe FilePath) ledgerGenesisFileParser = option (optional str) - (long "ledger-genesis" + ( long "ledger-genesis" <> metavar "FILE" <> value Nothing <> showDefault @@ -163,11 +163,11 @@ data OfflineUTxOWriteBackConfig = WriteBackToInitialUTxO | WriteBackToUTxOFile F deriving (Eq, Show, Generic, FromJSON, ToJSON) data OfflineConfig = OfflineConfig - { - initialUTxOFile :: FilePath + { initialUTxOFile :: FilePath , ledgerGenesisFile :: Maybe FilePath , utxoWriteBack :: Maybe OfflineUTxOWriteBackConfig - } deriving (Eq, Show, Generic, FromJSON, ToJSON) + } + deriving (Eq, Show, Generic, FromJSON, ToJSON) offlineUTxOWriteBackOptionsParser :: Parser (Maybe OfflineUTxOWriteBackConfig) offlineUTxOWriteBackOptionsParser = @@ -180,20 +180,22 @@ offlineUTxOWriteBackOptionsParser = <> metavar "FILE" <> help "Write back to given UTxO file." ) - , flag' WriteBackToInitialUTxO + , flag' + WriteBackToInitialUTxO ( long "write-back-to-initial-utxo" <> help "Write back to initial UTxO file." ) - ] offlineOptionsParser :: Parser OfflineConfig offlineOptionsParser = - subparser . command "offline" $ - info (OfflineConfig - <$> initialUTxOFileParser - <*> ledgerGenesisFileParser - <*> offlineUTxOWriteBackOptionsParser) + subparser . command "offline" $ + info + ( OfflineConfig + <$> initialUTxOFileParser + <*> ledgerGenesisFileParser + <*> offlineUTxOWriteBackOptionsParser + ) (progDesc "Run Hydra in offline mode") offlineOptionsNormalizedUtxoWriteBackFilePath :: OfflineConfig -> Maybe FilePath @@ -203,7 +205,6 @@ offlineOptionsNormalizedUtxoWriteBackFilePath OfflineConfig{initialUTxOFile, utx Just (WriteBackToInitialUTxO) -> Just initialUTxOFile Nothing -> Nothing - data RunOptions = RunOptions { verbosity :: Verbosity , nodeId :: NodeId @@ -820,7 +821,7 @@ toArgs argsLedgerConfig = ["--ledger-protocol-parameters", cardanoLedgerProtocolParametersFile] - + CardanoLedgerConfig { cardanoLedgerProtocolParametersFile } = ledgerConfig @@ -836,15 +837,17 @@ toArgs argsOfflineConfig = case offlineConfig of Nothing -> [] - Just OfflineConfig{initialUTxOFile, ledgerGenesisFile, utxoWriteBack} -> + Just OfflineConfig{initialUTxOFile, ledgerGenesisFile, utxoWriteBack} -> ["offline"] <> ["--initial-utxo-file", initialUTxOFile] <> maybe [] (\s -> ["--ledger-genesis-file", s]) ledgerGenesisFile - <> maybe [] (\case + <> maybe + [] + ( \case WriteBackToInitialUTxO -> ["--write-back-to-initial-utxo"] WriteBackToUTxOFile s -> ["--write-back-to-utxo-file", s] - ) - utxoWriteBack + ) + utxoWriteBack defaultRunOptions :: RunOptions defaultRunOptions = From 67e8139ad30799c8c725eb14dfafda03f42d53df Mon Sep 17 00:00:00 2001 From: card Date: Thu, 16 Nov 2023 10:48:32 -0500 Subject: [PATCH 14/44] dump worwk for the night --- hydra-cluster/hydra-cluster.cabal | 2 + hydra-cluster/src/Hydra/Cluster/Faucet.hs | 2 + hydra-cluster/src/Hydra/Cluster/Util.hs | 26 ++++- hydra-cluster/test/Test/ChainSpec.hs | 69 +++++++++++ hydra-cluster/test/Test/DirectChainSpec.hs | 45 +------ hydra-cluster/test/Test/OfflineChainSpec.hs | 110 ++++++++++++++++++ hydra-node/exe/hydra-node/Main.hs | 5 - hydra-node/src/Hydra/Chain/Offline.hs | 2 +- .../src/Hydra/Chain/Offline/Handlers.hs | 13 ++- hydra-node/src/Hydra/Options.hs | 8 ++ 10 files changed, 229 insertions(+), 53 deletions(-) create mode 100644 hydra-cluster/test/Test/ChainSpec.hs create mode 100644 hydra-cluster/test/Test/OfflineChainSpec.hs diff --git a/hydra-cluster/hydra-cluster.cabal b/hydra-cluster/hydra-cluster.cabal index 1fbb2ad880e..eaa2723b89a 100644 --- a/hydra-cluster/hydra-cluster.cabal +++ b/hydra-cluster/hydra-cluster.cabal @@ -147,10 +147,12 @@ test-suite tests other-modules: Paths_hydra_cluster Spec + Test.ChainSpec Test.CardanoClientSpec Test.CardanoNodeSpec Test.ChainObserverSpec Test.DirectChainSpec + Test.OfflineChainSpec Test.EndToEndSpec Test.GeneratorSpec Test.Hydra.Cluster.CardanoCliSpec diff --git a/hydra-cluster/src/Hydra/Cluster/Faucet.hs b/hydra-cluster/src/Hydra/Cluster/Faucet.hs index 28bab418101..e12d7904c7a 100644 --- a/hydra-cluster/src/Hydra/Cluster/Faucet.hs +++ b/hydra-cluster/src/Hydra/Cluster/Faucet.hs @@ -98,6 +98,8 @@ seedFromFaucet_ :: seedFromFaucet_ node vk ll tracer = void $ seedFromFaucet node vk ll tracer +--TODO(Elaine): we probably want a simplified but parallel version of this/createOutputAddress for offline mode , that just constructs a UTxO +-- actually no take a look at seedFromFaucet -- | Return the remaining funds to the faucet returnFundsToFaucet :: Tracer IO FaucetLog -> diff --git a/hydra-cluster/src/Hydra/Cluster/Util.hs b/hydra-cluster/src/Hydra/Cluster/Util.hs index 8ce8c4ca67c..f1e172d8a11 100644 --- a/hydra-cluster/src/Hydra/Cluster/Util.hs +++ b/hydra-cluster/src/Hydra/Cluster/Util.hs @@ -1,3 +1,8 @@ +{-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE AllowAmbiguousTypes #-} + + -- | Utilities used across hydra-cluster module Hydra.Cluster.Util where @@ -22,8 +27,14 @@ import Hydra.Ledger.Cardano (genSigningKey) import Hydra.Options (ChainConfig (..), defaultChainConfig) import Paths_hydra_cluster qualified as Pkg import System.FilePath ((<.>), ()) -import Test.Hydra.Prelude (failure) +import Test.Hydra.Prelude (failure, Expectation, shouldBe) import Test.QuickCheck (generate) +import Hydra.Chain (PostChainTx) +import Hydra.Chain (ChainEvent) +import Hydra.Ledger (IsTx) +import Hydra.Party (Party) +import Hydra.Chain (OnChainTx(OnInitTx, contestationPeriod, parties)) +import Hydra.Ledger (IsTx(UTxOType)) -- | Lookup a config file similar reading a file from disk. -- If the env variable `HYDRA_CONFIG_DIR` is set, filenames will be @@ -73,10 +84,21 @@ chainConfigFor me targetDir nodeSocket them cp = do { nodeSocket , cardanoSigningKey = skTarget me , cardanoVerificationKeys = [vkTarget himOrHer | himOrHer <- them] - , contestationPeriod = cp + , contestationPeriod = cp :: ContestationPeriod } where skTarget x = targetDir skName x vkTarget x = targetDir vkName x skName x = actorName x <.> ".sk" vkName x = actorName x <.> ".vk" + +seedInitialUTxOFromOffline :: IsTx tx => UTxOType tx -> FilePath -> IO () +seedInitialUTxOFromOffline utxo targetDir = do + -- i assume a static file might be too rigid ? we can keep around constants and then write them to disk for each test + -- readConfigFile "initial-utxo.json" >>= writeFileBS (targetDir "initial-utxo.json") + + writeFileBS (targetDir "utxo.json") . toStrict . Aeson.encode $ utxo + + -- Aeson.throwDecodeStrict =<< readFileBS (targetDir "utxo.json") + pure () + diff --git a/hydra-cluster/test/Test/ChainSpec.hs b/hydra-cluster/test/Test/ChainSpec.hs new file mode 100644 index 00000000000..7bd6d2d92d1 --- /dev/null +++ b/hydra-cluster/test/Test/ChainSpec.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FunctionalDependencies #-} + +module Test.ChainSpec ( + ChainTest (postTx, waitCallback), + hasInitTxWith, + observesInTime, + observesInTimeSatisfying, +) where + +import Hydra.Chain (ChainEvent (Observation, observedTx), OnChainTx (OnInitTx, contestationPeriod, parties), PostChainTx) +import Hydra.ContestationPeriod (ContestationPeriod) +import Hydra.Ledger (IsTx) +import Hydra.Party (Party) +import Hydra.Prelude +import Test.Hydra.Prelude + +-- import Test.DirectChainSpec (DirectChainTest(DirectChainTest)) + +-- Abstract over DirectChainTest and OfflineChainTest +class ChainTest c tx m | c -> tx m where -- TODO(Elaine): additional constraints? alternative: manual vtable ChainTest, directchain wraps + postTx :: c -> PostChainTx tx -> m () + waitCallback :: c -> m (ChainEvent tx) + +-- offlineConfigFor :: HasCallStack => Actor -> FilePath -> ContestationPeriod -> IO OfflineConfig +-- offlineConfigFor me targetDir contestationPeriod = do +-- undefined + +-- NOTE(Elaine): is this ther ight place for this?? + +-- | Load key files for given 'Actor's (see keysFor) and directly convert them to 'OnChainId'. +loadParticipants :: [Actor] -> IO [OnChainId] +loadParticipants actors = + forM actors $ \a -> do + (vk, _) <- keysFor a + pure $ verificationKeyToOnChainId vk + +hasInitTxWith :: (HasCallStack, IsTx tx) => HeadParameters -> [OnChainId] -> OnChainTx tx -> IO (HeadId, HeadSeed) +hasInitTxWith HeadParameters{contestationPeriod = expectedContestationPeriod, parties = expectedParties} expectedParticipants = \case + OnInitTx{headId, headSeed, headParameters = HeadParameters{contestationPeriod, parties}, participants} -> do + expectedParticipants `shouldMatchList` participants + expectedContestationPeriod `shouldBe` contestationPeriod + expectedParties `shouldMatchList` parties + pure (headId, headSeed) + tx -> failure ("Unexpected observation: " <> show tx) + +observesInTime :: ChainTest c tx IO => IsTx tx => c -> OnChainTx tx -> IO () +observesInTime chain expected = + observesInTimeSatisfying chain (`shouldBe` expected) + +observesInTimeSatisfying :: ChainTest c tx IO => c -> (OnChainTx tx -> Expectation) -> IO () +observesInTimeSatisfying c check = + failAfter 10 go + where + go = do + e <- waitCallback c + case e of + Observation{observedTx} -> + check observedTx + _TickOrRollback -> + go + +waitMatch :: ChainTest c tx IO => c -> (ChainEvent tx -> Maybe b) -> IO b +waitMatch c match = go + where + go = do + a <- waitCallback c + maybe go pure (match a) diff --git a/hydra-cluster/test/Test/DirectChainSpec.hs b/hydra-cluster/test/Test/DirectChainSpec.hs index 4a2e60fe3ea..c8a5772bdec 100644 --- a/hydra-cluster/test/Test/DirectChainSpec.hs +++ b/hydra-cluster/test/Test/DirectChainSpec.hs @@ -80,6 +80,8 @@ import Hydra.Snapshot (ConfirmedSnapshot (..), Snapshot (..)) import System.Process (proc, readCreateProcess) import Test.QuickCheck (generate) +import Test.ChainSpec + spec :: Spec spec = around (showLogsOnFailure "DirectChainSpec") $ do it "can init and abort a head given nothing has been committed" $ \tracer -> do @@ -462,6 +464,10 @@ data DirectChainTest tx m = DirectChainTest , draftCommitTx :: UTxO' (TxOut CtxUTxO, Witness WitCtxTxIn) -> HeadId -> m tx } +instance ChainTest DirectChainTest Tx IO where + postTx = postTx + waitCallback = waitCallback + -- | Wrapper around 'withDirectChain' that threads a 'ChainStateType tx' through -- 'postTx' and 'waitCallback' calls. withDirectChainTest :: @@ -489,38 +495,6 @@ withDirectChainTest tracer config ctx action = do Right tx -> pure tx } -hasInitTxWith :: (HasCallStack, IsTx tx) => HeadParameters -> [OnChainId] -> OnChainTx tx -> IO (HeadId, HeadSeed) -hasInitTxWith HeadParameters{contestationPeriod = expectedContestationPeriod, parties = expectedParties} expectedParticipants = \case - OnInitTx{headId, headSeed, headParameters = HeadParameters{contestationPeriod, parties}, participants} -> do - expectedParticipants `shouldMatchList` participants - expectedContestationPeriod `shouldBe` contestationPeriod - expectedParties `shouldMatchList` parties - pure (headId, headSeed) - tx -> failure ("Unexpected observation: " <> show tx) - -observesInTime :: IsTx tx => DirectChainTest tx IO -> OnChainTx tx -> IO () -observesInTime chain expected = - observesInTimeSatisfying chain (`shouldBe` expected) - -observesInTimeSatisfying :: DirectChainTest tx IO -> (OnChainTx tx -> IO a) -> IO a -observesInTimeSatisfying DirectChainTest{waitCallback} check = - failAfter 10 go - where - go = do - e <- waitCallback - case e of - Observation{observedTx} -> - check observedTx - _TickOrRollback -> - go - -waitMatch :: DirectChainTest tx IO -> (ChainEvent tx -> Maybe b) -> IO b -waitMatch DirectChainTest{waitCallback} match = go - where - go = do - a <- waitCallback - maybe go pure (match a) - delayUntil :: (MonadDelay m, MonadTime m) => UTCTime -> m () delayUntil target = do now <- getCurrentTime @@ -542,10 +516,3 @@ externalCommit node hydraClient externalSk headId utxoToCommit' = do submitTx node signedTx where DirectChainTest{draftCommitTx} = hydraClient - --- | Load key files for given 'Actor's (see keysFor) and directly convert them to 'OnChainId'. -loadParticipants :: [Actor] -> IO [OnChainId] -loadParticipants actors = - forM actors $ \a -> do - (vk, _) <- keysFor a - pure $ verificationKeyToOnChainId vk diff --git a/hydra-cluster/test/Test/OfflineChainSpec.hs b/hydra-cluster/test/Test/OfflineChainSpec.hs new file mode 100644 index 00000000000..1a1b2b844d8 --- /dev/null +++ b/hydra-cluster/test/Test/OfflineChainSpec.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} + +module Test.OfflineChainSpec where +import Hydra.Prelude +import Test.Hydra.Prelude +import Hydra.Chain (PostChainTx, ChainEvent) +import Hydra.Logging (showLogsOnFailure, Tracer) +import Hydra.Chain.Offline (withOfflineChain) +import Hydra.Options (defaultContestationPeriod, OfflineConfig, initialUTxOFile) +import Hydra.Party (deriveParty) +import Hydra.Options (defaultOfflineConfig) +import Hydra.Chain (HeadParameters(HeadParameters, contestationPeriod, parties)) +import Hydra.Cluster.Util (keysFor, seedInitialUTxOFromOffline) +import Hydra.Cluster.Fixture (Actor(Alice), aliceSk) +import Hydra.Chain (initHistory) +import Hydra.Chain.Direct.State (initialChainState) +import Control.Concurrent.STM (newEmptyTMVarIO, putTMVar, takeTMVar) +import Hydra.Chain (Chain(Chain, postTx)) + +--TODO(Elaine): replace with some offlinechainlog? +import Hydra.Chain.Direct.Handlers (DirectChainLog) +import Hydra.Party (Party) +import Hydra.Ledger.Cardano (Tx) +import Hydra.Chain (OnChainTx(OnCommitTx, party, committed)) + +import Test.ChainSpec (hasInitTxWith, observesInTime) +import Hydra.Ledger (IsTx(UTxOType)) +import Hydra.Chain (ChainEvent(observedTx)) +import Hydra.Chain (PostChainTx(AbortTx)) +import Hydra.Chain (OnChainTx(OnAbortTx)) +import Hydra.HeadId(HeadId(HeadId)) +import Hydra.Ledger.Cardano.Configuration (readJsonFileThrow) + + +data OfflineChainTest tx m = OfflineChainTest + { postTx :: PostChainTx tx -> m () + , waitCallback :: m (ChainEvent tx) + } + +withOfflineChainTest :: Tracer IO DirectChainLog -> OfflineConfig + -> Party + -> (OfflineChainTest Tx IO -> IO b) + -> IO b +withOfflineChainTest tracer offlineConfig party action = do + eventMVar <- newEmptyTMVarIO + + let callback event = atomically $ putTMVar eventMVar event + globals = undefined + contestationPeriod = defaultContestationPeriod + withOfflineChain tracer offlineConfig globals (HeadId "HeadId") party contestationPeriod (initHistory initialChainState) callback $ \Chain{postTx} -> do + action + OfflineChainTest + { postTx + , waitCallback = atomically $ takeTMVar eventMVar + } + +spec :: Spec +spec = around showLogsOnFailure $ do + it "can init and abort an offline head given nothing has been externally comitted" $ \tracer -> do + withTempDir "hydra-cluster" $ \tmp -> do + (aliceCardanoVk, aliceCardanoSk) <- keysFor Alice + -- let aliceHydraKey = generateSigningKey . show $ (1::Integer) --based on EndToEnd.hs + let aliceParty = deriveParty aliceSk + --TODO(Elaine): i think we have to make this relative see readConfigFile + initialUTxO <- readJsonFileThrow (parseJSON @(UTxOType Tx)) $ initialUTxOFile defaultOfflineConfig + + seedInitialUTxOFromOffline initialUTxO tmp + + withOfflineChainTest tracer defaultOfflineConfig aliceParty $ \OfflineChainTest{postTx, waitCallback} -> do + -- postTx $ InitTx + -- { headParameters = HeadParameters + -- { contestationPeriod = defaultContestationPeriod + -- , parties = [aliceParty] + -- } + -- } + -- we should automatically have an init, commit, event play because withOfflineChain calls initializeStateIfOffline + -- but withDirectChain doesnt do this so it makes me wonder if we should revert the change + + + participants <- loadParticipants [Alice] + + event <- waitCallback -- because we've got a tmvar the stuff in withOfflineChain should block until we've read out the remaining events + hasInitTxWith defaultContestationPeriod [aliceParty] participants $ observedTx event + + event' <- waitCallback + -- event' `shouldBe` Observation { observedTx = OnCommitTx { party = aliceParty, committed = initialUTxO } } + observedTx event' `observesInTime` OnCommitTx { party = aliceParty, committed = initialUTxO } + + postTx $ AbortTx {-TODO(Elaine): what are the semantics of this again -} mempty + event'' <- waitCallback + -- need to make observesintime etc generic to get timeout on this + observedTx event'' `observesInTime` OnAbortTx + + + + + pure () + pure () + + pure () + +-- hasInitTxWith :: ContestationPeriod -> Party -> ChainEvent Tx -> Expectation +-- hasInitTxWith expectedContestationPeriod expectedParty = \case +-- OnInitTx {contestationPeriod, parties} -> pure () +-- _ -> expectationFailure $ "expected InitTx, got " <> show event diff --git a/hydra-node/exe/hydra-node/Main.hs b/hydra-node/exe/hydra-node/Main.hs index d05804d0abd..ee138d76571 100644 --- a/hydra-node/exe/hydra-node/Main.hs +++ b/hydra-node/exe/hydra-node/Main.hs @@ -8,7 +8,6 @@ import Hydra.Prelude hiding (fromList) import Hydra.Cardano.Api ( serialiseToRawBytesHex, - toLedgerPParams, ) import Hydra.Chain.Direct.ScriptRegistry (publishHydraScripts) @@ -20,10 +19,6 @@ import Hydra.Options ( PublishOptions (..), RunOptions (..), parseHydraCommand, - LedgerConfig (..), - OfflineConfig (..), - offlineOptionsNormalizedUtxoWriteBackFilePath, - validateRunOptions, ) import Hydra.Utils (genHydraKeys) diff --git a/hydra-node/src/Hydra/Chain/Offline.hs b/hydra-node/src/Hydra/Chain/Offline.hs index 0938778204d..afc185c93e5 100644 --- a/hydra-node/src/Hydra/Chain/Offline.hs +++ b/hydra-node/src/Hydra/Chain/Offline.hs @@ -69,7 +69,7 @@ withOfflineChain tracer OfflineConfig{ledgerGenesisFile, initialUTxOFile} global initializeStateIfOffline chainStateHistory initialUTxO ownHeadId party contestationPeriod callback localChainState <- newLocalChainState chainStateHistory - let chainHandle = mkFakeL1Chain localChainState tracer ownHeadId callback + 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 diff --git a/hydra-node/src/Hydra/Chain/Offline/Handlers.hs b/hydra-node/src/Hydra/Chain/Offline/Handlers.hs index 0a963976a32..231798883b7 100644 --- a/hydra-node/src/Hydra/Chain/Offline/Handlers.hs +++ b/hydra-node/src/Hydra/Chain/Offline/Handlers.hs @@ -12,16 +12,17 @@ import Hydra.Chain (PostChainTx(headParameters, InitTx, AbortTx, CollectComTx, C import Hydra.Snapshot (getSnapshot, Snapshot (number)) import Hydra.Ledger.Cardano (Tx) import Hydra.Logging (Tracer, traceWith) - import Hydra.HeadId(HeadId) +import Hydra.ContestationPeriod (ContestationPeriod, toNominalDiffTime) mkFakeL1Chain :: + ContestationPeriod -> LocalChainState IO Tx -> Tracer IO DirectChainLog -> HeadId -> (ChainEvent Tx -> IO ()) -> Chain Tx IO -mkFakeL1Chain localChainState tracer ownHeadId callback = +mkFakeL1Chain contestationPeriod localChainState tracer ownHeadId callback = Chain { submitTx = const $ pure () , draftCommitTx = const . pure $ Left FailedToDraftTxNotInitializing @@ -31,19 +32,19 @@ mkFakeL1Chain localChainState tracer ownHeadId callback = let headId = ownHeadId _ <- case tx of - InitTx{headParameters = HeadParameters contestationPeriod parties} -> - callback $ Observation{newChainState = cst, observedTx = OnInitTx{headId = headId, parties = parties, contestationPeriod}} + InitTx{headParameters = HeadParameters contestationPeriod' parties} -> + callback $ Observation{newChainState = cst, observedTx = OnInitTx{headId, parties, contestationPeriod = contestationPeriod'}} AbortTx{} -> callback $ Observation{newChainState = cst, observedTx = OnAbortTx{}} CollectComTx{} -> callback $ Observation{newChainState = cst, observedTx = OnCollectComTx{}} CloseTx{confirmedSnapshot} -> do - inOneMinute <- addUTCTime 60 <$> getCurrentTime + contestationDeadline <- addUTCTime (toNominalDiffTime contestationPeriod) <$> getCurrentTime callback $ Observation { newChainState = cst , observedTx = - OnCloseTx{headId, snapshotNumber = number $ getSnapshot confirmedSnapshot, contestationDeadline = inOneMinute} -- ELAINE TODO: probably we shouldnt allow the clietn to do contestation in offline mode ? + OnCloseTx{headId, snapshotNumber = number $ getSnapshot confirmedSnapshot, contestationDeadline} -- ELAINE TODO: probably we shouldnt allow the clietn to do contestation in offline mode ? } ContestTx{confirmedSnapshot} -> -- this shouldnt really happen, i dont think we should allow contesting in offline mode diff --git a/hydra-node/src/Hydra/Options.hs b/hydra-node/src/Hydra/Options.hs index a65ce4854bc..4402d81dd79 100644 --- a/hydra-node/src/Hydra/Options.hs +++ b/hydra-node/src/Hydra/Options.hs @@ -169,6 +169,14 @@ data OfflineConfig = OfflineConfig } deriving (Eq, Show, Generic, FromJSON, ToJSON) +defaultOfflineConfig :: OfflineConfig +defaultOfflineConfig = + OfflineConfig + { initialUTxOFile = "utxo.json" + , ledgerGenesisFile = Nothing + , utxoWriteBack = Nothing + } + offlineUTxOWriteBackOptionsParser :: Parser (Maybe OfflineUTxOWriteBackConfig) offlineUTxOWriteBackOptionsParser = optional $ From 842f2b9596908bd753c4e037d46a859981964399 Mon Sep 17 00:00:00 2001 From: card Date: Tue, 21 Nov 2023 10:24:19 -0500 Subject: [PATCH 15/44] temp commit --- hydra-cluster/src/HydraNode.hs | 95 +++++++++++++++- hydra-cluster/test/Test/ChainSpec.hs | 69 ++++-------- hydra-cluster/test/Test/DirectChainSpec.hs | 36 +++++- hydra-cluster/test/Test/EndToEndSpec.hs | 18 ++- hydra-cluster/test/Test/OfflineChainSpec.hs | 106 +++++------------- .../src/Hydra/Chain/Offline/Persistence.hs | 14 +-- hydra-node/src/Hydra/Node.hs | 14 --- hydra-node/src/Hydra/Node/Run.hs | 6 +- hydra-node/src/Hydra/Options.hs | 31 +---- 9 files changed, 200 insertions(+), 189 deletions(-) diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs index 891eecf2242..b8b4e56d065 100644 --- a/hydra-cluster/src/HydraNode.hs +++ b/hydra-cluster/src/HydraNode.hs @@ -40,6 +40,7 @@ import System.Process ( ) import Test.Hydra.Prelude (checkProcessHasNotDied, failAfter, failure, withLogFile) import Prelude qualified +import Hydra.Options (OfflineConfig) data HydraClient = HydraClient { hydraNodeId :: Int @@ -200,6 +201,20 @@ data HydraNodeLog deriving stock (Eq, Show, Generic) deriving anyclass (ToJSON, FromJSON, ToObject) +-- run a single hydra node in offline mode +-- withHydraClusterOffline :: +-- HasCallStack => +-- Tracer IO EndToEndLog -> +-- FilePath -> +-- -- (VerificationKey PaymentKey, SigningKey PaymentKey) -> +-- SigningKey HydraKey -> +-- ContestationPeriod -> +-- (HydraClient -> IO a) -> +-- IO a +-- withHydraClusterOffline tracer workDir hydraKey contestationPeriod action = +-- withConfiguredHydraCluster tracer workDir "" firstNodeId allKeys hydraKeys ("9fdc525c20bc00d9dfa9d14904b65e01910c0dfe3bb39865523c1e20eaeb0903") (const $ id) contestationPeriod action +-- NOTE(Elaine): txid constant taken from EndToEndSpec someTxId, lift the whole cyclic dependency thing + -- XXX: The two lists need to be of same length. Also the verification keys can -- be derived from the signing keys. withHydraCluster :: @@ -281,10 +296,84 @@ withConfiguredHydraCluster tracer workDir nodeSocket firstNodeId allKeys hydraKe hydraScriptsTxId (\c -> startNodes (c : clients) rest) +withOfflineHydraNode :: + Tracer IO EndToEndLog + -> OfflineConfig + -> FilePath + -> Int + -> SigningKey HydraKey + -> (HydraClient -> IO a) + -> IO a +withOfflineHydraNode tracer offlineConfig workDir hydraNodeId hydraSKey action = + withLogFile logFilePath $ \logFileHandle -> do + withOfflineHydraNode' tracer offlineConfig workDir hydraNodeId hydraSKey (Just logFileHandle) $ do + \_ _err 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' :: + Tracer IO EndToEndLog + -> OfflineConfig + -> FilePath + -> Int + -> SigningKey HydraKey + -- | If given use this as std out. + -> Maybe Handle + -- -> (HydraClient -> IO a) + -> (Handle -> Handle -> ProcessHandle -> IO a) + -> IO a +withOfflineHydraNode' tracer offlineConfig workDir hydraNodeId hydraSKey mGivenStdOut action = + withSystemTempDirectory "hydra-node" $ \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 = + ( hydraNodeProcess $ + RunOptions + { verbosity = Verbose "HydraNode" + , nodeId = NodeId $ show hydraNodeId + , host = "127.0.0.1" + , port = fromIntegral $ 5_000 + hydraNodeId + , peers + , apiHost = "127.0.0.1" + , apiPort = fromIntegral $ 4_000 + hydraNodeId + , monitoringPort = Just $ fromIntegral $ 6_000 + hydraNodeId + , hydraSigningKey + , hydraVerificationKeys = [] + , hydraScriptsTxId = "9fdc525c20bc00d9dfa9d14904b65e01910c0dfe3bb39865523c1e20eaeb0903" + , persistenceDir = workDir "state-" <> show hydraNodeId + , chainConfig = defaultChainConfig + , ledgerConfig + , offlineConfig = Just 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 + peers = [] + -- | Run a hydra-node with given 'ChainConfig' and using the config from -- config/. withHydraNode :: - Tracer IO HydraNodeLog -> + Tracer IO EndToEndLog -> ChainConfig -> FilePath -> Int -> @@ -306,9 +395,11 @@ withHydraNode tracer chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNod where logFilePath = workDir "logs" "hydra-node-" <> show hydraNodeId <.> "log" + -- | Run a hydra-node with given 'ChainConfig' and using the config from -- config/. withHydraNode' :: + -- Either OfflineConfig ChainConfig -> ChainConfig -> FilePath -> Int -> @@ -349,8 +440,10 @@ withHydraNode' chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds h , hydraVerificationKeys , hydraScriptsTxId , persistenceDir = workDir "state-" <> show hydraNodeId + -- , chainConfig = fromRight defaultChainConfig chainConfig , chainConfig , ledgerConfig + -- , offlineConfig = leftToMaybe chainConfig , offlineConfig = Nothing } ) diff --git a/hydra-cluster/test/Test/ChainSpec.hs b/hydra-cluster/test/Test/ChainSpec.hs index 7bd6d2d92d1..280be125b7d 100644 --- a/hydra-cluster/test/Test/ChainSpec.hs +++ b/hydra-cluster/test/Test/ChainSpec.hs @@ -3,67 +3,36 @@ {-# LANGUAGE FunctionalDependencies #-} module Test.ChainSpec ( - ChainTest (postTx, waitCallback), - hasInitTxWith, - observesInTime, - observesInTimeSatisfying, + -- ( ChainTest(postTx, waitCallback) + -- , hasInitTxWith + -- , observesInTime + -- , observesInTimeSatisfying + spec, ) where -import Hydra.Chain (ChainEvent (Observation, observedTx), OnChainTx (OnInitTx, contestationPeriod, parties), PostChainTx) -import Hydra.ContestationPeriod (ContestationPeriod) -import Hydra.Ledger (IsTx) -import Hydra.Party (Party) +import Test.Hydra.Prelude + +-- import Hydra.Chain (ChainEvent(Observation, observedTx)) +-- import Hydra.Chain (PostChainTx) +-- import Hydra.ContestationPeriod (ContestationPeriod) +-- import Hydra.Party (Party) +-- import Hydra.Chain (OnChainTx) +-- import Hydra.Ledger (IsTx) +-- import Hydra.Chain (OnChainTx(OnInitTx, contestationPeriod, parties)) import Hydra.Prelude import Test.Hydra.Prelude -- import Test.DirectChainSpec (DirectChainTest(DirectChainTest)) -- Abstract over DirectChainTest and OfflineChainTest -class ChainTest c tx m | c -> tx m where -- TODO(Elaine): additional constraints? alternative: manual vtable ChainTest, directchain wraps - postTx :: c -> PostChainTx tx -> m () - waitCallback :: c -> m (ChainEvent tx) +-- class DirectChainTest tx IO m | c -> tx m where --TODO(Elaine): additional constraints? alternative: manual vtable ChainTest, directchain wraps +-- postTx :: c -> PostChainTx tx -> m () +-- waitCallback :: c -> m (ChainEvent tx) -- offlineConfigFor :: HasCallStack => Actor -> FilePath -> ContestationPeriod -> IO OfflineConfig -- offlineConfigFor me targetDir contestationPeriod = do -- undefined -- NOTE(Elaine): is this ther ight place for this?? - --- | Load key files for given 'Actor's (see keysFor) and directly convert them to 'OnChainId'. -loadParticipants :: [Actor] -> IO [OnChainId] -loadParticipants actors = - forM actors $ \a -> do - (vk, _) <- keysFor a - pure $ verificationKeyToOnChainId vk - -hasInitTxWith :: (HasCallStack, IsTx tx) => HeadParameters -> [OnChainId] -> OnChainTx tx -> IO (HeadId, HeadSeed) -hasInitTxWith HeadParameters{contestationPeriod = expectedContestationPeriod, parties = expectedParties} expectedParticipants = \case - OnInitTx{headId, headSeed, headParameters = HeadParameters{contestationPeriod, parties}, participants} -> do - expectedParticipants `shouldMatchList` participants - expectedContestationPeriod `shouldBe` contestationPeriod - expectedParties `shouldMatchList` parties - pure (headId, headSeed) - tx -> failure ("Unexpected observation: " <> show tx) - -observesInTime :: ChainTest c tx IO => IsTx tx => c -> OnChainTx tx -> IO () -observesInTime chain expected = - observesInTimeSatisfying chain (`shouldBe` expected) - -observesInTimeSatisfying :: ChainTest c tx IO => c -> (OnChainTx tx -> Expectation) -> IO () -observesInTimeSatisfying c check = - failAfter 10 go - where - go = do - e <- waitCallback c - case e of - Observation{observedTx} -> - check observedTx - _TickOrRollback -> - go - -waitMatch :: ChainTest c tx IO => c -> (ChainEvent tx -> Maybe b) -> IO b -waitMatch c match = go - where - go = do - a <- waitCallback c - maybe go pure (match a) +spec :: Spec +spec = pure () diff --git a/hydra-cluster/test/Test/DirectChainSpec.hs b/hydra-cluster/test/Test/DirectChainSpec.hs index c8a5772bdec..226d56b2711 100644 --- a/hydra-cluster/test/Test/DirectChainSpec.hs +++ b/hydra-cluster/test/Test/DirectChainSpec.hs @@ -464,9 +464,9 @@ data DirectChainTest tx m = DirectChainTest , draftCommitTx :: UTxO' (TxOut CtxUTxO, Witness WitCtxTxIn) -> HeadId -> m tx } -instance ChainTest DirectChainTest Tx IO where - postTx = postTx - waitCallback = waitCallback +-- instance ChainTest DirectChainTest Tx IO where +-- postTx = (postTx :: PostChainTx Tx -> IO ()) +-- waitCallback = (waitCallback :: IO (ChainEvent Tx)) -- | Wrapper around 'withDirectChain' that threads a 'ChainStateType tx' through -- 'postTx' and 'waitCallback' calls. @@ -516,3 +516,33 @@ externalCommit node hydraClient externalSk headId utxoToCommit' = do submitTx node signedTx where DirectChainTest{draftCommitTx} = hydraClient + +hasInitTxWith :: (HasCallStack, IsTx tx) => ContestationPeriod -> [Party] -> OnChainTx tx -> Expectation +hasInitTxWith expectedContestationPeriod expectedParties = \case + OnInitTx{contestationPeriod, parties} -> do + expectedContestationPeriod `shouldBe` contestationPeriod + expectedParties `shouldBe` parties + tx -> failure ("Unexpected observation: " <> show tx) + +observesInTime :: IsTx tx => DirectChainTest tx IO -> OnChainTx tx -> IO () +observesInTime chain expected = + observesInTimeSatisfying chain (`shouldBe` expected) + +observesInTimeSatisfying :: IsTx tx => DirectChainTest tx IO -> (OnChainTx tx -> Expectation) -> IO () +observesInTimeSatisfying c check = + failAfter 10 go + where + go = do + e <- waitCallback c + case e of + Observation{observedTx} -> + check observedTx + _TickOrRollback -> + go + +waitMatch :: IsTx tx => DirectChainTest tx IO -> (ChainEvent tx -> Maybe b) -> IO b +waitMatch c match = go + where + go = do + a <- waitCallback c + maybe go pure (match a) diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs index 175fec9e6b8..6892311768f 100644 --- a/hydra-cluster/test/Test/EndToEndSpec.hs +++ b/hydra-cluster/test/Test/EndToEndSpec.hs @@ -90,6 +90,7 @@ import HydraNode ( waitForNodesConnected, waitMatch, withHydraCluster, + withOfflineHydraNode, withHydraNode, withHydraNode', ) @@ -112,7 +113,12 @@ withClusterTempDir name = withTempDir ("hydra-cluster-e2e-" <> name) spec :: Spec -spec = around (showLogsOnFailure "EndToEndSpec") $ +spec = around showLogsOnFailure $ do + it "End-to-end offline mode" $ \tracer -> do + withTempDir ("offline-mode-e2e") $ \tmpDir -> do + withOfflineHydraNode (tracer :: Tracer IO EndToEndLog) defaultOfflineConfig tmpDir 0 aliceSk $ \n1 -> do + pure () + describe "End-to-end on Cardano devnet" $ do describe "single party hydra head" $ do it "full head life-cycle" $ \tracer -> do @@ -556,6 +562,16 @@ timedTx tmpDir tracer node@RunningNode{networkId, nodeSocket} hydraScriptsTxId = v ^? key "snapshot" . key "confirmedTransactions" confirmedTransactions ^.. values `shouldBe` [toJSON $ txId tx] +-- initAndCloseOffline :: FilePath -> Tracer IO EndToEndLog -> IO () +-- initAndCloseOffline tmpDir tracer = do +-- aliceKeys@(aliceCardanoVk, _ ) +-- let cardanoKey = [aliceKeys] +-- hydraKeys = [aliceSk] + +-- let contestationPeriod = UnsafeContestationPeriod 2 + +-- pure () + initAndClose :: FilePath -> Tracer IO EndToEndLog -> Int -> TxId -> RunningNode -> IO () initAndClose tmpDir tracer clusterIx hydraScriptsTxId node@RunningNode{nodeSocket, networkId} = do aliceKeys@(aliceCardanoVk, _) <- generate genKeyPair diff --git a/hydra-cluster/test/Test/OfflineChainSpec.hs b/hydra-cluster/test/Test/OfflineChainSpec.hs index 1a1b2b844d8..9d188c5960e 100644 --- a/hydra-cluster/test/Test/OfflineChainSpec.hs +++ b/hydra-cluster/test/Test/OfflineChainSpec.hs @@ -1,110 +1,60 @@ {-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} module Test.OfflineChainSpec where -import Hydra.Prelude -import Test.Hydra.Prelude -import Hydra.Chain (PostChainTx, ChainEvent) -import Hydra.Logging (showLogsOnFailure, Tracer) + +import Control.Concurrent.STM (newEmptyTMVarIO, putTMVar, takeTMVar) +import Hydra.Chain (Chain (Chain, postTx), ChainEvent, HeadParameters (HeadParameters, contestationPeriod, parties), PostChainTx (InitTx, headParameters), initHistory) +import Hydra.Chain.Direct.State (initialChainState) import Hydra.Chain.Offline (withOfflineChain) -import Hydra.Options (defaultContestationPeriod, OfflineConfig, initialUTxOFile) -import Hydra.Party (deriveParty) -import Hydra.Options (defaultOfflineConfig) -import Hydra.Chain (HeadParameters(HeadParameters, contestationPeriod, parties)) +import Hydra.Cluster.Fixture (Actor (Alice), aliceSk) import Hydra.Cluster.Util (keysFor, seedInitialUTxOFromOffline) -import Hydra.Cluster.Fixture (Actor(Alice), aliceSk) -import Hydra.Chain (initHistory) -import Hydra.Chain.Direct.State (initialChainState) -import Control.Concurrent.STM (newEmptyTMVarIO, putTMVar, takeTMVar) -import Hydra.Chain (Chain(Chain, postTx)) +import Hydra.Logging (Tracer, showLogsOnFailure) +import Hydra.Options (OfflineConfig (OfflineConfig, initialUTxOFile, ledgerGenesisFile), OfflineUTxOWriteBackConfig (), defaultContestationPeriod, defaultOfflineConfig, initialUTxOFile) +import Hydra.Party (deriveParty) +import Hydra.Prelude +import Test.Hydra.Prelude + +-- TODO(Elaine): replace with some offlinechainlog? ---TODO(Elaine): replace with some offlinechainlog? +import Hydra.Chain (OnChainTx (OnCommitTx, committed, party)) import Hydra.Chain.Direct.Handlers (DirectChainLog) -import Hydra.Party (Party) import Hydra.Ledger.Cardano (Tx) -import Hydra.Chain (OnChainTx(OnCommitTx, party, committed)) +import Hydra.Party (Party) -import Test.ChainSpec (hasInitTxWith, observesInTime) -import Hydra.Ledger (IsTx(UTxOType)) -import Hydra.Chain (ChainEvent(observedTx)) -import Hydra.Chain (PostChainTx(AbortTx)) -import Hydra.Chain (OnChainTx(OnAbortTx)) -import Hydra.HeadId(HeadId(HeadId)) +import Hydra.Chain (ChainEvent (observedTx), OnChainTx (OnAbortTx), PostChainTx (AbortTx)) +import Hydra.HeadId (HeadId (HeadId)) +import Hydra.Ledger (IsTx (UTxOType)) import Hydra.Ledger.Cardano.Configuration (readJsonFileThrow) - +import Test.DirectChainSpec (hasInitTxWith, observesInTime) data OfflineChainTest tx m = OfflineChainTest { postTx :: PostChainTx tx -> m () , waitCallback :: m (ChainEvent tx) } -withOfflineChainTest :: Tracer IO DirectChainLog -> OfflineConfig - -> Party - -> (OfflineChainTest Tx IO -> IO b) - -> IO b +withOfflineChainTest :: + Tracer IO DirectChainLog -> + OfflineConfig -> + Party -> + (OfflineChainTest Tx IO -> IO b) -> + IO b withOfflineChainTest tracer offlineConfig party action = do eventMVar <- newEmptyTMVarIO let callback event = atomically $ putTMVar eventMVar event globals = undefined contestationPeriod = defaultContestationPeriod - withOfflineChain tracer offlineConfig globals (HeadId "HeadId") party contestationPeriod (initHistory initialChainState) callback $ \Chain{postTx} -> do + withOfflineChain tracer offlineConfig globals (HeadId "HeadId") party contestationPeriod (initHistory initialChainState) callback $ \Chain{postTx} -> do action OfflineChainTest - { postTx + { postTx , waitCallback = atomically $ takeTMVar eventMVar } spec :: Spec -spec = around showLogsOnFailure $ do - it "can init and abort an offline head given nothing has been externally comitted" $ \tracer -> do - withTempDir "hydra-cluster" $ \tmp -> do - (aliceCardanoVk, aliceCardanoSk) <- keysFor Alice - -- let aliceHydraKey = generateSigningKey . show $ (1::Integer) --based on EndToEnd.hs - let aliceParty = deriveParty aliceSk - --TODO(Elaine): i think we have to make this relative see readConfigFile - initialUTxO <- readJsonFileThrow (parseJSON @(UTxOType Tx)) $ initialUTxOFile defaultOfflineConfig - - seedInitialUTxOFromOffline initialUTxO tmp - - withOfflineChainTest tracer defaultOfflineConfig aliceParty $ \OfflineChainTest{postTx, waitCallback} -> do - -- postTx $ InitTx - -- { headParameters = HeadParameters - -- { contestationPeriod = defaultContestationPeriod - -- , parties = [aliceParty] - -- } - -- } - -- we should automatically have an init, commit, event play because withOfflineChain calls initializeStateIfOffline - -- but withDirectChain doesnt do this so it makes me wonder if we should revert the change - - - participants <- loadParticipants [Alice] - - event <- waitCallback -- because we've got a tmvar the stuff in withOfflineChain should block until we've read out the remaining events - hasInitTxWith defaultContestationPeriod [aliceParty] participants $ observedTx event - - event' <- waitCallback - -- event' `shouldBe` Observation { observedTx = OnCommitTx { party = aliceParty, committed = initialUTxO } } - observedTx event' `observesInTime` OnCommitTx { party = aliceParty, committed = initialUTxO } - - postTx $ AbortTx {-TODO(Elaine): what are the semantics of this again -} mempty - event'' <- waitCallback - -- need to make observesintime etc generic to get timeout on this - observedTx event'' `observesInTime` OnAbortTx - - - - - pure () - pure () - - pure () - --- hasInitTxWith :: ContestationPeriod -> Party -> ChainEvent Tx -> Expectation --- hasInitTxWith expectedContestationPeriod expectedParty = \case --- OnInitTx {contestationPeriod, parties} -> pure () --- _ -> expectationFailure $ "expected InitTx, got " <> show event +spec = pure () diff --git a/hydra-node/src/Hydra/Chain/Offline/Persistence.hs b/hydra-node/src/Hydra/Chain/Offline/Persistence.hs index c75d08f1dba..69d7186bb7e 100644 --- a/hydra-node/src/Hydra/Chain/Offline/Persistence.hs +++ b/hydra-node/src/Hydra/Chain/Offline/Persistence.hs @@ -3,7 +3,6 @@ module Hydra.Chain.Offline.Persistence ( initializeStateIfOffline, createPersistenceWithUTxOWriteBack, - createStateChangePersistence, ) where import Hydra.Prelude @@ -90,15 +89,4 @@ createPersistenceWithUTxOWriteBack persistenceFilePath utxoFilePath = do SnapshotConfirmed{snapshot = Snapshot{utxo}} -> writeBinaryFileDurableAtomic utxoFilePath . toStrict $ Aeson.encode utxo _ -> pure () - } - -createStateChangePersistence :: - (MonadIO m, MonadThrow m) => - -- The filepath to write the main state change event persistence to - FilePath -> - -- The optional filepath to write UTxO to. UTxO is written after every confirmed snapshot. - Maybe FilePath -> - m (PersistenceIncremental (StateChanged Tx) m) -createStateChangePersistence persistenceFilePath = \case - Just utxoWriteBackFilePath -> createPersistenceWithUTxOWriteBack persistenceFilePath utxoWriteBackFilePath - _ -> createPersistenceIncremental persistenceFilePath + } \ No newline at end of file diff --git a/hydra-node/src/Hydra/Node.hs b/hydra-node/src/Hydra/Node.hs index 772c328523e..4891aaafa67 100644 --- a/hydra-node/src/Hydra/Node.hs +++ b/hydra-node/src/Hydra/Node.hs @@ -308,20 +308,6 @@ loadGlobalsFromGenesis ledgerGenesisFile = do pure globals --- loadStateOffline :: --- (MonadThrow m, IsChainState tx) => --- Tracer m (HydraNodeLog tx) -> --- PersistenceIncremental (StateChanged tx) m -> --- ChainStateType tx -> --- HeadId -> --- UTxOType tx -> - --- m (HeadState tx, ChainStateHistory tx) --- loadStateOffline tracer persistence defaultChainState defaultHeadId defaultUtxo = do --- loadState tracer persistence defaultChainState - --- TODO(ELAINE): figure out a less strange way to do this - -- | Taken from Cardano.Api.GenesisParameters, a private module in cardano-api fromShelleyGenesis :: Shelley.ShelleyGenesis Ledger.StandardCrypto -> GenesisParameters ShelleyEra fromShelleyGenesis diff --git a/hydra-node/src/Hydra/Node/Run.hs b/hydra-node/src/Hydra/Node/Run.hs index 1eb897fa7c1..665e318ee1e 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -24,7 +24,6 @@ import Hydra.Chain.CardanoClient (QueryPoint (..), queryGenesisParameters) import Hydra.Chain.Direct (loadChainContext, mkTinyWallet, withDirectChain) import Hydra.Chain.Direct.State (initialChainState) import Hydra.Chain.Offline (withOfflineChain) -import Hydra.Chain.Offline.Persistence (createStateChangePersistence) import Hydra.HeadLogic ( Environment (..), Event (..), @@ -58,10 +57,9 @@ import Hydra.Options ( ChainConfig (..), InvalidOptions (..), LedgerConfig (..), - OfflineConfig (OfflineConfig, initialUTxOFile, ledgerGenesisFile, utxoWriteBack), + OfflineConfig (OfflineConfig, initialUTxOFile, ledgerGenesisFile), OfflineUTxOWriteBackConfig (..), RunOptions (..), - offlineOptionsNormalizedUtxoWriteBackFilePath, validateRunOptions, ) import Hydra.Persistence (createPersistenceIncremental) @@ -122,7 +120,7 @@ run opts = do loadGlobalsFromGenesis ledgerGenesisFile withCardanoLedger pparams globals $ \ledger -> do - persistence <- createStateChangePersistence (persistenceDir <> "/state") (offlineOptionsNormalizedUtxoWriteBackFilePath =<< leftToMaybe onlineOrOfflineConfig) + persistence <- createPersistenceIncremental $ persistenceDir <> "/state" (hs, chainStateHistory) <- loadState (contramap Node tracer) persistence initialChainState checkHeadState (contramap Node tracer) env hs diff --git a/hydra-node/src/Hydra/Options.hs b/hydra-node/src/Hydra/Options.hs index 4402d81dd79..d39d5a74f80 100644 --- a/hydra-node/src/Hydra/Options.hs +++ b/hydra-node/src/Hydra/Options.hs @@ -165,7 +165,6 @@ data OfflineUTxOWriteBackConfig = WriteBackToInitialUTxO | WriteBackToUTxOFile F data OfflineConfig = OfflineConfig { initialUTxOFile :: FilePath , ledgerGenesisFile :: Maybe FilePath - , utxoWriteBack :: Maybe OfflineUTxOWriteBackConfig } deriving (Eq, Show, Generic, FromJSON, ToJSON) @@ -174,7 +173,6 @@ defaultOfflineConfig = OfflineConfig { initialUTxOFile = "utxo.json" , ledgerGenesisFile = Nothing - , utxoWriteBack = Nothing } offlineUTxOWriteBackOptionsParser :: Parser (Maybe OfflineUTxOWriteBackConfig) @@ -202,17 +200,9 @@ offlineOptionsParser = ( OfflineConfig <$> initialUTxOFileParser <*> ledgerGenesisFileParser - <*> offlineUTxOWriteBackOptionsParser ) (progDesc "Run Hydra in offline mode") -offlineOptionsNormalizedUtxoWriteBackFilePath :: OfflineConfig -> Maybe FilePath -offlineOptionsNormalizedUtxoWriteBackFilePath OfflineConfig{initialUTxOFile, utxoWriteBack} = - case utxoWriteBack of - Just (WriteBackToUTxOFile path) -> Just path - Just (WriteBackToInitialUTxO) -> Just initialUTxOFile - Nothing -> Nothing - data RunOptions = RunOptions { verbosity :: Verbosity , nodeId :: NodeId @@ -281,19 +271,13 @@ instance Arbitrary OfflineConfig where arbitrary = do ledgerGenesisFile <- oneof [pure Nothing, Just <$> genFilePath "ledgerGenesis"] initialUTxOFile <- genFilePath "utxo.json" - utxoWriteBack <- arbitrary -- writeFileBS initialUTxOFile "{}" pure $ OfflineConfig { initialUTxOFile , ledgerGenesisFile - , utxoWriteBack } - shrink = genericShrink - -instance Arbitrary OfflineUTxOWriteBackConfig where - arbitrary = pure $ WriteBackToInitialUTxO --FIXME(Elaine): this wont be used so theres no need to fix during rebase shrink = genericShrink @@ -375,7 +359,11 @@ cardanoLedgerProtocolParametersParser = \See manual how to configure this." ) -data ChainConfig = DirectChainConfig +data ChainConfig' = OfflineChainConfig' OfflineConfig | DirectChainConfig' ChainConfig + deriving stock (Eq, Show, Generic) + deriving anyclass (ToJSON, FromJSON) + +data ChainConfig = DirectChainConfig -- rename type constructor to directchainconfig { networkId :: NetworkId -- ^ Network identifer to which we expect to connect. , nodeSocket :: SocketPath @@ -845,17 +833,10 @@ toArgs argsOfflineConfig = case offlineConfig of Nothing -> [] - Just OfflineConfig{initialUTxOFile, ledgerGenesisFile, utxoWriteBack} -> + Just OfflineConfig{initialUTxOFile, ledgerGenesisFile} -> ["offline"] <> ["--initial-utxo-file", initialUTxOFile] <> maybe [] (\s -> ["--ledger-genesis-file", s]) ledgerGenesisFile - <> maybe - [] - ( \case - WriteBackToInitialUTxO -> ["--write-back-to-initial-utxo"] - WriteBackToUTxOFile s -> ["--write-back-to-utxo-file", s] - ) - utxoWriteBack defaultRunOptions :: RunOptions defaultRunOptions = From 6414da2a29c0d7b60c6fdfd49854aab351e11730 Mon Sep 17 00:00:00 2001 From: card Date: Wed, 29 Nov 2023 13:56:29 -0500 Subject: [PATCH 16/44] bugfixes, end to end offline mode tests --- hydra-cluster/hydra-cluster.cabal | 2 - hydra-cluster/src/Hydra/Cluster/Faucet.hs | 3 +- hydra-cluster/src/Hydra/Cluster/Util.hs | 121 ++++++++++++++---- hydra-cluster/src/HydraNode.hs | 83 ++++++------ hydra-cluster/test/Test/ChainSpec.hs | 38 ------ hydra-cluster/test/Test/DirectChainSpec.hs | 9 +- hydra-cluster/test/Test/EndToEndSpec.hs | 43 +++++-- hydra-cluster/test/Test/OfflineChainSpec.hs | 60 --------- .../src/Hydra/Chain/Offline/Handlers.hs | 14 +- .../src/Hydra/Chain/Offline/Persistence.hs | 13 +- hydra-node/src/Hydra/Node/Run.hs | 16 +-- hydra-node/src/Hydra/Options.hs | 11 +- 12 files changed, 186 insertions(+), 227 deletions(-) delete mode 100644 hydra-cluster/test/Test/ChainSpec.hs delete mode 100644 hydra-cluster/test/Test/OfflineChainSpec.hs diff --git a/hydra-cluster/hydra-cluster.cabal b/hydra-cluster/hydra-cluster.cabal index eaa2723b89a..1fbb2ad880e 100644 --- a/hydra-cluster/hydra-cluster.cabal +++ b/hydra-cluster/hydra-cluster.cabal @@ -147,12 +147,10 @@ test-suite tests other-modules: Paths_hydra_cluster Spec - Test.ChainSpec Test.CardanoClientSpec Test.CardanoNodeSpec Test.ChainObserverSpec Test.DirectChainSpec - Test.OfflineChainSpec Test.EndToEndSpec Test.GeneratorSpec Test.Hydra.Cluster.CardanoCliSpec diff --git a/hydra-cluster/src/Hydra/Cluster/Faucet.hs b/hydra-cluster/src/Hydra/Cluster/Faucet.hs index e12d7904c7a..e65808adbce 100644 --- a/hydra-cluster/src/Hydra/Cluster/Faucet.hs +++ b/hydra-cluster/src/Hydra/Cluster/Faucet.hs @@ -98,8 +98,9 @@ seedFromFaucet_ :: seedFromFaucet_ node vk ll tracer = void $ seedFromFaucet node vk ll tracer ---TODO(Elaine): we probably want a simplified but parallel version of this/createOutputAddress for offline mode , that just constructs a UTxO +-- TODO(Elaine): we probably want a simplified but parallel version of this/createOutputAddress for offline mode , that just constructs a UTxO -- actually no take a look at seedFromFaucet + -- | Return the remaining funds to the faucet returnFundsToFaucet :: Tracer IO FaucetLog -> diff --git a/hydra-cluster/src/Hydra/Cluster/Util.hs b/hydra-cluster/src/Hydra/Cluster/Util.hs index f1e172d8a11..03720557d3b 100644 --- a/hydra-cluster/src/Hydra/Cluster/Util.hs +++ b/hydra-cluster/src/Hydra/Cluster/Util.hs @@ -1,40 +1,68 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE AllowAmbiguousTypes #-} - +{-# LANGUAGE ScopedTypeVariables #-} -- | Utilities used across hydra-cluster -module Hydra.Cluster.Util where +module Hydra.Cluster.Util ( + readConfigFile, + keysFor, + createAndSaveSigningKey, + offlineConfigFor, + offlineConfigForUTxO, + chainConfigFor, + initialUtxoWithFunds, + buildAddress, +) where 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), + IsCardanoEra, + IsShelleyBasedEra, + Key (VerificationKey, getVerificationKey, verificationKeyHash), + Lovelace, + NetworkId, PaymentKey, - SigningKey, + ShelleyAddr, + SigningKey (GenesisUTxOSigningKey, PaymentSigningKey), SocketPath, + StakeAddressReference (NoStakeAddress), TextEnvelopeError (TextEnvelopeAesonDecodeError), + Tx, + TxOutValue (TxOutValue), + UTxO' (UTxO), + VerificationKey (GenesisUTxOVerificationKey, PaymentVerificationKey), + castSigningKey, + castVerificationKey, deserialiseFromTextEnvelope, + genesisUTxOPseudoTxIn, + lovelaceToTxOutValue, + mkTxOutValue, + shelleyAddressInEra, textEnvelopeToJSON, ) +import Hydra.Cardano.Api.MultiAssetSupportedInEra (HasMultiAsset) +import Hydra.Cardano.Api.Prelude (PaymentCredential (PaymentCredentialByKey), ReferenceScript (ReferenceScriptNone), TxOut (TxOut), TxOutDatum (TxOutDatumNone), Value, lovelaceToTxOutValue, makeShelleyAddress, shelleyAddressInEra) +import Hydra.Chain (ChainEvent, OnChainTx (OnInitTx, contestationPeriod, parties), PostChainTx) 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 Hydra.Party (Party) import Paths_hydra_cluster qualified as Pkg import System.FilePath ((<.>), ()) -import Test.Hydra.Prelude (failure, Expectation, shouldBe) +import Test.Hydra.Prelude (Expectation, failure, shouldBe) import Test.QuickCheck (generate) -import Hydra.Chain (PostChainTx) -import Hydra.Chain (ChainEvent) -import Hydra.Ledger (IsTx) -import Hydra.Party (Party) -import Hydra.Chain (OnChainTx(OnInitTx, contestationPeriod, parties)) -import Hydra.Ledger (IsTx(UTxOType)) + +-- import CardanoClient (buildAddress) -- | Lookup a config file similar reading a file from disk. -- If the env variable `HYDRA_CONFIG_DIR` is set, filenames will be @@ -70,6 +98,62 @@ 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 + + -- Aeson.throwDecodeStrict =<< readFileBS (targetDir "utxo.json") + pure destinationPath + +buildAddress :: VerificationKey PaymentKey -> NetworkId -> Address ShelleyAddr +buildAddress vKey networkId = + makeShelleyAddress networkId (PaymentCredentialByKey $ verificationKeyHash vKey) NoStakeAddress + +initialUtxoWithFunds :: + forall era ctx. + (IsShelleyBasedEra era, HasMultiAsset 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 + (shelleyAddressInEra @era $ buildAddress vKey networkId) + (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 when (me `elem` them) $ @@ -91,14 +175,3 @@ chainConfigFor me targetDir nodeSocket them cp = do vkTarget x = targetDir vkName x skName x = actorName x <.> ".sk" vkName x = actorName x <.> ".vk" - -seedInitialUTxOFromOffline :: IsTx tx => UTxOType tx -> FilePath -> IO () -seedInitialUTxOFromOffline utxo targetDir = do - -- i assume a static file might be too rigid ? we can keep around constants and then write them to disk for each test - -- readConfigFile "initial-utxo.json" >>= writeFileBS (targetDir "initial-utxo.json") - - writeFileBS (targetDir "utxo.json") . toStrict . Aeson.encode $ utxo - - -- Aeson.throwDecodeStrict =<< readFileBS (targetDir "utxo.json") - pure () - diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs index b8b4e56d065..1d297183173 100644 --- a/hydra-cluster/src/HydraNode.hs +++ b/hydra-cluster/src/HydraNode.hs @@ -25,10 +25,11 @@ 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, RunOptions (..), defaultChainConfig, toArgs) 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) +import System.Directory (createDirectoryIfMissing) import System.FilePath ((<.>), ()) import System.IO.Temp (withSystemTempDirectory) import System.Process ( @@ -40,7 +41,6 @@ import System.Process ( ) import Test.Hydra.Prelude (checkProcessHasNotDied, failAfter, failure, withLogFile) import Prelude qualified -import Hydra.Options (OfflineConfig) data HydraClient = HydraClient { hydraNodeId :: Int @@ -201,20 +201,6 @@ data HydraNodeLog deriving stock (Eq, Show, Generic) deriving anyclass (ToJSON, FromJSON, ToObject) --- run a single hydra node in offline mode --- withHydraClusterOffline :: --- HasCallStack => --- Tracer IO EndToEndLog -> --- FilePath -> --- -- (VerificationKey PaymentKey, SigningKey PaymentKey) -> --- SigningKey HydraKey -> --- ContestationPeriod -> --- (HydraClient -> IO a) -> --- IO a --- withHydraClusterOffline tracer workDir hydraKey contestationPeriod action = --- withConfiguredHydraCluster tracer workDir "" firstNodeId allKeys hydraKeys ("9fdc525c20bc00d9dfa9d14904b65e01910c0dfe3bb39865523c1e20eaeb0903") (const $ id) contestationPeriod action --- NOTE(Elaine): txid constant taken from EndToEndSpec someTxId, lift the whole cyclic dependency thing - -- XXX: The two lists need to be of same length. Also the verification keys can -- be derived from the signing keys. withHydraCluster :: @@ -296,18 +282,18 @@ withConfiguredHydraCluster tracer workDir nodeSocket firstNodeId allKeys hydraKe hydraScriptsTxId (\c -> startNodes (c : clients) rest) -withOfflineHydraNode :: - Tracer IO EndToEndLog - -> OfflineConfig - -> FilePath - -> Int - -> SigningKey HydraKey - -> (HydraClient -> IO a) - -> IO a +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' tracer offlineConfig workDir hydraNodeId hydraSKey (Just logFileHandle) $ do - \_ _err processHandle -> do + withOfflineHydraNode' offlineConfig workDir hydraNodeId hydraSKey (Just logFileHandle) $ do + \_stdoutHandle _stderrHandle processHandle -> do result <- race (checkProcessHasNotDied ("hydra-node (" <> show hydraNodeId <> ")") processHandle) @@ -318,19 +304,24 @@ withOfflineHydraNode tracer offlineConfig workDir hydraNodeId hydraSKey action = where logFilePath = workDir "logs" "hydra-node-" <> show hydraNodeId <.> "log" +withPersistentDirectoryDebug :: MonadIO m => FilePath -> (FilePath -> m a) -> m a +withPersistentDirectoryDebug name action = do + liftIO $ createDirectoryIfMissing True name + putStrLn $ "Persistent Directory Created: " <> name + action name + withOfflineHydraNode' :: - Tracer IO EndToEndLog - -> OfflineConfig - -> FilePath - -> Int - -> SigningKey HydraKey + OfflineConfig -> + FilePath -> + Int -> + SigningKey HydraKey -> -- | If given use this as std out. - -> Maybe Handle + Maybe Handle -> -- -> (HydraClient -> IO a) - -> (Handle -> Handle -> ProcessHandle -> IO a) - -> IO a -withOfflineHydraNode' tracer offlineConfig workDir hydraNodeId hydraSKey mGivenStdOut action = - withSystemTempDirectory "hydra-node" $ \dir -> do + (Handle -> Handle -> ProcessHandle -> IO a) -> + IO a +withOfflineHydraNode' offlineConfig workDir hydraNodeId hydraSKey mGivenStdOut action = + withPersistentDirectoryDebug "hydra-node-tempdir" $ \dir -> do let cardanoLedgerProtocolParametersFile = dir "protocol-parameters.json" readConfigFile "protocol-parameters.json" >>= writeFileBS cardanoLedgerProtocolParametersFile let hydraSigningKey = dir (show hydraNodeId <> ".sk") @@ -340,12 +331,14 @@ withOfflineHydraNode' tracer offlineConfig workDir hydraNodeId hydraSKey mGivenS { cardanoLedgerProtocolParametersFile } let p = + -- ( hydraNodeProcess . (\args -> trace ("ARGS DUMP: " <> foldMap (" "<>) (toArgs args)) args) $ ( hydraNodeProcess $ RunOptions { verbosity = Verbose "HydraNode" , nodeId = NodeId $ show hydraNodeId , host = "127.0.0.1" - , port = fromIntegral $ 5_000 + hydraNodeId + , -- NOTE(Elaine): port 5000 is used on recent versions of macos + port = fromIntegral $ 5_100 + hydraNodeId , peers , apiHost = "127.0.0.1" , apiPort = fromIntegral $ 4_000 + hydraNodeId @@ -373,7 +366,7 @@ withOfflineHydraNode' tracer offlineConfig workDir hydraNodeId hydraSKey mGivenS -- | Run a hydra-node with given 'ChainConfig' and using the config from -- config/. withHydraNode :: - Tracer IO EndToEndLog -> + Tracer IO HydraNodeLog -> ChainConfig -> FilePath -> Int -> @@ -395,11 +388,9 @@ withHydraNode tracer chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNod where logFilePath = workDir "logs" "hydra-node-" <> show hydraNodeId <.> "log" - -- | Run a hydra-node with given 'ChainConfig' and using the config from -- config/. withHydraNode' :: - -- Either OfflineConfig ChainConfig -> ChainConfig -> FilePath -> Int -> @@ -431,7 +422,7 @@ withHydraNode' chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds h { verbosity = Verbose "HydraNode" , nodeId = NodeId $ show hydraNodeId , host = "127.0.0.1" - , port = fromIntegral $ 5_000 + hydraNodeId + , port = fromIntegral $ 5_100 + hydraNodeId , peers , apiHost = "127.0.0.1" , apiPort = fromIntegral $ 4_000 + hydraNodeId @@ -440,11 +431,11 @@ withHydraNode' chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds h , hydraVerificationKeys , hydraScriptsTxId , persistenceDir = workDir "state-" <> show hydraNodeId - -- , chainConfig = fromRight defaultChainConfig chainConfig - , chainConfig + , -- , chainConfig = fromRight defaultChainConfig chainConfig + chainConfig , ledgerConfig - -- , offlineConfig = leftToMaybe chainConfig - , offlineConfig = Nothing + , -- , offlineConfig = leftToMaybe chainConfig + offlineConfig = Nothing } ) { std_out = maybe CreatePipe UseHandle mGivenStdOut @@ -459,7 +450,7 @@ withHydraNode' chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds h peers = [ Host { Network.hostname = "127.0.0.1" - , Network.port = fromIntegral $ 5_000 + i + , Network.port = fromIntegral $ 5_100 + i } | i <- allNodeIds , i /= hydraNodeId diff --git a/hydra-cluster/test/Test/ChainSpec.hs b/hydra-cluster/test/Test/ChainSpec.hs deleted file mode 100644 index 280be125b7d..00000000000 --- a/hydra-cluster/test/Test/ChainSpec.hs +++ /dev/null @@ -1,38 +0,0 @@ -{-# LANGUAGE DisambiguateRecordFields #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE FunctionalDependencies #-} - -module Test.ChainSpec ( - -- ( ChainTest(postTx, waitCallback) - -- , hasInitTxWith - -- , observesInTime - -- , observesInTimeSatisfying - spec, -) where - -import Test.Hydra.Prelude - --- import Hydra.Chain (ChainEvent(Observation, observedTx)) --- import Hydra.Chain (PostChainTx) --- import Hydra.ContestationPeriod (ContestationPeriod) --- import Hydra.Party (Party) --- import Hydra.Chain (OnChainTx) --- import Hydra.Ledger (IsTx) --- import Hydra.Chain (OnChainTx(OnInitTx, contestationPeriod, parties)) -import Hydra.Prelude -import Test.Hydra.Prelude - --- import Test.DirectChainSpec (DirectChainTest(DirectChainTest)) - --- Abstract over DirectChainTest and OfflineChainTest --- class DirectChainTest tx IO m | c -> tx m where --TODO(Elaine): additional constraints? alternative: manual vtable ChainTest, directchain wraps --- postTx :: c -> PostChainTx tx -> m () --- waitCallback :: c -> m (ChainEvent tx) - --- offlineConfigFor :: HasCallStack => Actor -> FilePath -> ContestationPeriod -> IO OfflineConfig --- offlineConfigFor me targetDir contestationPeriod = do --- undefined - --- NOTE(Elaine): is this ther ight place for this?? -spec :: Spec -spec = pure () diff --git a/hydra-cluster/test/Test/DirectChainSpec.hs b/hydra-cluster/test/Test/DirectChainSpec.hs index 226d56b2711..38893f647c8 100644 --- a/hydra-cluster/test/Test/DirectChainSpec.hs +++ b/hydra-cluster/test/Test/DirectChainSpec.hs @@ -80,8 +80,6 @@ import Hydra.Snapshot (ConfirmedSnapshot (..), Snapshot (..)) import System.Process (proc, readCreateProcess) import Test.QuickCheck (generate) -import Test.ChainSpec - spec :: Spec spec = around (showLogsOnFailure "DirectChainSpec") $ do it "can init and abort a head given nothing has been committed" $ \tracer -> do @@ -517,18 +515,19 @@ externalCommit node hydraClient externalSk headId utxoToCommit' = do where DirectChainTest{draftCommitTx} = hydraClient -hasInitTxWith :: (HasCallStack, IsTx tx) => ContestationPeriod -> [Party] -> OnChainTx tx -> Expectation +hasInitTxWith :: (HasCallStack, IsTx tx) => ContestationPeriod -> [Party] -> OnChainTx tx -> IO HeadId hasInitTxWith expectedContestationPeriod expectedParties = \case - OnInitTx{contestationPeriod, parties} -> do + OnInitTx{headId, contestationPeriod, parties} -> do expectedContestationPeriod `shouldBe` contestationPeriod expectedParties `shouldBe` parties + pure headId tx -> failure ("Unexpected observation: " <> show tx) observesInTime :: IsTx tx => DirectChainTest tx IO -> OnChainTx tx -> IO () observesInTime chain expected = observesInTimeSatisfying chain (`shouldBe` expected) -observesInTimeSatisfying :: IsTx tx => DirectChainTest tx IO -> (OnChainTx tx -> Expectation) -> IO () +observesInTimeSatisfying :: IsTx tx => DirectChainTest tx IO -> (OnChainTx tx -> IO a) -> IO a observesInTimeSatisfying c check = failAfter 10 go where diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs index 6892311768f..950ca62c8b6 100644 --- a/hydra-cluster/test/Test/EndToEndSpec.hs +++ b/hydra-cluster/test/Test/EndToEndSpec.hs @@ -8,6 +8,7 @@ import Hydra.Prelude import Test.Hydra.Prelude import Cardano.Api.UTxO qualified as UTxO + import CardanoClient (QueryPoint (..), queryGenesisParameters, queryTip, queryTipSlotNo, submitTx, waitForUTxO) import CardanoNode (RunningNode (..), withCardanoNodeDevnet) import Control.Concurrent.STM (newTVarIO, readTVarIO) @@ -34,6 +35,7 @@ import Hydra.Cardano.Api ( mkVkAddress, serialiseAddress, signTx, + pattern TxOut, pattern TxValidityLowerBound, ) import Hydra.Chain.Direct.State () @@ -70,7 +72,7 @@ import Hydra.Cluster.Scenarios ( testPreventResumeReconfiguredPeer, threeNodesNoErrorsOnOpen, ) -import Hydra.Cluster.Util (chainConfigFor, keysFor) +import Hydra.Cluster.Util (chainConfigFor, keysFor, offlineConfigFor) import Hydra.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod)) import Hydra.Crypto (generateSigningKey) import Hydra.Ledger (txId) @@ -90,9 +92,9 @@ import HydraNode ( waitForNodesConnected, waitMatch, withHydraCluster, - withOfflineHydraNode, withHydraNode, withHydraNode', + withOfflineHydraNode, ) import System.Directory (removeDirectoryRecursive) import System.FilePath (()) @@ -113,10 +115,33 @@ withClusterTempDir name = withTempDir ("hydra-cluster-e2e-" <> name) spec :: Spec -spec = around showLogsOnFailure $ do +spec = around (showLogsOnFailure "EndToEndSpec") $ do it "End-to-end offline mode" $ \tracer -> do withTempDir ("offline-mode-e2e") $ \tmpDir -> do - withOfflineHydraNode (tracer :: Tracer IO EndToEndLog) defaultOfflineConfig tmpDir 0 aliceSk $ \n1 -> do + let networkId = Testnet (NetworkMagic 42) -- from defaultChainConfig + let startingState = + [ (Alice, lovelaceToValue 100_000_000) + , (Bob, lovelaceToValue 100_000_000) + ] + (aliceCardanoVk, aliceCardanoSk) <- keysFor Alice + (bobCardanoVk, _) <- keysFor Bob + offlineConfig <- offlineConfigFor startingState tmpDir networkId + + initialUtxo <- Aeson.throwDecodeStrict @UTxO.UTxO =<< readFileBS (initialUTxOFile offlineConfig) + 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" + pure () describe "End-to-end on Cardano devnet" $ do @@ -562,16 +587,6 @@ timedTx tmpDir tracer node@RunningNode{networkId, nodeSocket} hydraScriptsTxId = v ^? key "snapshot" . key "confirmedTransactions" confirmedTransactions ^.. values `shouldBe` [toJSON $ txId tx] --- initAndCloseOffline :: FilePath -> Tracer IO EndToEndLog -> IO () --- initAndCloseOffline tmpDir tracer = do --- aliceKeys@(aliceCardanoVk, _ ) --- let cardanoKey = [aliceKeys] --- hydraKeys = [aliceSk] - --- let contestationPeriod = UnsafeContestationPeriod 2 - --- pure () - initAndClose :: FilePath -> Tracer IO EndToEndLog -> Int -> TxId -> RunningNode -> IO () initAndClose tmpDir tracer clusterIx hydraScriptsTxId node@RunningNode{nodeSocket, networkId} = do aliceKeys@(aliceCardanoVk, _) <- generate genKeyPair diff --git a/hydra-cluster/test/Test/OfflineChainSpec.hs b/hydra-cluster/test/Test/OfflineChainSpec.hs deleted file mode 100644 index 9d188c5960e..00000000000 --- a/hydra-cluster/test/Test/OfflineChainSpec.hs +++ /dev/null @@ -1,60 +0,0 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DisambiguateRecordFields #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} - -module Test.OfflineChainSpec where - -import Control.Concurrent.STM (newEmptyTMVarIO, putTMVar, takeTMVar) -import Hydra.Chain (Chain (Chain, postTx), ChainEvent, HeadParameters (HeadParameters, contestationPeriod, parties), PostChainTx (InitTx, headParameters), initHistory) -import Hydra.Chain.Direct.State (initialChainState) -import Hydra.Chain.Offline (withOfflineChain) -import Hydra.Cluster.Fixture (Actor (Alice), aliceSk) -import Hydra.Cluster.Util (keysFor, seedInitialUTxOFromOffline) -import Hydra.Logging (Tracer, showLogsOnFailure) -import Hydra.Options (OfflineConfig (OfflineConfig, initialUTxOFile, ledgerGenesisFile), OfflineUTxOWriteBackConfig (), defaultContestationPeriod, defaultOfflineConfig, initialUTxOFile) -import Hydra.Party (deriveParty) -import Hydra.Prelude -import Test.Hydra.Prelude - --- TODO(Elaine): replace with some offlinechainlog? - -import Hydra.Chain (OnChainTx (OnCommitTx, committed, party)) -import Hydra.Chain.Direct.Handlers (DirectChainLog) -import Hydra.Ledger.Cardano (Tx) -import Hydra.Party (Party) - -import Hydra.Chain (ChainEvent (observedTx), OnChainTx (OnAbortTx), PostChainTx (AbortTx)) -import Hydra.HeadId (HeadId (HeadId)) -import Hydra.Ledger (IsTx (UTxOType)) -import Hydra.Ledger.Cardano.Configuration (readJsonFileThrow) -import Test.DirectChainSpec (hasInitTxWith, observesInTime) - -data OfflineChainTest tx m = OfflineChainTest - { postTx :: PostChainTx tx -> m () - , waitCallback :: m (ChainEvent tx) - } - -withOfflineChainTest :: - Tracer IO DirectChainLog -> - OfflineConfig -> - Party -> - (OfflineChainTest Tx IO -> IO b) -> - IO b -withOfflineChainTest tracer offlineConfig party action = do - eventMVar <- newEmptyTMVarIO - - let callback event = atomically $ putTMVar eventMVar event - globals = undefined - contestationPeriod = defaultContestationPeriod - withOfflineChain tracer offlineConfig globals (HeadId "HeadId") party contestationPeriod (initHistory initialChainState) callback $ \Chain{postTx} -> do - action - OfflineChainTest - { postTx - , waitCallback = atomically $ takeTMVar eventMVar - } - -spec :: Spec -spec = pure () diff --git a/hydra-node/src/Hydra/Chain/Offline/Handlers.hs b/hydra-node/src/Hydra/Chain/Offline/Handlers.hs index 231798883b7..1a3834ed1b4 100644 --- a/hydra-node/src/Hydra/Chain/Offline/Handlers.hs +++ b/hydra-node/src/Hydra/Chain/Offline/Handlers.hs @@ -5,15 +5,15 @@ module Hydra.Chain.Offline.Handlers ( mkFakeL1Chain, ) where -import Hydra.Prelude -import Hydra.Chain.Direct.State (ChainStateAt(ChainStateAt), chainState) -import Hydra.Chain.Direct.Handlers (DirectChainLog(ToPost, toPost), LocalChainState, getLatest) -import Hydra.Chain (PostChainTx(headParameters, InitTx, AbortTx, CollectComTx, CloseTx, ContestTx, confirmedSnapshot, FanoutTx), ChainEvent (Observation, newChainState, observedTx), snapshotNumber, confirmedSnapshot, HeadParameters (HeadParameters), Chain (postTx, draftCommitTx, submitTx, Chain), contestationDeadline, OnChainTx (OnInitTx, headId, OnAbortTx, OnCollectComTx, OnCloseTx, parties, contestationPeriod, OnContestTx, OnFanoutTx), HeadParameters (HeadParameters), snapshotNumber, PostTxError (FailedToDraftTxNotInitializing)) -import Hydra.Snapshot (getSnapshot, Snapshot (number)) +import Hydra.Chain (Chain (Chain, draftCommitTx, postTx, submitTx), ChainEvent (Observation, newChainState, observedTx), HeadParameters (HeadParameters), OnChainTx (OnAbortTx, OnCloseTx, OnCollectComTx, OnContestTx, OnFanoutTx, OnInitTx, contestationPeriod, headId, parties), PostChainTx (AbortTx, CloseTx, CollectComTx, ContestTx, FanoutTx, InitTx, confirmedSnapshot, headParameters), PostTxError (FailedToDraftTxNotInitializing), confirmedSnapshot, contestationDeadline, snapshotNumber) +import Hydra.Chain.Direct.Handlers (DirectChainLog (ToPost, toPost), LocalChainState, getLatest) +import Hydra.Chain.Direct.State (ChainStateAt (ChainStateAt), chainState) +import Hydra.ContestationPeriod (ContestationPeriod, toNominalDiffTime) +import Hydra.HeadId (HeadId) import Hydra.Ledger.Cardano (Tx) import Hydra.Logging (Tracer, traceWith) -import Hydra.HeadId(HeadId) -import Hydra.ContestationPeriod (ContestationPeriod, toNominalDiffTime) +import Hydra.Prelude +import Hydra.Snapshot (Snapshot (number), getSnapshot) mkFakeL1Chain :: ContestationPeriod -> diff --git a/hydra-node/src/Hydra/Chain/Offline/Persistence.hs b/hydra-node/src/Hydra/Chain/Offline/Persistence.hs index 69d7186bb7e..38378229203 100644 --- a/hydra-node/src/Hydra/Chain/Offline/Persistence.hs +++ b/hydra-node/src/Hydra/Chain/Offline/Persistence.hs @@ -7,7 +7,6 @@ module Hydra.Chain.Offline.Persistence ( import Hydra.Prelude -import Hydra.Ledger (IsTx(UTxOType)) import Data.Aeson qualified as Aeson import Hydra.Cardano.Api (Tx) import Hydra.Chain ( @@ -20,14 +19,8 @@ import Hydra.Chain ( party, ) import Hydra.Chain.Direct.State (initialChainState) -import Hydra.HeadId (HeadId) -import Hydra.Party (Party) -import Hydra.Persistence (PersistenceIncremental(PersistenceIncremental, append, loadAll), createPersistenceIncremental) -import Hydra.HeadLogic (StateChanged(SnapshotConfirmed, snapshot)) -import Hydra.Snapshot (Snapshot(Snapshot, utxo)) -import UnliftIO.IO.File (writeBinaryFileDurableAtomic) -import qualified Data.Aeson as Aeson import Hydra.ContestationPeriod (ContestationPeriod) +import Hydra.HeadId (HeadId) import Hydra.HeadLogic (StateChanged (SnapshotConfirmed, snapshot)) import Hydra.Ledger (IsTx (UTxOType)) import Hydra.Party (Party) @@ -47,7 +40,7 @@ initializeStateIfOffline chainStateHistory initialUTxO ownHeadId ownParty contes let emptyChainStateHistory = initHistory initialChainState -- if we don't have a chainStateHistory to restore from disk from, start a new one - when (chainStateHistory /= emptyChainStateHistory) $ do + when (chainStateHistory == emptyChainStateHistory) $ do callback $ Observation { newChainState = initialChainState @@ -89,4 +82,4 @@ createPersistenceWithUTxOWriteBack persistenceFilePath utxoFilePath = do SnapshotConfirmed{snapshot = Snapshot{utxo}} -> writeBinaryFileDurableAtomic utxoFilePath . toStrict $ Aeson.encode utxo _ -> pure () - } \ No newline at end of file + } diff --git a/hydra-node/src/Hydra/Node/Run.hs b/hydra-node/src/Hydra/Node/Run.hs index 665e318ee1e..ab4394ee203 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-} module Hydra.Node.Run where @@ -13,9 +14,6 @@ import Hydra.Cardano.Api ( GenesisParameters (..), ProtocolParametersConversionError, ShelleyBasedEra (..), - StandardCrypto, - SystemStart (SystemStart), - Tx, toLedgerPParams, ) import Hydra.Cardano.Api qualified as Shelley @@ -57,8 +55,7 @@ import Hydra.Options ( ChainConfig (..), InvalidOptions (..), LedgerConfig (..), - OfflineConfig (OfflineConfig, initialUTxOFile, ledgerGenesisFile), - OfflineUTxOWriteBackConfig (..), + OfflineConfig (OfflineConfig, ledgerGenesisFile), RunOptions (..), validateRunOptions, ) @@ -66,15 +63,6 @@ import Hydra.Persistence (createPersistenceIncremental) import Hydra.HeadId (HeadId (..)) -import Data.Aeson qualified as Aeson -import Hydra.Chain.Direct.Fixture (defaultGlobals) -import Hydra.ContestationPeriod (fromChain) -import Hydra.Data.ContestationPeriod (contestationPeriodFromDiffTime) -import Hydra.Ledger (IsTx (UTxOType)) -import Hydra.Persistence (PersistenceIncremental (PersistenceIncremental, append, loadAll)) -import Hydra.Snapshot (Snapshot (Snapshot), utxo) -import UnliftIO.IO.File (writeBinaryFileDurableAtomic) - data ConfigurationException = ConfigurationException ProtocolParametersConversionError | InvalidOptionException InvalidOptions diff --git a/hydra-node/src/Hydra/Options.hs b/hydra-node/src/Hydra/Options.hs index d39d5a74f80..6fca2559ab0 100644 --- a/hydra-node/src/Hydra/Options.hs +++ b/hydra-node/src/Hydra/Options.hs @@ -266,18 +266,17 @@ instance Arbitrary RunOptions where shrink = genericShrink ---FIXME(Elaine): this instance doesn't do stuff correctly but was necessary during rebasing +-- FIXME(Elaine): this instance doesn't do stuff correctly but was necessary during rebasing instance Arbitrary OfflineConfig where arbitrary = do ledgerGenesisFile <- oneof [pure Nothing, Just <$> genFilePath "ledgerGenesis"] initialUTxOFile <- genFilePath "utxo.json" - -- writeFileBS initialUTxOFile "{}" pure $ - OfflineConfig { - initialUTxOFile - , ledgerGenesisFile - } + OfflineConfig + { initialUTxOFile + , ledgerGenesisFile + } shrink = genericShrink From e322bb984ec51c045a9877e85462b8249380b281 Mon Sep 17 00:00:00 2001 From: card Date: Wed, 6 Dec 2023 19:52:38 -0500 Subject: [PATCH 17/44] remove re-checked-in golden test failures, add to gitignore since they shouldn't be added generally --- .gitignore | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.gitignore b/.gitignore index 669207c43ea..a4ccac5fafa 100644 --- a/.gitignore +++ b/.gitignore @@ -24,6 +24,8 @@ result* *.o test-results.xml hspec-results.md +hydra-node/golden/RunOptions.faulty.json +hydra-node/golden/RunOptions.faulty.reencoded.json # Benchmark results *.html From 681202a1deefc7abce9ca7f54a4ab6742dc6eefb Mon Sep 17 00:00:00 2001 From: card Date: Tue, 12 Dec 2023 10:52:46 -0500 Subject: [PATCH 18/44] commit only test fixes --- hydra-cluster/src/Hydra/Cluster/Util.hs | 14 +++----------- hydra-cluster/src/HydraNode.hs | 8 +------- hydra-cluster/test/Test/DirectChainSpec.hs | 4 ++-- hydra-node/golden/RunOptions.json | 5 +++++ hydra-node/src/Hydra/Options.hs | 4 ++-- 5 files changed, 13 insertions(+), 22 deletions(-) diff --git a/hydra-cluster/src/Hydra/Cluster/Util.hs b/hydra-cluster/src/Hydra/Cluster/Util.hs index 03720557d3b..1d3e4df92a8 100644 --- a/hydra-cluster/src/Hydra/Cluster/Util.hs +++ b/hydra-cluster/src/Hydra/Cluster/Util.hs @@ -24,42 +24,34 @@ import Hydra.Cardano.Api ( Address, AsType (AsPaymentKey, AsSigningKey), HasTypeProxy (AsType), - IsCardanoEra, IsShelleyBasedEra, Key (VerificationKey, getVerificationKey, verificationKeyHash), - Lovelace, NetworkId, PaymentKey, ShelleyAddr, - SigningKey (GenesisUTxOSigningKey, PaymentSigningKey), + SigningKey, SocketPath, StakeAddressReference (NoStakeAddress), TextEnvelopeError (TextEnvelopeAesonDecodeError), Tx, - TxOutValue (TxOutValue), UTxO' (UTxO), VerificationKey (GenesisUTxOVerificationKey, PaymentVerificationKey), - castSigningKey, - castVerificationKey, deserialiseFromTextEnvelope, genesisUTxOPseudoTxIn, - lovelaceToTxOutValue, mkTxOutValue, shelleyAddressInEra, textEnvelopeToJSON, ) import Hydra.Cardano.Api.MultiAssetSupportedInEra (HasMultiAsset) -import Hydra.Cardano.Api.Prelude (PaymentCredential (PaymentCredentialByKey), ReferenceScript (ReferenceScriptNone), TxOut (TxOut), TxOutDatum (TxOutDatumNone), Value, lovelaceToTxOutValue, makeShelleyAddress, shelleyAddressInEra) -import Hydra.Chain (ChainEvent, OnChainTx (OnInitTx, contestationPeriod, parties), PostChainTx) +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 (..), OfflineConfig (OfflineConfig, initialUTxOFile, ledgerGenesisFile), defaultChainConfig) -import Hydra.Party (Party) import Paths_hydra_cluster qualified as Pkg import System.FilePath ((<.>), ()) -import Test.Hydra.Prelude (Expectation, failure, shouldBe) +import Test.Hydra.Prelude (failure) import Test.QuickCheck (generate) -- import CardanoClient (buildAddress) diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs index 1d297183173..61e86d20aee 100644 --- a/hydra-cluster/src/HydraNode.hs +++ b/hydra-cluster/src/HydraNode.hs @@ -29,7 +29,6 @@ import Hydra.Options (ChainConfig (..), LedgerConfig (..), OfflineConfig, RunOpt 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) -import System.Directory (createDirectoryIfMissing) import System.FilePath ((<.>), ()) import System.IO.Temp (withSystemTempDirectory) import System.Process ( @@ -304,11 +303,6 @@ withOfflineHydraNode tracer offlineConfig workDir hydraNodeId hydraSKey action = where logFilePath = workDir "logs" "hydra-node-" <> show hydraNodeId <.> "log" -withPersistentDirectoryDebug :: MonadIO m => FilePath -> (FilePath -> m a) -> m a -withPersistentDirectoryDebug name action = do - liftIO $ createDirectoryIfMissing True name - putStrLn $ "Persistent Directory Created: " <> name - action name withOfflineHydraNode' :: OfflineConfig -> @@ -321,7 +315,7 @@ withOfflineHydraNode' :: (Handle -> Handle -> ProcessHandle -> IO a) -> IO a withOfflineHydraNode' offlineConfig workDir hydraNodeId hydraSKey mGivenStdOut action = - withPersistentDirectoryDebug "hydra-node-tempdir" $ \dir -> do + withSystemTempDirectory "hydra-node" $ \dir -> do let cardanoLedgerProtocolParametersFile = dir "protocol-parameters.json" readConfigFile "protocol-parameters.json" >>= writeFileBS cardanoLedgerProtocolParametersFile let hydraSigningKey = dir (show hydraNodeId <> ".sk") diff --git a/hydra-cluster/test/Test/DirectChainSpec.hs b/hydra-cluster/test/Test/DirectChainSpec.hs index 38893f647c8..b8e1decb0e3 100644 --- a/hydra-cluster/test/Test/DirectChainSpec.hs +++ b/hydra-cluster/test/Test/DirectChainSpec.hs @@ -527,7 +527,7 @@ observesInTime :: IsTx tx => DirectChainTest tx IO -> OnChainTx tx -> IO () observesInTime chain expected = observesInTimeSatisfying chain (`shouldBe` expected) -observesInTimeSatisfying :: IsTx tx => DirectChainTest tx IO -> (OnChainTx tx -> IO a) -> IO a +observesInTimeSatisfying :: DirectChainTest tx IO -> (OnChainTx tx -> IO a) -> IO a observesInTimeSatisfying c check = failAfter 10 go where @@ -539,7 +539,7 @@ observesInTimeSatisfying c check = _TickOrRollback -> go -waitMatch :: IsTx tx => DirectChainTest tx IO -> (ChainEvent tx -> Maybe b) -> IO b +waitMatch :: DirectChainTest tx IO -> (ChainEvent tx -> Maybe b) -> IO b waitMatch c match = go where go = do 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/src/Hydra/Options.hs b/hydra-node/src/Hydra/Options.hs index 6fca2559ab0..2bafd24e7db 100644 --- a/hydra-node/src/Hydra/Options.hs +++ b/hydra-node/src/Hydra/Options.hs @@ -834,8 +834,8 @@ toArgs Nothing -> [] Just OfflineConfig{initialUTxOFile, ledgerGenesisFile} -> ["offline"] - <> ["--initial-utxo-file", initialUTxOFile] - <> maybe [] (\s -> ["--ledger-genesis-file", s]) ledgerGenesisFile + <> ["--initial-utxo", initialUTxOFile] + <> maybe [] (\s -> ["--ledger-genesis", s]) ledgerGenesisFile defaultRunOptions :: RunOptions defaultRunOptions = From 5adfe592f394bf6da46498cd664b618d7c309ded Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Wed, 13 Dec 2023 17:19:01 +0100 Subject: [PATCH 19/44] Fix compilation, several warnings remain Only fixes compilation somewhat as the warnings need to be addressed for making it work properly. --- hydra-cluster/src/Hydra/Cluster/Util.hs | 8 +++---- .../src/Hydra/Chain/Offline/Handlers.hs | 22 ++++++++++++++----- .../src/Hydra/Chain/Offline/Persistence.hs | 6 ++--- hydra-node/src/Hydra/Node/Run.hs | 5 ++--- 4 files changed, 25 insertions(+), 16 deletions(-) diff --git a/hydra-cluster/src/Hydra/Cluster/Util.hs b/hydra-cluster/src/Hydra/Cluster/Util.hs index 1d3e4df92a8..c82eb9f623f 100644 --- a/hydra-cluster/src/Hydra/Cluster/Util.hs +++ b/hydra-cluster/src/Hydra/Cluster/Util.hs @@ -24,6 +24,7 @@ import Hydra.Cardano.Api ( Address, AsType (AsPaymentKey, AsSigningKey), HasTypeProxy (AsType), + IsMaryEraOnwards, IsShelleyBasedEra, Key (VerificationKey, getVerificationKey, verificationKeyHash), NetworkId, @@ -39,10 +40,9 @@ import Hydra.Cardano.Api ( deserialiseFromTextEnvelope, genesisUTxOPseudoTxIn, mkTxOutValue, - shelleyAddressInEra, + mkVkAddress, textEnvelopeToJSON, ) -import Hydra.Cardano.Api.MultiAssetSupportedInEra (HasMultiAsset) 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) @@ -117,7 +117,7 @@ buildAddress vKey networkId = initialUtxoWithFunds :: forall era ctx. - (IsShelleyBasedEra era, HasMultiAsset era) => + (IsShelleyBasedEra era, IsMaryEraOnwards era) => NetworkId -> [(VerificationKey PaymentKey, Value)] -> IO (UTxO' (TxOut ctx era)) @@ -130,7 +130,7 @@ initialUtxoWithFunds networkId valueMap = where txout vKey val = TxOut - (shelleyAddressInEra @era $ buildAddress vKey networkId) + (mkVkAddress networkId vKey) (mkTxOutValue val) TxOutDatumNone ReferenceScriptNone diff --git a/hydra-node/src/Hydra/Chain/Offline/Handlers.hs b/hydra-node/src/Hydra/Chain/Offline/Handlers.hs index 1a3834ed1b4..03b653bf33b 100644 --- a/hydra-node/src/Hydra/Chain/Offline/Handlers.hs +++ b/hydra-node/src/Hydra/Chain/Offline/Handlers.hs @@ -5,9 +5,19 @@ module Hydra.Chain.Offline.Handlers ( mkFakeL1Chain, ) where -import Hydra.Chain (Chain (Chain, draftCommitTx, postTx, submitTx), ChainEvent (Observation, newChainState, observedTx), HeadParameters (HeadParameters), OnChainTx (OnAbortTx, OnCloseTx, OnCollectComTx, OnContestTx, OnFanoutTx, OnInitTx, contestationPeriod, headId, parties), PostChainTx (AbortTx, CloseTx, CollectComTx, ContestTx, FanoutTx, InitTx, confirmedSnapshot, headParameters), PostTxError (FailedToDraftTxNotInitializing), confirmedSnapshot, contestationDeadline, snapshotNumber) +import Hydra.Chain ( + Chain (Chain, draftCommitTx, postTx, submitTx), + ChainEvent (Observation, newChainState, observedTx), + HeadParameters (HeadParameters), + OnChainTx (..), + PostChainTx (..), + PostTxError (FailedToDraftTxNotInitializing), + confirmedSnapshot, + contestationDeadline, + snapshotNumber, + ) import Hydra.Chain.Direct.Handlers (DirectChainLog (ToPost, toPost), LocalChainState, getLatest) -import Hydra.Chain.Direct.State (ChainStateAt (ChainStateAt), chainState) +import Hydra.Chain.Direct.State (ChainStateAt (ChainStateAt)) import Hydra.ContestationPeriod (ContestationPeriod, toNominalDiffTime) import Hydra.HeadId (HeadId) import Hydra.Ledger.Cardano (Tx) @@ -25,15 +35,15 @@ mkFakeL1Chain :: mkFakeL1Chain contestationPeriod localChainState tracer ownHeadId callback = Chain { submitTx = const $ pure () - , draftCommitTx = const . pure $ Left FailedToDraftTxNotInitializing + , draftCommitTx = \_ _ -> pure $ Left FailedToDraftTxNotInitializing , postTx = \tx -> do - cst@ChainStateAt{chainState = _chainState} <- atomically (getLatest localChainState) + cst@ChainStateAt{} <- atomically (getLatest localChainState) traceWith tracer $ ToPost{toPost = tx} let headId = ownHeadId _ <- case tx of - InitTx{headParameters = HeadParameters contestationPeriod' parties} -> - callback $ Observation{newChainState = cst, observedTx = OnInitTx{headId, parties, contestationPeriod = contestationPeriod'}} + InitTx{headParameters} -> + callback $ Observation{newChainState = cst, observedTx = OnInitTx{headId, headParameters}} AbortTx{} -> callback $ Observation{newChainState = cst, observedTx = OnAbortTx{}} CollectComTx{} -> diff --git a/hydra-node/src/Hydra/Chain/Offline/Persistence.hs b/hydra-node/src/Hydra/Chain/Offline/Persistence.hs index 38378229203..e8d707f04f7 100644 --- a/hydra-node/src/Hydra/Chain/Offline/Persistence.hs +++ b/hydra-node/src/Hydra/Chain/Offline/Persistence.hs @@ -12,7 +12,8 @@ import Hydra.Cardano.Api (Tx) import Hydra.Chain ( ChainEvent (Observation, observedTx), ChainStateHistory, - OnChainTx (OnCommitTx, OnInitTx, contestationPeriod, headId, parties), + HeadParameters (..), + OnChainTx (..), committed, initHistory, newChainState, @@ -47,8 +48,7 @@ initializeStateIfOffline chainStateHistory initialUTxO ownHeadId ownParty contes , observedTx = OnInitTx { headId = ownHeadId - , parties = [ownParty] - , contestationPeriod = contestationPeriod + , headParameters = HeadParameters{parties = [ownParty], contestationPeriod} } } diff --git a/hydra-node/src/Hydra/Node/Run.hs b/hydra-node/src/Hydra/Node/Run.hs index ab4394ee203..84ca21304c0 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -17,7 +17,7 @@ import Hydra.Cardano.Api ( toLedgerPParams, ) import Hydra.Cardano.Api qualified as Shelley -import Hydra.Chain (ChainEvent (..), OnChainTx (..), maximumNumberOfParties) +import Hydra.Chain (maximumNumberOfParties) import Hydra.Chain.CardanoClient (QueryPoint (..), queryGenesisParameters) import Hydra.Chain.Direct (loadChainContext, mkTinyWallet, withDirectChain) import Hydra.Chain.Direct.State (initialChainState) @@ -25,7 +25,6 @@ import Hydra.Chain.Offline (withOfflineChain) import Hydra.HeadLogic ( Environment (..), Event (..), - StateChanged (..), defaultTTL, ) import Hydra.Ledger.Cardano qualified as Ledger @@ -116,7 +115,7 @@ run opts = do -- Chain let withChain cont = case onlineOrOfflineConfig of Left offlineConfig' -> - let headId = HeadId "HeadId" + let headId = UnsafeHeadId "HeadId" in withOfflineChain (contramap DirectChain tracer) offlineConfig' globals headId party contestationPeriod chainStateHistory (putEvent . OnChainEvent) cont Right onlineConfig -> do ctx <- loadChainContext chainConfig party hydraScriptsTxId From ecb26de57879c1000618f9e7ed6663d6b2f46963 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Wed, 13 Dec 2023 17:27:48 +0100 Subject: [PATCH 20/44] Minimize diff to master There were several things changed forth and back without ultimately changing anything on this branch. This commit aims to reduce the diff to master to make the actual change more visible. --- hydra-cluster/src/Hydra/Cluster/Util.hs | 14 +---- hydra-cluster/src/HydraNode.hs | 1 - hydra-cluster/test/Test/DirectChainSpec.hs | 72 ++++++++++++---------- hydra-cluster/test/Test/EndToEndSpec.hs | 1 - hydra-node/exe/hydra-node/Main.hs | 3 - hydra-node/src/Hydra/Chain/Direct.hs | 5 -- hydra-node/src/Hydra/Chain/Offline.hs | 3 - hydra-node/src/Hydra/Node/Run.hs | 3 +- 8 files changed, 40 insertions(+), 62 deletions(-) diff --git a/hydra-cluster/src/Hydra/Cluster/Util.hs b/hydra-cluster/src/Hydra/Cluster/Util.hs index c82eb9f623f..6b5bc4ef177 100644 --- a/hydra-cluster/src/Hydra/Cluster/Util.hs +++ b/hydra-cluster/src/Hydra/Cluster/Util.hs @@ -1,19 +1,7 @@ {-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE DisambiguateRecordFields #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE ScopedTypeVariables #-} -- | Utilities used across hydra-cluster -module Hydra.Cluster.Util ( - readConfigFile, - keysFor, - createAndSaveSigningKey, - offlineConfigFor, - offlineConfigForUTxO, - chainConfigFor, - initialUtxoWithFunds, - buildAddress, -) where +module Hydra.Cluster.Util where import Hydra.Prelude diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs index 61e86d20aee..282010e3bb9 100644 --- a/hydra-cluster/src/HydraNode.hs +++ b/hydra-cluster/src/HydraNode.hs @@ -303,7 +303,6 @@ withOfflineHydraNode tracer offlineConfig workDir hydraNodeId hydraSKey action = where logFilePath = workDir "logs" "hydra-node-" <> show hydraNodeId <.> "log" - withOfflineHydraNode' :: OfflineConfig -> FilePath -> diff --git a/hydra-cluster/test/Test/DirectChainSpec.hs b/hydra-cluster/test/Test/DirectChainSpec.hs index b8e1decb0e3..4a2e60fe3ea 100644 --- a/hydra-cluster/test/Test/DirectChainSpec.hs +++ b/hydra-cluster/test/Test/DirectChainSpec.hs @@ -462,10 +462,6 @@ data DirectChainTest tx m = DirectChainTest , draftCommitTx :: UTxO' (TxOut CtxUTxO, Witness WitCtxTxIn) -> HeadId -> m tx } --- instance ChainTest DirectChainTest Tx IO where --- postTx = (postTx :: PostChainTx Tx -> IO ()) --- waitCallback = (waitCallback :: IO (ChainEvent Tx)) - -- | Wrapper around 'withDirectChain' that threads a 'ChainStateType tx' through -- 'postTx' and 'waitCallback' calls. withDirectChainTest :: @@ -493,6 +489,38 @@ withDirectChainTest tracer config ctx action = do Right tx -> pure tx } +hasInitTxWith :: (HasCallStack, IsTx tx) => HeadParameters -> [OnChainId] -> OnChainTx tx -> IO (HeadId, HeadSeed) +hasInitTxWith HeadParameters{contestationPeriod = expectedContestationPeriod, parties = expectedParties} expectedParticipants = \case + OnInitTx{headId, headSeed, headParameters = HeadParameters{contestationPeriod, parties}, participants} -> do + expectedParticipants `shouldMatchList` participants + expectedContestationPeriod `shouldBe` contestationPeriod + expectedParties `shouldMatchList` parties + pure (headId, headSeed) + tx -> failure ("Unexpected observation: " <> show tx) + +observesInTime :: IsTx tx => DirectChainTest tx IO -> OnChainTx tx -> IO () +observesInTime chain expected = + observesInTimeSatisfying chain (`shouldBe` expected) + +observesInTimeSatisfying :: DirectChainTest tx IO -> (OnChainTx tx -> IO a) -> IO a +observesInTimeSatisfying DirectChainTest{waitCallback} check = + failAfter 10 go + where + go = do + e <- waitCallback + case e of + Observation{observedTx} -> + check observedTx + _TickOrRollback -> + go + +waitMatch :: DirectChainTest tx IO -> (ChainEvent tx -> Maybe b) -> IO b +waitMatch DirectChainTest{waitCallback} match = go + where + go = do + a <- waitCallback + maybe go pure (match a) + delayUntil :: (MonadDelay m, MonadTime m) => UTCTime -> m () delayUntil target = do now <- getCurrentTime @@ -515,33 +543,9 @@ externalCommit node hydraClient externalSk headId utxoToCommit' = do where DirectChainTest{draftCommitTx} = hydraClient -hasInitTxWith :: (HasCallStack, IsTx tx) => ContestationPeriod -> [Party] -> OnChainTx tx -> IO HeadId -hasInitTxWith expectedContestationPeriod expectedParties = \case - OnInitTx{headId, contestationPeriod, parties} -> do - expectedContestationPeriod `shouldBe` contestationPeriod - expectedParties `shouldBe` parties - pure headId - tx -> failure ("Unexpected observation: " <> show tx) - -observesInTime :: IsTx tx => DirectChainTest tx IO -> OnChainTx tx -> IO () -observesInTime chain expected = - observesInTimeSatisfying chain (`shouldBe` expected) - -observesInTimeSatisfying :: DirectChainTest tx IO -> (OnChainTx tx -> IO a) -> IO a -observesInTimeSatisfying c check = - failAfter 10 go - where - go = do - e <- waitCallback c - case e of - Observation{observedTx} -> - check observedTx - _TickOrRollback -> - go - -waitMatch :: DirectChainTest tx IO -> (ChainEvent tx -> Maybe b) -> IO b -waitMatch c match = go - where - go = do - a <- waitCallback c - maybe go pure (match a) +-- | Load key files for given 'Actor's (see keysFor) and directly convert them to 'OnChainId'. +loadParticipants :: [Actor] -> IO [OnChainId] +loadParticipants actors = + forM actors $ \a -> do + (vk, _) <- keysFor a + pure $ verificationKeyToOnChainId vk diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs index 950ca62c8b6..b47ff37d114 100644 --- a/hydra-cluster/test/Test/EndToEndSpec.hs +++ b/hydra-cluster/test/Test/EndToEndSpec.hs @@ -8,7 +8,6 @@ import Hydra.Prelude import Test.Hydra.Prelude import Cardano.Api.UTxO qualified as UTxO - import CardanoClient (QueryPoint (..), queryGenesisParameters, queryTip, queryTipSlotNo, submitTx, waitForUTxO) import CardanoNode (RunningNode (..), withCardanoNodeDevnet) import Control.Concurrent.STM (newTVarIO, readTVarIO) diff --git a/hydra-node/exe/hydra-node/Main.hs b/hydra-node/exe/hydra-node/Main.hs index ee138d76571..6ed42044d63 100644 --- a/hydra-node/exe/hydra-node/Main.hs +++ b/hydra-node/exe/hydra-node/Main.hs @@ -1,6 +1,4 @@ -{-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE TypeApplications #-} module Main where @@ -9,7 +7,6 @@ import Hydra.Prelude hiding (fromList) import Hydra.Cardano.Api ( serialiseToRawBytesHex, ) - import Hydra.Chain.Direct.ScriptRegistry (publishHydraScripts) import Hydra.Chain.Direct.Util (readKeyPair) import Hydra.Logging (Verbosity (..)) diff --git a/hydra-node/src/Hydra/Chain/Direct.hs b/hydra-node/src/Hydra/Chain/Direct.hs index cf7654e2e94..fdda726cb6e 100644 --- a/hydra-node/src/Hydra/Chain/Direct.hs +++ b/hydra-node/src/Hydra/Chain/Direct.hs @@ -1,8 +1,4 @@ -{-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -- | Chain component implementation which uses directly the Node-to-Client -- protocols to submit "hand-rolled" transactions. @@ -74,7 +70,6 @@ import Hydra.Chain.Direct.Handlers ( onRollBackward, onRollForward, ) - import Hydra.Chain.Direct.ScriptRegistry (queryScriptRegistry) import Hydra.Chain.Direct.State ( ChainContext (..), diff --git a/hydra-node/src/Hydra/Chain/Offline.hs b/hydra-node/src/Hydra/Chain/Offline.hs index afc185c93e5..bd022b121bf 100644 --- a/hydra-node/src/Hydra/Chain/Offline.hs +++ b/hydra-node/src/Hydra/Chain/Offline.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE DisambiguateRecordFields #-} -{-# LANGUAGE TypeApplications #-} - module Hydra.Chain.Offline ( withOfflineChain, ) where diff --git a/hydra-node/src/Hydra/Node/Run.hs b/hydra-node/src/Hydra/Node/Run.hs index 84ca21304c0..2394e8e97d8 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -22,6 +22,7 @@ import Hydra.Chain.CardanoClient (QueryPoint (..), queryGenesisParameters) import Hydra.Chain.Direct (loadChainContext, mkTinyWallet, withDirectChain) import Hydra.Chain.Direct.State (initialChainState) import Hydra.Chain.Offline (withOfflineChain) +import Hydra.HeadId (HeadId (..)) import Hydra.HeadLogic ( Environment (..), Event (..), @@ -60,8 +61,6 @@ import Hydra.Options ( ) import Hydra.Persistence (createPersistenceIncremental) -import Hydra.HeadId (HeadId (..)) - data ConfigurationException = ConfigurationException ProtocolParametersConversionError | InvalidOptionException InvalidOptions From dcfc0bf64cef8db39db1fef5c85fdec6a299745c Mon Sep 17 00:00:00 2001 From: card Date: Thu, 14 Dec 2023 21:05:10 -0500 Subject: [PATCH 21/44] WIP: get tests passing, with debug code left in --- cabal.project | 2 +- hydra-cluster/src/HydraNode.hs | 21 ++++++++-- hydra-node/hydra-node.cabal | 1 + .../src/Hydra/Chain/Offline/Handlers.hs | 15 ++++--- .../src/Hydra/Chain/Offline/Persistence.hs | 7 +++- hydra-node/src/Hydra/Node.hs | 42 +++++++++++++++---- hydra-node/src/Hydra/Node/Run.hs | 10 +++++ 7 files changed, 77 insertions(+), 21 deletions(-) diff --git a/cabal.project b/cabal.project index faac256a994..ee8dd8b6264 100644 --- a/cabal.project +++ b/cabal.project @@ -35,7 +35,7 @@ package * -- Warnings as errors for local packages program-options - ghc-options: -Werror + ghc-options: -Wwarn -- Always build tests and benchmarks of local packages tests: True diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs index 282010e3bb9..4eea770b6c2 100644 --- a/hydra-cluster/src/HydraNode.hs +++ b/hydra-cluster/src/HydraNode.hs @@ -30,7 +30,7 @@ import Network.HTTP.Req (GET (..), HttpException, JsonResponse, NoReqBody (..), import Network.HTTP.Req qualified as Req import Network.WebSockets (Connection, receiveData, runClient, sendClose, sendTextData) import System.FilePath ((<.>), ()) -import System.IO.Temp (withSystemTempDirectory) +import System.IO.Temp (withSystemTempDirectory, getCanonicalTemporaryDirectory) import System.Process ( CreateProcess (..), ProcessHandle, @@ -40,6 +40,7 @@ import System.Process ( ) import Test.Hydra.Prelude (checkProcessHasNotDied, failAfter, failure, withLogFile) import Prelude qualified +import System.Directory (createDirectoryIfMissing) data HydraClient = HydraClient { hydraNodeId :: Int @@ -303,6 +304,15 @@ withOfflineHydraNode tracer offlineConfig workDir hydraNodeId hydraSKey action = where logFilePath = workDir "logs" "hydra-node-" <> show hydraNodeId <.> "log" +withPersistentDebugDirectory :: FilePath -> (FilePath -> IO a) -> IO a +withPersistentDebugDirectory newFolder action = do + tempDirectory <- getCanonicalTemporaryDirectory + let newPath = tempDirectory newFolder + createDirectoryIfMissing True newPath + + putStrLn $ "LOG: PERSISTENT BUG DIRECTORY: " <> newPath + action newPath + withOfflineHydraNode' :: OfflineConfig -> FilePath -> @@ -314,18 +324,21 @@ withOfflineHydraNode' :: (Handle -> Handle -> ProcessHandle -> IO a) -> IO a withOfflineHydraNode' offlineConfig workDir hydraNodeId hydraSKey mGivenStdOut action = - withSystemTempDirectory "hydra-node" $ \dir -> do + withPersistentDebugDirectory "hydra-node-e2e" $ \dir -> do + putStrLn $ "LOG: Called withOfflineHydraNode': dir = " <> dir let cardanoLedgerProtocolParametersFile = dir "protocol-parameters.json" + putStrLn $ "LOG: Writing protocol-parameters.json at directory: " <> cardanoLedgerProtocolParametersFile readConfigFile "protocol-parameters.json" >>= writeFileBS cardanoLedgerProtocolParametersFile let hydraSigningKey = dir (show hydraNodeId <> ".sk") + putStrLn $ "LOG: Writing hydraSigningKey at directory: " <> hydraSigningKey void $ writeFileTextEnvelope (File hydraSigningKey) Nothing hydraSKey let ledgerConfig = CardanoLedgerConfig { cardanoLedgerProtocolParametersFile } let p = - -- ( hydraNodeProcess . (\args -> trace ("ARGS DUMP: " <> foldMap (" "<>) (toArgs args)) args) $ - ( hydraNodeProcess $ + ( hydraNodeProcess . (\args -> trace ("ARGS DUMP: " <> foldMap (" "<>) (toArgs args)) args) $ + -- ( hydraNodeProcess $ RunOptions { verbosity = Verbose "HydraNode" , nodeId = NodeId $ show hydraNodeId diff --git a/hydra-node/hydra-node.cabal b/hydra-node/hydra-node.cabal index 8834ea57bee..3d68aaa2481 100644 --- a/hydra-node/hydra-node.cabal +++ b/hydra-node/hydra-node.cabal @@ -184,6 +184,7 @@ executable hydra-node , hydra-cardano-api , hydra-node , hydra-prelude + , base ghc-options: -threaded -rtsopts -with-rtsopts=-N4 diff --git a/hydra-node/src/Hydra/Chain/Offline/Handlers.hs b/hydra-node/src/Hydra/Chain/Offline/Handlers.hs index 03b653bf33b..59520e08ae9 100644 --- a/hydra-node/src/Hydra/Chain/Offline/Handlers.hs +++ b/hydra-node/src/Hydra/Chain/Offline/Handlers.hs @@ -19,7 +19,7 @@ import Hydra.Chain ( 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) +import Hydra.HeadId (HeadId, HeadSeed (UnsafeHeadSeed)) import Hydra.Ledger.Cardano (Tx) import Hydra.Logging (Tracer, traceWith) import Hydra.Prelude @@ -41,13 +41,16 @@ mkFakeL1Chain contestationPeriod localChainState tracer ownHeadId callback = 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}} + callback $ Observation{newChainState = cst, observedTx = OnInitTx{headId, headParameters, headSeed, participants = []}} + -- FIXME(Elaine): might want to make participants nonempty, a singleton list of just some random 28 byte garbage AbortTx{} -> - callback $ Observation{newChainState = cst, observedTx = OnAbortTx{}} + callback $ Observation{newChainState = cst, observedTx = OnAbortTx{headId}} CollectComTx{} -> - callback $ Observation{newChainState = cst, observedTx = OnCollectComTx{}} + callback $ Observation{newChainState = cst, observedTx = OnCollectComTx{headId}} CloseTx{confirmedSnapshot} -> do contestationDeadline <- addUTCTime (toNominalDiffTime contestationPeriod) <$> getCurrentTime callback $ @@ -62,14 +65,14 @@ mkFakeL1Chain contestationPeriod localChainState tracer ownHeadId callback = Observation { newChainState = cst , observedTx = - OnContestTx{snapshotNumber = number $ getSnapshot confirmedSnapshot} + OnContestTx{snapshotNumber = number $ getSnapshot confirmedSnapshot, headId} } FanoutTx{} -> callback $ Observation { newChainState = cst , observedTx = - OnFanoutTx{} + OnFanoutTx{headId} } pure () } diff --git a/hydra-node/src/Hydra/Chain/Offline/Persistence.hs b/hydra-node/src/Hydra/Chain/Offline/Persistence.hs index e8d707f04f7..c0d6cc2ee35 100644 --- a/hydra-node/src/Hydra/Chain/Offline/Persistence.hs +++ b/hydra-node/src/Hydra/Chain/Offline/Persistence.hs @@ -21,8 +21,8 @@ import Hydra.Chain ( ) import Hydra.Chain.Direct.State (initialChainState) import Hydra.ContestationPeriod (ContestationPeriod) -import Hydra.HeadId (HeadId) -import Hydra.HeadLogic (StateChanged (SnapshotConfirmed, snapshot)) +import Hydra.HeadId (HeadId, HeadSeed (UnsafeHeadSeed)) +import Hydra.HeadLogic (StateChanged (SnapshotConfirmed, snapshot), Environment (participants)) import Hydra.Ledger (IsTx (UTxOType)) import Hydra.Party (Party) import Hydra.Persistence (PersistenceIncremental (PersistenceIncremental, append, loadAll), createPersistenceIncremental) @@ -49,6 +49,8 @@ initializeStateIfOffline chainStateHistory initialUTxO ownHeadId ownParty contes OnInitTx { headId = ownHeadId , headParameters = HeadParameters{parties = [ownParty], contestationPeriod} + , headSeed = UnsafeHeadSeed "OfflineHeadSeed_" -- FIXME(Elaine): might want to generate? + , participants = []-- error "Participants unimplemented!" -- FIXME(Elaine): might want to make arbitrary / garbage 28 byte value } } @@ -61,6 +63,7 @@ initializeStateIfOffline chainStateHistory initialUTxO ownHeadId ownParty contes OnCommitTx { party = ownParty , committed = initialUTxO + , headId = ownHeadId } } diff --git a/hydra-node/src/Hydra/Node.hs b/hydra-node/src/Hydra/Node.hs index 4891aaafa67..f163a9be5a3 100644 --- a/hydra-node/src/Hydra/Node.hs +++ b/hydra-node/src/Hydra/Node.hs @@ -69,13 +69,29 @@ import Hydra.Persistence (PersistenceIncremental (..), loadAll) -- | Intialize the 'Environment' from command line options. initEnvironment :: RunOptions -> IO Environment initEnvironment options = do + putStrLn $ "LOG: before readFileTextEnvelopeThrow hydraSigningKey" + putStrLn $ "LOG: hydraSigningKey: " ++ hydraSigningKey sk <- readFileTextEnvelopeThrow (AsSigningKey AsHydraKey) hydraSigningKey + putStrLn "LOG: before readFileTextEnvelopeThrow hydraVerificationKeys" + putStrLn $ "LOG: hydraVerificationKeys: " ++ show hydraVerificationKeys 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 + putStrLn "LOG: before readFileTextEnvelopeThrow cardanoSigningKey" + putStrLn $ "LOG: cardanoSigningKey: " ++ cardanoSigningKey + ownSigningKey <- case offlineConfig of + -- Nothing for offlineconfig means we are running in online mode + Nothing -> readFileTextEnvelopeThrow (AsSigningKey AsPaymentKey) cardanoSigningKey + -- Just offlineconfig means we are running in offline mode + Just _ -> pure $ Hydra.Prelude.error "Shouldn't be using cardanoSigningKey in offline mode!" + + putStrLn "LOG: before readFileTextEnvelopeThrow cardanoVerificationKeys" + putStrLn $ "LOG: cardanoVerificationKeys: " ++ show cardanoVerificationKeys otherVerificationKeys <- mapM (readFileTextEnvelopeThrow (AsVerificationKey AsPaymentKey)) cardanoVerificationKeys - let participants = verificationKeyToOnChainId <$> (getVerificationKey ownSigningKey : otherVerificationKeys) + -- let participants = [] + let participants = case offlineConfig of + Nothing -> verificationKeyToOnChainId <$> (getVerificationKey ownSigningKey : otherVerificationKeys) + Just _ -> [] pure $ Environment { party = deriveParty sk @@ -91,6 +107,7 @@ initEnvironment options = do RunOptions { hydraSigningKey , hydraVerificationKeys + , offlineConfig , chainConfig = DirectChainConfig { contestationPeriod @@ -185,20 +202,28 @@ stepHydraNode :: HydraNode tx m -> m () stepHydraNode tracer node = do + -- trace ("LOG: starting hydra step") (pure ()) e@Queued{eventId, queuedEvent} <- nextEvent eq traceWith tracer $ BeginEvent{by = party, eventId, event = queuedEvent} + -- trace "LOG: processing event" (pure ()) outcome <- atomically (processNextEvent node queuedEvent) traceWith tracer (LogicOutcome party outcome) + -- trace "LOG: processed event" (pure ()) + -- trace "LOG: handling outcome" (pure ()) handleOutcome e outcome + -- trace "LOG: handled outcome" (pure ()) + -- trace "LOG: processing effects" (pure ()) processEffects node tracer eventId outcome traceWith tracer EndEvent{by = party, eventId} + -- trace "LOG: finished hydra step" (pure ()) + -- trace "LOG: finished step" (pure ()) where handleOutcome e = \case - Error _ -> pure () - Wait _reason -> putEventAfter eq waitDelay (decreaseTTL e) - StateChanged sc -> append sc - Effects _ -> pure () - Combined l r -> handleOutcome e l >> handleOutcome e r + Error _ -> {- trace "LOG: Handle: error" $ -} pure () + Wait _reason -> {-trace "LOG: Handle: Wait" $ -}putEventAfter eq waitDelay (decreaseTTL e) + StateChanged sc ->{- trace "LOG: Handle: StateChanged" $-} append sc + Effects _ -> {-trace "LOG: Handle: Effects" $ -}pure () + Combined l r -> {-trace "LOG: Handle: Combined" $ -}handleOutcome e l >> handleOutcome e r decreaseTTL = \case @@ -224,13 +249,14 @@ processNextEvent :: Event tx -> STM m (Outcome tx) processNextEvent HydraNode{nodeState, ledger, env} e = + -- trace "LOG: processNextEvent called with " $ modifyHeadState $ \s -> let outcome = computeOutcome s e in (outcome, aggregateState s outcome) where NodeState{modifyHeadState} = nodeState - computeOutcome = Logic.update env ledger + computeOutcome = {- trace "LOG: computeOutcome" $-} Logic.update env ledger processEffects :: ( MonadAsync m diff --git a/hydra-node/src/Hydra/Node/Run.hs b/hydra-node/src/Hydra/Node/Run.hs index 2394e8e97d8..4aa3096b596 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -78,9 +78,12 @@ explain = \case run :: RunOptions -> IO () run opts = do + putStrLn $ "LOG: Called run()" either (throwIO . InvalidOptionException) pure $ validateRunOptions opts + putStrLn $ "LOG: Called validateRunOptions()" let RunOptions{verbosity, monitoringPort, persistenceDir, offlineConfig} = opts env@Environment{party, otherParties, signingKey, contestationPeriod} <- initEnvironment opts + putStrLn $ "LOG: Called initEnvironment()" withTracer verbosity $ \tracer' -> withMonitoring monitoringPort tracer' $ \tracer -> do traceWith tracer (NodeOptions opts) @@ -104,13 +107,17 @@ run opts = do Just OfflineConfig{ledgerGenesisFile} -> do -- offline loadGlobalsFromGenesis ledgerGenesisFile + putStrLn $ "LOG: Got globals" withCardanoLedger pparams globals $ \ledger -> do + putStrLn $ "LOG: Called withCardanoLedger" persistence <- createPersistenceIncremental $ persistenceDir <> "/state" (hs, chainStateHistory) <- loadState (contramap Node tracer) persistence initialChainState + putStrLn $ "LOG: Loaded state from persistence directory: " <> persistenceDir <> "/state" checkHeadState (contramap Node tracer) env hs nodeState <- createNodeState hs + putStrLn $ "LOG: Created node state" -- Chain let withChain cont = case onlineOrOfflineConfig of Left offlineConfig' -> @@ -121,15 +128,18 @@ run opts = do wallet <- mkTinyWallet (contramap DirectChain tracer) onlineConfig withDirectChain (contramap DirectChain tracer) onlineConfig ctx wallet chainStateHistory (putEvent . OnChainEvent) cont withChain $ \chain -> do + putStrLn $ "LOG: Called withChain" -- API let RunOptions{host, port, peers, nodeId} = opts putNetworkEvent (Authenticated msg otherParty) = putEvent $ NetworkEvent defaultTTL otherParty msg RunOptions{apiHost, apiPort} = opts apiPersistence <- createPersistenceIncremental $ persistenceDir <> "/server-output" withAPIServer apiHost apiPort party apiPersistence (contramap APIServer tracer) chain pparams (putEvent . ClientEvent) $ \server -> do + putStrLn $ "LOG: Called withAPIServer" -- Network let networkConfiguration = NetworkConfiguration{persistenceDir, signingKey, otherParties, host, port, peers, nodeId} withNetwork tracer (connectionMessages server) networkConfiguration putNetworkEvent $ \hn -> do + putStrLn $ "LOG: Called withNetwork" -- Main loop runHydraNode (contramap Node tracer) $ HydraNode From f641a98316743b2b509088c159333067cf31d7f3 Mon Sep 17 00:00:00 2001 From: card Date: Thu, 14 Dec 2023 22:03:42 -0500 Subject: [PATCH 22/44] demonstrate offline mode running with arbitrary participant OnChainId --- hydra-node/src/Hydra/Chain/Offline/Handlers.hs | 6 ++++-- hydra-node/src/Hydra/Chain/Offline/Persistence.hs | 5 +++-- hydra-node/src/Hydra/Node.hs | 4 ++-- 3 files changed, 9 insertions(+), 6 deletions(-) diff --git a/hydra-node/src/Hydra/Chain/Offline/Handlers.hs b/hydra-node/src/Hydra/Chain/Offline/Handlers.hs index 59520e08ae9..4c4d05c5b81 100644 --- a/hydra-node/src/Hydra/Chain/Offline/Handlers.hs +++ b/hydra-node/src/Hydra/Chain/Offline/Handlers.hs @@ -24,6 +24,7 @@ import Hydra.Ledger.Cardano (Tx) import Hydra.Logging (Tracer, traceWith) import Hydra.Prelude import Hydra.Snapshot (Snapshot (number), getSnapshot) +import Hydra.OnChainId (OnChainId(UnsafeOnChainId)) mkFakeL1Chain :: ContestationPeriod -> @@ -43,10 +44,11 @@ mkFakeL1Chain contestationPeriod localChainState tracer ownHeadId callback = let headId = ownHeadId let offlineHeadSeed = UnsafeHeadSeed "OfflineHeadSeed_" headSeed = offlineHeadSeed + ownParticipant = UnsafeOnChainId "___OfflineHeadParticipant___" + participants = [ownParticipant] _ <- case tx of InitTx{headParameters} -> - callback $ Observation{newChainState = cst, observedTx = OnInitTx{headId, headParameters, headSeed, participants = []}} - -- FIXME(Elaine): might want to make participants nonempty, a singleton list of just some random 28 byte garbage + callback $ Observation{newChainState = cst, observedTx = OnInitTx{headId, headParameters, headSeed, participants}} AbortTx{} -> callback $ Observation{newChainState = cst, observedTx = OnAbortTx{headId}} CollectComTx{} -> diff --git a/hydra-node/src/Hydra/Chain/Offline/Persistence.hs b/hydra-node/src/Hydra/Chain/Offline/Persistence.hs index c0d6cc2ee35..44ab08b375b 100644 --- a/hydra-node/src/Hydra/Chain/Offline/Persistence.hs +++ b/hydra-node/src/Hydra/Chain/Offline/Persistence.hs @@ -28,6 +28,7 @@ import Hydra.Party (Party) import Hydra.Persistence (PersistenceIncremental (PersistenceIncremental, append, loadAll), createPersistenceIncremental) import Hydra.Snapshot (Snapshot (Snapshot, utxo)) import UnliftIO.IO.File (writeBinaryFileDurableAtomic) +import Hydra.OnChainId (OnChainId(UnsafeOnChainId)) initializeStateIfOffline :: ChainStateHistory Tx -> @@ -49,8 +50,8 @@ initializeStateIfOffline chainStateHistory initialUTxO ownHeadId ownParty contes OnInitTx { headId = ownHeadId , headParameters = HeadParameters{parties = [ownParty], contestationPeriod} - , headSeed = UnsafeHeadSeed "OfflineHeadSeed_" -- FIXME(Elaine): might want to generate? - , participants = []-- error "Participants unimplemented!" -- FIXME(Elaine): might want to make arbitrary / garbage 28 byte value + , headSeed = UnsafeHeadSeed "OfflineHeadSeed_" + , participants = [UnsafeOnChainId "___OfflineHeadParticipant___"] } } diff --git a/hydra-node/src/Hydra/Node.hs b/hydra-node/src/Hydra/Node.hs index f163a9be5a3..974211c5f20 100644 --- a/hydra-node/src/Hydra/Node.hs +++ b/hydra-node/src/Hydra/Node.hs @@ -63,6 +63,7 @@ import Hydra.Node.ParameterMismatch (ParamMismatch (..), ParameterMismatch (..)) import Hydra.Options (ChainConfig (..), RunOptions (..)) import Hydra.Party (Party (..), deriveParty) import Hydra.Persistence (PersistenceIncremental (..), loadAll) +import Hydra.OnChainId (OnChainId(UnsafeOnChainId)) -- * Environment Handling @@ -88,10 +89,9 @@ initEnvironment options = do putStrLn "LOG: before readFileTextEnvelopeThrow cardanoVerificationKeys" putStrLn $ "LOG: cardanoVerificationKeys: " ++ show cardanoVerificationKeys otherVerificationKeys <- mapM (readFileTextEnvelopeThrow (AsVerificationKey AsPaymentKey)) cardanoVerificationKeys - -- let participants = [] let participants = case offlineConfig of Nothing -> verificationKeyToOnChainId <$> (getVerificationKey ownSigningKey : otherVerificationKeys) - Just _ -> [] + Just _ -> [UnsafeOnChainId "___OfflineHeadParticipant___"] pure $ Environment { party = deriveParty sk From a7ad53a0548e715e42b192d110a065302f9134c0 Mon Sep 17 00:00:00 2001 From: card Date: Thu, 14 Dec 2023 22:32:08 -0500 Subject: [PATCH 23/44] clean up most stuff, get rid of debug code & logs --- hydra-cluster/src/Hydra/Cluster/Faucet.hs | 3 -- hydra-cluster/src/HydraNode.hs | 18 ++-------- .../src/Hydra/Chain/Offline/Handlers.hs | 4 +-- hydra-node/src/Hydra/Node.hs | 33 +++++-------------- hydra-node/src/Hydra/Node/Run.hs | 12 +------ 5 files changed, 13 insertions(+), 57 deletions(-) diff --git a/hydra-cluster/src/Hydra/Cluster/Faucet.hs b/hydra-cluster/src/Hydra/Cluster/Faucet.hs index e65808adbce..28bab418101 100644 --- a/hydra-cluster/src/Hydra/Cluster/Faucet.hs +++ b/hydra-cluster/src/Hydra/Cluster/Faucet.hs @@ -98,9 +98,6 @@ seedFromFaucet_ :: seedFromFaucet_ node vk ll tracer = void $ seedFromFaucet node vk ll tracer --- TODO(Elaine): we probably want a simplified but parallel version of this/createOutputAddress for offline mode , that just constructs a UTxO --- actually no take a look at seedFromFaucet - -- | Return the remaining funds to the faucet returnFundsToFaucet :: Tracer IO FaucetLog -> diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs index 4eea770b6c2..f19a8ec5e84 100644 --- a/hydra-cluster/src/HydraNode.hs +++ b/hydra-cluster/src/HydraNode.hs @@ -304,15 +304,6 @@ withOfflineHydraNode tracer offlineConfig workDir hydraNodeId hydraSKey action = where logFilePath = workDir "logs" "hydra-node-" <> show hydraNodeId <.> "log" -withPersistentDebugDirectory :: FilePath -> (FilePath -> IO a) -> IO a -withPersistentDebugDirectory newFolder action = do - tempDirectory <- getCanonicalTemporaryDirectory - let newPath = tempDirectory newFolder - createDirectoryIfMissing True newPath - - putStrLn $ "LOG: PERSISTENT BUG DIRECTORY: " <> newPath - action newPath - withOfflineHydraNode' :: OfflineConfig -> FilePath -> @@ -320,25 +311,20 @@ withOfflineHydraNode' :: SigningKey HydraKey -> -- | If given use this as std out. Maybe Handle -> - -- -> (HydraClient -> IO a) (Handle -> Handle -> ProcessHandle -> IO a) -> IO a withOfflineHydraNode' offlineConfig workDir hydraNodeId hydraSKey mGivenStdOut action = - withPersistentDebugDirectory "hydra-node-e2e" $ \dir -> do - putStrLn $ "LOG: Called withOfflineHydraNode': dir = " <> dir + withSystemTempDirectory "hydra-node-e2e" $ \dir -> do let cardanoLedgerProtocolParametersFile = dir "protocol-parameters.json" - putStrLn $ "LOG: Writing protocol-parameters.json at directory: " <> cardanoLedgerProtocolParametersFile readConfigFile "protocol-parameters.json" >>= writeFileBS cardanoLedgerProtocolParametersFile let hydraSigningKey = dir (show hydraNodeId <> ".sk") - putStrLn $ "LOG: Writing hydraSigningKey at directory: " <> hydraSigningKey void $ writeFileTextEnvelope (File hydraSigningKey) Nothing hydraSKey let ledgerConfig = CardanoLedgerConfig { cardanoLedgerProtocolParametersFile } let p = - ( hydraNodeProcess . (\args -> trace ("ARGS DUMP: " <> foldMap (" "<>) (toArgs args)) args) $ - -- ( hydraNodeProcess $ + ( hydraNodeProcess $ RunOptions { verbosity = Verbose "HydraNode" , nodeId = NodeId $ show hydraNodeId diff --git a/hydra-node/src/Hydra/Chain/Offline/Handlers.hs b/hydra-node/src/Hydra/Chain/Offline/Handlers.hs index 4c4d05c5b81..e00c1ee6dc9 100644 --- a/hydra-node/src/Hydra/Chain/Offline/Handlers.hs +++ b/hydra-node/src/Hydra/Chain/Offline/Handlers.hs @@ -59,10 +59,10 @@ mkFakeL1Chain contestationPeriod localChainState tracer ownHeadId callback = Observation { newChainState = cst , observedTx = - OnCloseTx{headId, snapshotNumber = number $ getSnapshot confirmedSnapshot, contestationDeadline} -- ELAINE TODO: probably we shouldnt allow the clietn to do contestation in offline mode ? + OnCloseTx{headId, snapshotNumber = number $ getSnapshot confirmedSnapshot, contestationDeadline} } ContestTx{confirmedSnapshot} -> - -- this shouldnt really happen, i dont think we should allow contesting in offline mode + -- TODO: this shouldn't really happen... make it impossible to do contestation in offline mode? callback $ Observation { newChainState = cst diff --git a/hydra-node/src/Hydra/Node.hs b/hydra-node/src/Hydra/Node.hs index 974211c5f20..4e087e64996 100644 --- a/hydra-node/src/Hydra/Node.hs +++ b/hydra-node/src/Hydra/Node.hs @@ -70,24 +70,16 @@ import Hydra.OnChainId (OnChainId(UnsafeOnChainId)) -- | Intialize the 'Environment' from command line options. initEnvironment :: RunOptions -> IO Environment initEnvironment options = do - putStrLn $ "LOG: before readFileTextEnvelopeThrow hydraSigningKey" - putStrLn $ "LOG: hydraSigningKey: " ++ hydraSigningKey sk <- readFileTextEnvelopeThrow (AsSigningKey AsHydraKey) hydraSigningKey - putStrLn "LOG: before readFileTextEnvelopeThrow hydraVerificationKeys" - putStrLn $ "LOG: hydraVerificationKeys: " ++ show hydraVerificationKeys otherParties <- mapM loadParty hydraVerificationKeys -- NOTE: This is a cardano-specific initialization step of loading -- --cardano-verification-key options and deriving 'OnChainId's from it. - putStrLn "LOG: before readFileTextEnvelopeThrow cardanoSigningKey" - putStrLn $ "LOG: cardanoSigningKey: " ++ cardanoSigningKey ownSigningKey <- case offlineConfig of - -- Nothing for offlineconfig means we are running in online mode + -- online mode Nothing -> readFileTextEnvelopeThrow (AsSigningKey AsPaymentKey) cardanoSigningKey - -- Just offlineconfig means we are running in offline mode + -- offline mode Just _ -> pure $ Hydra.Prelude.error "Shouldn't be using cardanoSigningKey in offline mode!" - putStrLn "LOG: before readFileTextEnvelopeThrow cardanoVerificationKeys" - putStrLn $ "LOG: cardanoVerificationKeys: " ++ show cardanoVerificationKeys otherVerificationKeys <- mapM (readFileTextEnvelopeThrow (AsVerificationKey AsPaymentKey)) cardanoVerificationKeys let participants = case offlineConfig of Nothing -> verificationKeyToOnChainId <$> (getVerificationKey ownSigningKey : otherVerificationKeys) @@ -202,28 +194,20 @@ stepHydraNode :: HydraNode tx m -> m () stepHydraNode tracer node = do - -- trace ("LOG: starting hydra step") (pure ()) e@Queued{eventId, queuedEvent} <- nextEvent eq traceWith tracer $ BeginEvent{by = party, eventId, event = queuedEvent} - -- trace "LOG: processing event" (pure ()) outcome <- atomically (processNextEvent node queuedEvent) traceWith tracer (LogicOutcome party outcome) - -- trace "LOG: processed event" (pure ()) - -- trace "LOG: handling outcome" (pure ()) handleOutcome e outcome - -- trace "LOG: handled outcome" (pure ()) - -- trace "LOG: processing effects" (pure ()) processEffects node tracer eventId outcome traceWith tracer EndEvent{by = party, eventId} - -- trace "LOG: finished hydra step" (pure ()) - -- trace "LOG: finished step" (pure ()) where handleOutcome e = \case - Error _ -> {- trace "LOG: Handle: error" $ -} pure () - Wait _reason -> {-trace "LOG: Handle: Wait" $ -}putEventAfter eq waitDelay (decreaseTTL e) - StateChanged sc ->{- trace "LOG: Handle: StateChanged" $-} append sc - Effects _ -> {-trace "LOG: Handle: Effects" $ -}pure () - Combined l r -> {-trace "LOG: Handle: Combined" $ -}handleOutcome e l >> handleOutcome e r + Error _ -> pure () + Wait _reason -> putEventAfter eq waitDelay (decreaseTTL e) + StateChanged sc -> append sc + Effects _ -> pure () + Combined l r -> handleOutcome e l >> handleOutcome e r decreaseTTL = \case @@ -249,14 +233,13 @@ processNextEvent :: Event tx -> STM m (Outcome tx) processNextEvent HydraNode{nodeState, ledger, env} e = - -- trace "LOG: processNextEvent called with " $ modifyHeadState $ \s -> let outcome = computeOutcome s e in (outcome, aggregateState s outcome) where NodeState{modifyHeadState} = nodeState - computeOutcome = {- trace "LOG: computeOutcome" $-} Logic.update env ledger + computeOutcome = Logic.update env ledger processEffects :: ( MonadAsync m diff --git a/hydra-node/src/Hydra/Node/Run.hs b/hydra-node/src/Hydra/Node/Run.hs index 4aa3096b596..e2a802b8eba 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -78,12 +78,9 @@ explain = \case run :: RunOptions -> IO () run opts = do - putStrLn $ "LOG: Called run()" either (throwIO . InvalidOptionException) pure $ validateRunOptions opts - putStrLn $ "LOG: Called validateRunOptions()" let RunOptions{verbosity, monitoringPort, persistenceDir, offlineConfig} = opts env@Environment{party, otherParties, signingKey, contestationPeriod} <- initEnvironment opts - putStrLn $ "LOG: Called initEnvironment()" withTracer verbosity $ \tracer' -> withMonitoring monitoringPort tracer' $ \tracer -> do traceWith tracer (NodeOptions opts) @@ -107,17 +104,13 @@ run opts = do Just OfflineConfig{ledgerGenesisFile} -> do -- offline loadGlobalsFromGenesis ledgerGenesisFile - putStrLn $ "LOG: Got globals" withCardanoLedger pparams globals $ \ledger -> do - putStrLn $ "LOG: Called withCardanoLedger" persistence <- createPersistenceIncremental $ persistenceDir <> "/state" (hs, chainStateHistory) <- loadState (contramap Node tracer) persistence initialChainState - putStrLn $ "LOG: Loaded state from persistence directory: " <> persistenceDir <> "/state" checkHeadState (contramap Node tracer) env hs nodeState <- createNodeState hs - putStrLn $ "LOG: Created node state" -- Chain let withChain cont = case onlineOrOfflineConfig of Left offlineConfig' -> @@ -128,18 +121,15 @@ run opts = do wallet <- mkTinyWallet (contramap DirectChain tracer) onlineConfig withDirectChain (contramap DirectChain tracer) onlineConfig ctx wallet chainStateHistory (putEvent . OnChainEvent) cont withChain $ \chain -> do - putStrLn $ "LOG: Called withChain" -- API let RunOptions{host, port, peers, nodeId} = opts putNetworkEvent (Authenticated msg otherParty) = putEvent $ NetworkEvent defaultTTL otherParty msg RunOptions{apiHost, apiPort} = opts apiPersistence <- createPersistenceIncremental $ persistenceDir <> "/server-output" withAPIServer apiHost apiPort party apiPersistence (contramap APIServer tracer) chain pparams (putEvent . ClientEvent) $ \server -> do - putStrLn $ "LOG: Called withAPIServer" -- Network let networkConfiguration = NetworkConfiguration{persistenceDir, signingKey, otherParties, host, port, peers, nodeId} withNetwork tracer (connectionMessages server) networkConfiguration putNetworkEvent $ \hn -> do - putStrLn $ "LOG: Called withNetwork" -- Main loop runHydraNode (contramap Node tracer) $ HydraNode @@ -165,7 +155,7 @@ identifyNode :: RunOptions -> RunOptions identifyNode opt@RunOptions{verbosity = Verbose "HydraNode", nodeId} = opt{verbosity = Verbose $ "HydraNode-" <> show nodeId} identifyNode opt = opt --- TODO(ELAINE): figure out a less strange way to do this +-- TODO: export from cardano-api -- | Taken from Cardano.Api.GenesisParameters, a private module in cardano-api fromShelleyGenesis :: Shelley.ShelleyGenesis Ledger.StandardCrypto -> GenesisParameters Shelley.ShelleyEra From 1228373d5a8b236ce52113e794412ccc590d667a Mon Sep 17 00:00:00 2001 From: card Date: Thu, 14 Dec 2023 22:32:29 -0500 Subject: [PATCH 24/44] Revert "demonstrate offline mode running with arbitrary participant OnChainId" This reverts commit 84adba8663574c01f41e1fd2e4d806c2b9184acb. --- hydra-node/src/Hydra/Chain/Offline/Handlers.hs | 6 ++---- hydra-node/src/Hydra/Chain/Offline/Persistence.hs | 5 ++--- hydra-node/src/Hydra/Node.hs | 4 ++-- 3 files changed, 6 insertions(+), 9 deletions(-) diff --git a/hydra-node/src/Hydra/Chain/Offline/Handlers.hs b/hydra-node/src/Hydra/Chain/Offline/Handlers.hs index e00c1ee6dc9..60cb0f162c4 100644 --- a/hydra-node/src/Hydra/Chain/Offline/Handlers.hs +++ b/hydra-node/src/Hydra/Chain/Offline/Handlers.hs @@ -24,7 +24,6 @@ import Hydra.Ledger.Cardano (Tx) import Hydra.Logging (Tracer, traceWith) import Hydra.Prelude import Hydra.Snapshot (Snapshot (number), getSnapshot) -import Hydra.OnChainId (OnChainId(UnsafeOnChainId)) mkFakeL1Chain :: ContestationPeriod -> @@ -44,11 +43,10 @@ mkFakeL1Chain contestationPeriod localChainState tracer ownHeadId callback = let headId = ownHeadId let offlineHeadSeed = UnsafeHeadSeed "OfflineHeadSeed_" headSeed = offlineHeadSeed - ownParticipant = UnsafeOnChainId "___OfflineHeadParticipant___" - participants = [ownParticipant] _ <- case tx of InitTx{headParameters} -> - callback $ Observation{newChainState = cst, observedTx = OnInitTx{headId, headParameters, headSeed, participants}} + callback $ Observation{newChainState = cst, observedTx = OnInitTx{headId, headParameters, headSeed, participants = []}} + -- FIXME(Elaine): might want to make participants nonempty, a singleton list of just some random 28 byte garbage AbortTx{} -> callback $ Observation{newChainState = cst, observedTx = OnAbortTx{headId}} CollectComTx{} -> diff --git a/hydra-node/src/Hydra/Chain/Offline/Persistence.hs b/hydra-node/src/Hydra/Chain/Offline/Persistence.hs index 44ab08b375b..c0d6cc2ee35 100644 --- a/hydra-node/src/Hydra/Chain/Offline/Persistence.hs +++ b/hydra-node/src/Hydra/Chain/Offline/Persistence.hs @@ -28,7 +28,6 @@ import Hydra.Party (Party) import Hydra.Persistence (PersistenceIncremental (PersistenceIncremental, append, loadAll), createPersistenceIncremental) import Hydra.Snapshot (Snapshot (Snapshot, utxo)) import UnliftIO.IO.File (writeBinaryFileDurableAtomic) -import Hydra.OnChainId (OnChainId(UnsafeOnChainId)) initializeStateIfOffline :: ChainStateHistory Tx -> @@ -50,8 +49,8 @@ initializeStateIfOffline chainStateHistory initialUTxO ownHeadId ownParty contes OnInitTx { headId = ownHeadId , headParameters = HeadParameters{parties = [ownParty], contestationPeriod} - , headSeed = UnsafeHeadSeed "OfflineHeadSeed_" - , participants = [UnsafeOnChainId "___OfflineHeadParticipant___"] + , headSeed = UnsafeHeadSeed "OfflineHeadSeed_" -- FIXME(Elaine): might want to generate? + , participants = []-- error "Participants unimplemented!" -- FIXME(Elaine): might want to make arbitrary / garbage 28 byte value } } diff --git a/hydra-node/src/Hydra/Node.hs b/hydra-node/src/Hydra/Node.hs index 4e087e64996..73d54df3a05 100644 --- a/hydra-node/src/Hydra/Node.hs +++ b/hydra-node/src/Hydra/Node.hs @@ -63,7 +63,6 @@ import Hydra.Node.ParameterMismatch (ParamMismatch (..), ParameterMismatch (..)) import Hydra.Options (ChainConfig (..), RunOptions (..)) import Hydra.Party (Party (..), deriveParty) import Hydra.Persistence (PersistenceIncremental (..), loadAll) -import Hydra.OnChainId (OnChainId(UnsafeOnChainId)) -- * Environment Handling @@ -81,9 +80,10 @@ initEnvironment options = do Just _ -> pure $ Hydra.Prelude.error "Shouldn't be using cardanoSigningKey in offline mode!" otherVerificationKeys <- mapM (readFileTextEnvelopeThrow (AsVerificationKey AsPaymentKey)) cardanoVerificationKeys + -- let participants = [] let participants = case offlineConfig of Nothing -> verificationKeyToOnChainId <$> (getVerificationKey ownSigningKey : otherVerificationKeys) - Just _ -> [UnsafeOnChainId "___OfflineHeadParticipant___"] + Just _ -> [] pure $ Environment { party = deriveParty sk From f81761af03b3600b4a9f22da068b3a7377b58237 Mon Sep 17 00:00:00 2001 From: card Date: Fri, 15 Dec 2023 05:58:47 -0500 Subject: [PATCH 25/44] wip: temporary commit for demoing offline mode. Good for demo, do not merge as is --- hydra-cluster/test/Test/EndToEndSpec.hs | 265 +++++++++++++++++++++++- hydra-node/hydra-node.cabal | 2 + 2 files changed, 259 insertions(+), 8 deletions(-) diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs index b47ff37d114..73ccf2b7a1b 100644 --- a/hydra-cluster/test/Test/EndToEndSpec.hs +++ b/hydra-cluster/test/Test/EndToEndSpec.hs @@ -36,6 +36,23 @@ import Hydra.Cardano.Api ( signTx, pattern TxOut, pattern TxValidityLowerBound, + CtxTx, + txFee, + txIns, + txOuts, + makeSignedTransaction, + makeShelleyKeyWitness, + ShelleyWitnessSigningKey(..), + createAndValidateTransactionBody, + pattern TxFeeExplicit, + KeyWitnessInCtx (..), + pattern KeyWitness, + pattern BuildTxWith, + ToTxContext (toTxContext), + negateValue, + pattern TxOutDatumNone, + pattern ReferenceScriptNone, + Lovelace (..), ) import Hydra.Chain.Direct.State () import Hydra.Cluster.Faucet ( @@ -75,7 +92,7 @@ import Hydra.Cluster.Util (chainConfigFor, keysFor, offlineConfigFor) 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, mkRangedTx, mkSimpleTx, Tx, emptyTxBody) import Hydra.Logging (Tracer, showLogsOnFailure) import Hydra.Options import Hydra.Party (deriveParty) @@ -95,12 +112,13 @@ import HydraNode ( withHydraNode', withOfflineHydraNode, ) -import System.Directory (removeDirectoryRecursive) +import System.Directory (removeDirectoryRecursive, listDirectory) import System.FilePath (()) import System.IO (hGetLine) import System.IO.Error (isEOFError) import Test.QuickCheck (generate) import Prelude qualified +import qualified Data.ByteString.Char8 as BS allNodeIds :: [Int] allNodeIds = [1 .. 3] @@ -116,33 +134,264 @@ withClusterTempDir name = spec :: Spec spec = around (showLogsOnFailure "EndToEndSpec") $ do it "End-to-end offline mode" $ \tracer -> do - withTempDir ("offline-mode-e2e") $ \tmpDir -> do + withTempDir ("offline-mode-e2e") $ \tmpDir -> + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -- Offline mode demo! + + do let networkId = Testnet (NetworkMagic 42) -- from defaultChainConfig let startingState = [ (Alice, lovelaceToValue 100_000_000) , (Bob, lovelaceToValue 100_000_000) + , (Carol, lovelaceToValue 998_987_654) -- 999_999_999 - 1_012_345 ] + (aliceCardanoVk, aliceCardanoSk) <- keysFor Alice - (bobCardanoVk, _) <- keysFor Bob + (bobCardanoVk, bobCardanoSk) <- keysFor Bob + (carolCardanoVk, _carolCardanoSk) <- keysFor Carol offlineConfig <- offlineConfigFor startingState tmpDir networkId initialUtxo <- Aeson.throwDecodeStrict @UTxO.UTxO =<< readFileBS (initialUTxOFile offlineConfig) let Just (aliceSeedTxIn, aliceSeedTxOut) = UTxO.find (\(TxOut addr _ _ _) -> addr == mkVkAddress networkId aliceCardanoVk) initialUtxo + let putStrLnGreen s = do + putStrLn $ "\x1b[32m" <> replicate (length s + 6) '=' <> "\x1b[0m" + putStrLn $ "\x1b[32m" <> "|| " <> s <> " ||" <> "\x1b[0m" + putStrLn $ "\x1b[32m" <> replicate (length s + 6) '=' <> "\x1b[0m" + + let printJSON :: Aeson.ToJSON a => a -> IO () + printJSON = BS.putStrLn . toStrict . Aeson.encode + + let waitABit = void @IO $ threadDelay 30 + withOfflineHydraNode (contramap FromHydraNode tracer) offlineConfig tmpDir 0 aliceSk $ \node -> do + -- An offline Hydra node all booted up! + putStrLnGreen "DEMO: An offline Hydra node all booted up!" + + waitABit + + -- Let's build a simple transaction, from Alice to Bob, of 1_000_000 lovelace + putStrLnGreen "DEMO: Let's build a simple transaction, from Alice to Bob, of 1_000_000 lovelace" let Right tx = mkSimpleTx (aliceSeedTxIn, aliceSeedTxOut) - (mkVkAddress networkId bobCardanoVk, lovelaceToValue paymentFromAliceToBob) + (mkVkAddress networkId bobCardanoVk, lovelaceToValue paymentFromAliceToBob) -- 1_000_000 aliceCardanoSk - send node $ input "NewTx" ["transaction" .= tx] + waitABit + -- Here's our first transaction, from Alice to bob + putStrLnGreen "DEMO: Here's our first transaction, from Alice to Bob" + + printJSON tx - waitMatch 10 node $ \v -> do - guard $ v ^? key "tag" == Just "SnapshotConfirmed" + send node $ input "NewTx" ["transaction" .= tx] + confirmedTxValue <- waitMatch 10 node $ \v -> do + v <$ guard ( v ^? key "tag" == Just "SnapshotConfirmed") + + waitABit + putStrLnGreen "DEMO: Transaction confirmed! Here's the Hydra's response" + printJSON confirmedTxValue + + + + + + waitABit + + -- Let's build a second transaction, from Bob to Carol, of 1_012_345 lovelace + putStrLnGreen "DEMO: Let's build a second transaction, from Bob to Carol, of 1_012_345 lovelace" + + -- putStrLn $ "Writing passing_transaction_1.json to disk" + -- Aeson.encodeFile "passing_transaction_1.json" tx + + let bobUTxOSet = UTxO.filter (\(TxOut addr _ _ _) -> addr == mkVkAddress networkId bobCardanoVk) initialUtxo + + let (bobTxIns, bobTxOuts) = unzip $ UTxO.pairs bobUTxOSet + + let Right tx2 = do + let fee = Lovelace 0 + recipient = mkVkAddress networkId carolCardanoVk + sk = bobCardanoSk + + txins = bobTxIns + valueIn = foldMap (\(TxOut _ v _ _) -> v) bobTxOuts + owner = mkVkAddress networkId bobCardanoVk + refScript = ReferenceScriptNone + datum = TxOutDatumNone + + valueOut = lovelaceToValue 1_012_345 + + txOuts = + TxOut @CtxTx recipient valueOut TxOutDatumNone ReferenceScriptNone + : [ TxOut @CtxTx + owner + (valueIn <> negateValue valueOut) + (toTxContext datum) + refScript + | valueOut /= valueIn + ] + bodyContent = + emptyTxBody + { txIns = zip txins (repeat $ BuildTxWith $ KeyWitness KeyWitnessForSpending) + , txOuts + , txFee = TxFeeExplicit fee + } + + body <- createAndValidateTransactionBody bodyContent + let witnesses = [makeShelleyKeyWitness body (WitnessPaymentKey sk)] + pure $ makeSignedTransaction witnesses body + + waitABit + -- Here's our second transaction, from Bob to Carol + putStrLnGreen "DEMO: Here's our second transaction, from Bob to Carol" + printJSON tx2 + + send node $ input "NewTx" ["transaction" .= tx2] + + waitABit + -- Our confirmation of our second transaction, from Bob to Carol + putStrLnGreen "DEMO: Our confirmation of our second transaction, from Bob to Carol" + + nextSnapshotConfirmed <- waitMatch 10 node $ \v -> do + v <$ guard ( v ^? key "tag" == Just "SnapshotConfirmed") + + waitABit + -- Transaction confirmed! Here's the Hydra's response to our second transaction + putStrLnGreen "DEMO: Transaction confirmed! Here's the Hydra's response" + + printJSON nextSnapshotConfirmed + + waitABit + -- Now, some invalid transactions + putStrLnGreen "DEMO: Now, three invalid transactions, loaded from disk" + + let failDirectory = "tmp/example_transactions/should_fail" + transactions <- traverse + (Aeson.throwDecodeStrict @Tx <=< BS.readFile . (failDirectory )) + =<< listDirectory failDirectory + forM_ (take 3 transactions) $ \tx -> do + waitABit + + -- Here's the transaction we're trying to submit + putStrLnGreen "DEMO: Here's the invalid transaction we're trying to submit" + printJSON tx + send node $ input "NewTx" ["transaction" .= tx] + + + waitABit + -- Here's the response from the Hydra node + putStrLnGreen "DEMO: Here's the rejection from the Hydra node" + + response <- waitMatch 10 node $ \v -> do + v <$ guard ( v ^? key "tag" == Just "TxInvalid") + printJSON response + waitABit + + + putStrLnGreen "DEMO: All done :)" pure () + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 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/hydra-node.cabal b/hydra-node/hydra-node.cabal index 3d68aaa2481..2f381ca9bce 100644 --- a/hydra-node/hydra-node.cabal +++ b/hydra-node/hydra-node.cabal @@ -173,6 +173,8 @@ library , wai-websockets , warp , websockets + --FIXME: get rid of this test dependency before merging ! + , cardano-prelude-test ghc-options: -haddock From c730f271eac47e29b0a74715cdfefc7276c0ddca Mon Sep 17 00:00:00 2001 From: card Date: Fri, 15 Dec 2023 06:06:29 -0500 Subject: [PATCH 26/44] Revert "wip: temporary commit for demoing offline mode. Good for demo, do not merge as is" This reverts commit 6599c0a9e3437361395ea8dce8d167af9f32b852. --- hydra-cluster/test/Test/EndToEndSpec.hs | 265 +----------------------- hydra-node/hydra-node.cabal | 2 - 2 files changed, 8 insertions(+), 259 deletions(-) diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs index 73ccf2b7a1b..b47ff37d114 100644 --- a/hydra-cluster/test/Test/EndToEndSpec.hs +++ b/hydra-cluster/test/Test/EndToEndSpec.hs @@ -36,23 +36,6 @@ import Hydra.Cardano.Api ( signTx, pattern TxOut, pattern TxValidityLowerBound, - CtxTx, - txFee, - txIns, - txOuts, - makeSignedTransaction, - makeShelleyKeyWitness, - ShelleyWitnessSigningKey(..), - createAndValidateTransactionBody, - pattern TxFeeExplicit, - KeyWitnessInCtx (..), - pattern KeyWitness, - pattern BuildTxWith, - ToTxContext (toTxContext), - negateValue, - pattern TxOutDatumNone, - pattern ReferenceScriptNone, - Lovelace (..), ) import Hydra.Chain.Direct.State () import Hydra.Cluster.Faucet ( @@ -92,7 +75,7 @@ import Hydra.Cluster.Util (chainConfigFor, keysFor, offlineConfigFor) import Hydra.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod)) import Hydra.Crypto (generateSigningKey) import Hydra.Ledger (txId) -import Hydra.Ledger.Cardano (genKeyPair, mkRangedTx, mkSimpleTx, Tx, emptyTxBody) +import Hydra.Ledger.Cardano (genKeyPair, mkRangedTx, mkSimpleTx) import Hydra.Logging (Tracer, showLogsOnFailure) import Hydra.Options import Hydra.Party (deriveParty) @@ -112,13 +95,12 @@ import HydraNode ( withHydraNode', withOfflineHydraNode, ) -import System.Directory (removeDirectoryRecursive, listDirectory) +import System.Directory (removeDirectoryRecursive) import System.FilePath (()) import System.IO (hGetLine) import System.IO.Error (isEOFError) import Test.QuickCheck (generate) import Prelude qualified -import qualified Data.ByteString.Char8 as BS allNodeIds :: [Int] allNodeIds = [1 .. 3] @@ -134,263 +116,32 @@ withClusterTempDir name = spec :: Spec spec = around (showLogsOnFailure "EndToEndSpec") $ do it "End-to-end offline mode" $ \tracer -> do - withTempDir ("offline-mode-e2e") $ \tmpDir -> - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- Offline mode demo! - - do + withTempDir ("offline-mode-e2e") $ \tmpDir -> do let networkId = Testnet (NetworkMagic 42) -- from defaultChainConfig let startingState = [ (Alice, lovelaceToValue 100_000_000) , (Bob, lovelaceToValue 100_000_000) - , (Carol, lovelaceToValue 998_987_654) -- 999_999_999 - 1_012_345 ] - (aliceCardanoVk, aliceCardanoSk) <- keysFor Alice - (bobCardanoVk, bobCardanoSk) <- keysFor Bob - (carolCardanoVk, _carolCardanoSk) <- keysFor Carol + (bobCardanoVk, _) <- keysFor Bob offlineConfig <- offlineConfigFor startingState tmpDir networkId initialUtxo <- Aeson.throwDecodeStrict @UTxO.UTxO =<< readFileBS (initialUTxOFile offlineConfig) let Just (aliceSeedTxIn, aliceSeedTxOut) = UTxO.find (\(TxOut addr _ _ _) -> addr == mkVkAddress networkId aliceCardanoVk) initialUtxo - let putStrLnGreen s = do - putStrLn $ "\x1b[32m" <> replicate (length s + 6) '=' <> "\x1b[0m" - putStrLn $ "\x1b[32m" <> "|| " <> s <> " ||" <> "\x1b[0m" - putStrLn $ "\x1b[32m" <> replicate (length s + 6) '=' <> "\x1b[0m" - - let printJSON :: Aeson.ToJSON a => a -> IO () - printJSON = BS.putStrLn . toStrict . Aeson.encode - - let waitABit = void @IO $ threadDelay 30 - withOfflineHydraNode (contramap FromHydraNode tracer) offlineConfig tmpDir 0 aliceSk $ \node -> do - -- An offline Hydra node all booted up! - putStrLnGreen "DEMO: An offline Hydra node all booted up!" - - waitABit - - -- Let's build a simple transaction, from Alice to Bob, of 1_000_000 lovelace - putStrLnGreen "DEMO: Let's build a simple transaction, from Alice to Bob, of 1_000_000 lovelace" let Right tx = mkSimpleTx (aliceSeedTxIn, aliceSeedTxOut) - (mkVkAddress networkId bobCardanoVk, lovelaceToValue paymentFromAliceToBob) -- 1_000_000 + (mkVkAddress networkId bobCardanoVk, lovelaceToValue paymentFromAliceToBob) aliceCardanoSk - waitABit - -- Here's our first transaction, from Alice to bob - putStrLnGreen "DEMO: Here's our first transaction, from Alice to Bob" - - printJSON tx - send node $ input "NewTx" ["transaction" .= tx] - confirmedTxValue <- waitMatch 10 node $ \v -> do - v <$ guard ( v ^? key "tag" == Just "SnapshotConfirmed") - - waitABit - putStrLnGreen "DEMO: Transaction confirmed! Here's the Hydra's response" - printJSON confirmedTxValue - - - - - - waitABit - - -- Let's build a second transaction, from Bob to Carol, of 1_012_345 lovelace - putStrLnGreen "DEMO: Let's build a second transaction, from Bob to Carol, of 1_012_345 lovelace" - - -- putStrLn $ "Writing passing_transaction_1.json to disk" - -- Aeson.encodeFile "passing_transaction_1.json" tx - - let bobUTxOSet = UTxO.filter (\(TxOut addr _ _ _) -> addr == mkVkAddress networkId bobCardanoVk) initialUtxo - - let (bobTxIns, bobTxOuts) = unzip $ UTxO.pairs bobUTxOSet - - let Right tx2 = do - let fee = Lovelace 0 - recipient = mkVkAddress networkId carolCardanoVk - sk = bobCardanoSk - - txins = bobTxIns - valueIn = foldMap (\(TxOut _ v _ _) -> v) bobTxOuts - owner = mkVkAddress networkId bobCardanoVk - refScript = ReferenceScriptNone - datum = TxOutDatumNone - - valueOut = lovelaceToValue 1_012_345 - - txOuts = - TxOut @CtxTx recipient valueOut TxOutDatumNone ReferenceScriptNone - : [ TxOut @CtxTx - owner - (valueIn <> negateValue valueOut) - (toTxContext datum) - refScript - | valueOut /= valueIn - ] - bodyContent = - emptyTxBody - { txIns = zip txins (repeat $ BuildTxWith $ KeyWitness KeyWitnessForSpending) - , txOuts - , txFee = TxFeeExplicit fee - } - - body <- createAndValidateTransactionBody bodyContent - let witnesses = [makeShelleyKeyWitness body (WitnessPaymentKey sk)] - pure $ makeSignedTransaction witnesses body - - waitABit - -- Here's our second transaction, from Bob to Carol - putStrLnGreen "DEMO: Here's our second transaction, from Bob to Carol" - printJSON tx2 - - send node $ input "NewTx" ["transaction" .= tx2] - - waitABit - -- Our confirmation of our second transaction, from Bob to Carol - putStrLnGreen "DEMO: Our confirmation of our second transaction, from Bob to Carol" - - nextSnapshotConfirmed <- waitMatch 10 node $ \v -> do - v <$ guard ( v ^? key "tag" == Just "SnapshotConfirmed") - - waitABit - -- Transaction confirmed! Here's the Hydra's response to our second transaction - putStrLnGreen "DEMO: Transaction confirmed! Here's the Hydra's response" - - printJSON nextSnapshotConfirmed - - waitABit - -- Now, some invalid transactions - putStrLnGreen "DEMO: Now, three invalid transactions, loaded from disk" - - let failDirectory = "tmp/example_transactions/should_fail" - transactions <- traverse - (Aeson.throwDecodeStrict @Tx <=< BS.readFile . (failDirectory )) - =<< listDirectory failDirectory - forM_ (take 3 transactions) $ \tx -> do - waitABit - - -- Here's the transaction we're trying to submit - putStrLnGreen "DEMO: Here's the invalid transaction we're trying to submit" - printJSON tx - send node $ input "NewTx" ["transaction" .= tx] - - - waitABit - -- Here's the response from the Hydra node - putStrLnGreen "DEMO: Here's the rejection from the Hydra node" - - response <- waitMatch 10 node $ \v -> do - v <$ guard ( v ^? key "tag" == Just "TxInvalid") - printJSON response - waitABit - - - putStrLnGreen "DEMO: All done :)" - pure () - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + waitMatch 10 node $ \v -> do + guard $ v ^? key "tag" == Just "SnapshotConfirmed" + pure () describe "End-to-end on Cardano devnet" $ do describe "single party hydra head" $ do diff --git a/hydra-node/hydra-node.cabal b/hydra-node/hydra-node.cabal index 2f381ca9bce..3d68aaa2481 100644 --- a/hydra-node/hydra-node.cabal +++ b/hydra-node/hydra-node.cabal @@ -173,8 +173,6 @@ library , wai-websockets , warp , websockets - --FIXME: get rid of this test dependency before merging ! - , cardano-prelude-test ghc-options: -haddock From 2c2f4f9205f036d50fcfae5e08167957f0ae2dbe Mon Sep 17 00:00:00 2001 From: card Date: Fri, 15 Dec 2023 11:49:50 -0500 Subject: [PATCH 27/44] pr feedback --- .gitignore | 2 -- hydra-cluster/src/Hydra/Cluster/Util.hs | 7 ++----- hydra-cluster/src/HydraNode.hs | 6 ++---- 3 files changed, 4 insertions(+), 11 deletions(-) diff --git a/.gitignore b/.gitignore index a4ccac5fafa..669207c43ea 100644 --- a/.gitignore +++ b/.gitignore @@ -24,8 +24,6 @@ result* *.o test-results.xml hspec-results.md -hydra-node/golden/RunOptions.faulty.json -hydra-node/golden/RunOptions.faulty.reencoded.json # Benchmark results *.html diff --git a/hydra-cluster/src/Hydra/Cluster/Util.hs b/hydra-cluster/src/Hydra/Cluster/Util.hs index 6b5bc4ef177..3de5900e591 100644 --- a/hydra-cluster/src/Hydra/Cluster/Util.hs +++ b/hydra-cluster/src/Hydra/Cluster/Util.hs @@ -42,8 +42,6 @@ import System.FilePath ((<.>), ()) import Test.Hydra.Prelude (failure) import Test.QuickCheck (generate) --- import CardanoClient (buildAddress) - -- | Lookup a config file similar reading a file from disk. -- If the env variable `HYDRA_CONFIG_DIR` is set, filenames will be -- resolved relative to its value otherwise they will be looked up in the @@ -96,7 +94,6 @@ seedInitialUTxOFromOffline targetDir utxo = do let destinationPath = targetDir "utxo.json" writeFileBS destinationPath . toStrict . Aeson.encode $ utxo - -- Aeson.throwDecodeStrict =<< readFileBS (targetDir "utxo.json") pure destinationPath buildAddress :: VerificationKey PaymentKey -> NetworkId -> Address ShelleyAddr @@ -135,7 +132,7 @@ initialUtxoForActors actorToVal networkId = do 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 @@ -148,7 +145,7 @@ chainConfigFor me targetDir nodeSocket them cp = do { nodeSocket , cardanoSigningKey = skTarget me , cardanoVerificationKeys = [vkTarget himOrHer | himOrHer <- them] - , contestationPeriod = cp :: ContestationPeriod + , contestationPeriod } where skTarget x = targetDir skName x diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs index f19a8ec5e84..9a56e1202ff 100644 --- a/hydra-cluster/src/HydraNode.hs +++ b/hydra-cluster/src/HydraNode.hs @@ -423,11 +423,9 @@ withHydraNode' chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds h , hydraVerificationKeys , hydraScriptsTxId , persistenceDir = workDir "state-" <> show hydraNodeId - , -- , chainConfig = fromRight defaultChainConfig chainConfig - chainConfig + , chainConfig , ledgerConfig - , -- , offlineConfig = leftToMaybe chainConfig - offlineConfig = Nothing + , offlineConfig = Nothing } ) { std_out = maybe CreatePipe UseHandle mGivenStdOut From 65b2357d3cf8cb5dbc835b621b2e467cdf2a264b Mon Sep 17 00:00:00 2001 From: card Date: Fri, 15 Dec 2023 11:51:50 -0500 Subject: [PATCH 28/44] revert back to old port: see #1218 for macOS port bug --- hydra-cluster/src/HydraNode.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs index 9a56e1202ff..46292b7f897 100644 --- a/hydra-cluster/src/HydraNode.hs +++ b/hydra-cluster/src/HydraNode.hs @@ -329,8 +329,7 @@ withOfflineHydraNode' offlineConfig workDir hydraNodeId hydraSKey mGivenStdOut a { verbosity = Verbose "HydraNode" , nodeId = NodeId $ show hydraNodeId , host = "127.0.0.1" - , -- NOTE(Elaine): port 5000 is used on recent versions of macos - port = fromIntegral $ 5_100 + hydraNodeId + , port = fromIntegral $ 5_000 + hydraNodeId , peers , apiHost = "127.0.0.1" , apiPort = fromIntegral $ 4_000 + hydraNodeId @@ -414,7 +413,7 @@ withHydraNode' chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds h { verbosity = Verbose "HydraNode" , nodeId = NodeId $ show hydraNodeId , host = "127.0.0.1" - , port = fromIntegral $ 5_100 + hydraNodeId + , port = fromIntegral $ 5_000 + hydraNodeId , peers , apiHost = "127.0.0.1" , apiPort = fromIntegral $ 4_000 + hydraNodeId @@ -440,7 +439,7 @@ withHydraNode' chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds h peers = [ Host { Network.hostname = "127.0.0.1" - , Network.port = fromIntegral $ 5_100 + i + , Network.port = fromIntegral $ 5_000 + i } | i <- allNodeIds , i /= hydraNodeId From 510d4ef4ef6d79797b84f8d860febdbbe27bb774 Mon Sep 17 00:00:00 2001 From: card Date: Fri, 15 Dec 2023 11:55:39 -0500 Subject: [PATCH 29/44] more pr feedback --- hydra-node/src/Hydra/Node.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/hydra-node/src/Hydra/Node.hs b/hydra-node/src/Hydra/Node.hs index 73d54df3a05..9b8813915d4 100644 --- a/hydra-node/src/Hydra/Node.hs +++ b/hydra-node/src/Hydra/Node.hs @@ -77,10 +77,9 @@ initEnvironment options = do -- online mode Nothing -> readFileTextEnvelopeThrow (AsSigningKey AsPaymentKey) cardanoSigningKey -- offline mode - Just _ -> pure $ Hydra.Prelude.error "Shouldn't be using cardanoSigningKey in offline mode!" + Just _ -> die "Shouldn't be using cardanoSigningKey in offline mode!" otherVerificationKeys <- mapM (readFileTextEnvelopeThrow (AsVerificationKey AsPaymentKey)) cardanoVerificationKeys - -- let participants = [] let participants = case offlineConfig of Nothing -> verificationKeyToOnChainId <$> (getVerificationKey ownSigningKey : otherVerificationKeys) Just _ -> [] From 7f283aef57ab47d17ac58cc366a3dabf3ea35fc8 Mon Sep 17 00:00:00 2001 From: card Date: Fri, 15 Dec 2023 13:24:19 -0500 Subject: [PATCH 30/44] more feedback, undo error->die feedback due to introduced test failure --- cabal.project | 2 +- hydra-cluster/src/HydraNode.hs | 25 ++++- hydra-node/hydra-node.cabal | 1 - hydra-node/src/Hydra/Chain/Offline.hs | 90 +++++++++++++++++- .../src/Hydra/Chain/Offline/Handlers.hs | 2 - .../src/Hydra/Chain/Offline/Persistence.hs | 2 +- hydra-node/src/Hydra/Node.hs | 93 ++----------------- hydra-node/src/Hydra/Node/Run.hs | 4 +- hydra-node/test/Hydra/NodeSpec.hs | 2 +- 9 files changed, 116 insertions(+), 105 deletions(-) diff --git a/cabal.project b/cabal.project index ee8dd8b6264..faac256a994 100644 --- a/cabal.project +++ b/cabal.project @@ -35,7 +35,7 @@ package * -- Warnings as errors for local packages program-options - ghc-options: -Wwarn + ghc-options: -Werror -- Always build tests and benchmarks of local packages tests: True diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs index 46292b7f897..50aae0e0163 100644 --- a/hydra-cluster/src/HydraNode.hs +++ b/hydra-cluster/src/HydraNode.hs @@ -29,8 +29,9 @@ import Hydra.Options (ChainConfig (..), LedgerConfig (..), OfflineConfig, RunOpt 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) +import System.Directory (createDirectoryIfMissing) import System.FilePath ((<.>), ()) -import System.IO.Temp (withSystemTempDirectory, getCanonicalTemporaryDirectory) +import System.IO.Temp (withSystemTempDirectory, getCanonicalTemporaryDirectory ) import System.Process ( CreateProcess (..), ProcessHandle, @@ -40,7 +41,6 @@ import System.Process ( ) import Test.Hydra.Prelude (checkProcessHasNotDied, failAfter, failure, withLogFile) import Prelude qualified -import System.Directory (createDirectoryIfMissing) data HydraClient = HydraClient { hydraNodeId :: Int @@ -304,6 +304,20 @@ withOfflineHydraNode tracer offlineConfig workDir hydraNodeId hydraSKey action = where logFilePath = workDir "logs" "hydra-node-" <> show hydraNodeId <.> "log" +-- withPersistentDebguDirectory :: +-- Tracer IO HydraNodeLog -> +-- FilePath -> +-- Int -> +-- SigningKey HydraKey -> +-- (HydraClient -> IO a) -> +-- IO a +withPersistentDebugDirectory newDir action = do + systemTempDir <- getCanonicalTemporaryDirectory + let newPath = systemTempDir "hydra-node" + + + action newPath + withOfflineHydraNode' :: OfflineConfig -> FilePath -> @@ -314,7 +328,7 @@ withOfflineHydraNode' :: (Handle -> Handle -> ProcessHandle -> IO a) -> IO a withOfflineHydraNode' offlineConfig workDir hydraNodeId hydraSKey mGivenStdOut action = - withSystemTempDirectory "hydra-node-e2e" $ \dir -> do + withPersistentDebugDirectory "hydra-node-e2e" $ \dir -> do let cardanoLedgerProtocolParametersFile = dir "protocol-parameters.json" readConfigFile "protocol-parameters.json" >>= writeFileBS cardanoLedgerProtocolParametersFile let hydraSigningKey = dir (show hydraNodeId <> ".sk") @@ -324,7 +338,8 @@ withOfflineHydraNode' offlineConfig workDir hydraNodeId hydraSKey mGivenStdOut a { cardanoLedgerProtocolParametersFile } let p = - ( hydraNodeProcess $ + -- ( hydraNodeProcess $ + (hydraNodeProcess . (\x -> trace (show (toArgs x)) x) $ RunOptions { verbosity = Verbose "HydraNode" , nodeId = NodeId $ show hydraNodeId @@ -395,7 +410,7 @@ withHydraNode' :: (Handle -> ProcessHandle -> IO a) -> IO a withHydraNode' chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds hydraScriptsTxId mGivenStdOut action = do - withSystemTempDirectory "hydra-node" $ \dir -> do + withPersistentDebugDirectory "hydra-node" $ \dir -> do let cardanoLedgerProtocolParametersFile = dir "protocol-parameters.json" readConfigFile "protocol-parameters.json" >>= writeFileBS cardanoLedgerProtocolParametersFile let hydraSigningKey = dir (show hydraNodeId <> ".sk") diff --git a/hydra-node/hydra-node.cabal b/hydra-node/hydra-node.cabal index 3d68aaa2481..8834ea57bee 100644 --- a/hydra-node/hydra-node.cabal +++ b/hydra-node/hydra-node.cabal @@ -184,7 +184,6 @@ executable hydra-node , hydra-cardano-api , hydra-node , hydra-prelude - , base ghc-options: -threaded -rtsopts -with-rtsopts=-N4 diff --git a/hydra-node/src/Hydra/Chain/Offline.hs b/hydra-node/src/Hydra/Chain/Offline.hs index bd022b121bf..6546a483d1e 100644 --- a/hydra-node/src/Hydra/Chain/Offline.hs +++ b/hydra-node/src/Hydra/Chain/Offline.hs @@ -1,19 +1,22 @@ module Hydra.Chain.Offline ( withOfflineChain, + loadGlobalsFromGenesis, + loadState + ) where import Hydra.Prelude import Hydra.Chain.Offline.Handlers (mkFakeL1Chain) -import Hydra.Logging (Tracer) +import Hydra.Logging (Tracer, traceWith) import Hydra.Chain ( ChainComponent, ChainEvent (Tick), ChainStateHistory, chainSlot, - chainTime, + chainTime, IsChainState (ChainStateType), ) import Hydra.HeadId (HeadId) @@ -23,11 +26,13 @@ import Hydra.Chain.Direct.Handlers ( ) import Hydra.Ledger (ChainSlot (ChainSlot), IsTx (UTxOType)) -import Hydra.Ledger.Cardano.Configuration (readJsonFileThrow) +import Hydra.Ledger.Cardano.Configuration (readJsonFileThrow, newGlobals) import Hydra.Options (OfflineConfig (OfflineConfig, initialUTxOFile, ledgerGenesisFile)) import Cardano.Ledger.Shelley.API qualified as Ledger +import Cardano.Ledger.BaseTypes qualified as Ledger +import Cardano.Ledger.Crypto qualified as Ledger import Ouroboros.Consensus.HardFork.History (interpretQuery, mkInterpreter, neverForksSummary, slotToWallclock, wallclockToSlot) import Ouroboros.Consensus.HardFork.History qualified as Consensus @@ -45,14 +50,20 @@ import Ouroboros.Consensus.Util.Time (nominalDelay) import Hydra.Cardano.Api ( StandardCrypto, - Tx, + Tx, GenesisParameters (..), ShelleyEra, ) import Hydra.Chain.Offline.Persistence (initializeStateIfOffline) import Hydra.ContestationPeriod (ContestationPeriod) import Hydra.Party (Party) +import Hydra.Persistence (PersistenceIncremental(..)) +import Hydra.Node (HydraNodeLog (..)) +import Hydra.HeadLogic (StateChanged, IdleState (..), recoverChainStateHistory, recoverState, HeadState(Idle)) +import qualified Cardano.Ledger.Shelley.API as Shelley +import Hydra.Cardano.Api qualified as Shelley +import Hydra.Chain.Direct.Fixture (defaultGlobals) withOfflineChain :: - Tracer IO DirectChainLog -> -- TODO(ELAINE): change type to indicate offline mode maybe? + Tracer IO DirectChainLog -> OfflineConfig -> Ledger.Globals -> HeadId -> @@ -136,3 +147,72 @@ withOfflineChain tracer OfflineConfig{ledgerGenesisFile, initialUTxOFile} global case res of Left () -> error "'connectTo' cannot terminate but did?" Right a -> pure a + +-- | Load a 'HeadState' from persistence. +loadState :: + (MonadThrow m, IsChainState tx) => + Tracer m (HydraNodeLog tx) -> + PersistenceIncremental (StateChanged tx) m -> + ChainStateType tx -> + m (HeadState tx, ChainStateHistory tx) +loadState tracer persistence defaultChainState = do + events <- loadAll persistence + traceWith tracer LoadedState{numberOfEvents = fromIntegral $ length events} + let headState = recoverState initialState events + chainStateHistory = recoverChainStateHistory defaultChainState events + pure (headState, chainStateHistory) + where + initialState = Idle IdleState{chainState = defaultChainState} + +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 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 + } \ No newline at end of file diff --git a/hydra-node/src/Hydra/Chain/Offline/Handlers.hs b/hydra-node/src/Hydra/Chain/Offline/Handlers.hs index 60cb0f162c4..b3a30207d47 100644 --- a/hydra-node/src/Hydra/Chain/Offline/Handlers.hs +++ b/hydra-node/src/Hydra/Chain/Offline/Handlers.hs @@ -8,12 +8,10 @@ module Hydra.Chain.Offline.Handlers ( import Hydra.Chain ( Chain (Chain, draftCommitTx, postTx, submitTx), ChainEvent (Observation, newChainState, observedTx), - HeadParameters (HeadParameters), OnChainTx (..), PostChainTx (..), PostTxError (FailedToDraftTxNotInitializing), confirmedSnapshot, - contestationDeadline, snapshotNumber, ) import Hydra.Chain.Direct.Handlers (DirectChainLog (ToPost, toPost), LocalChainState, getLatest) diff --git a/hydra-node/src/Hydra/Chain/Offline/Persistence.hs b/hydra-node/src/Hydra/Chain/Offline/Persistence.hs index c0d6cc2ee35..b7fefcea672 100644 --- a/hydra-node/src/Hydra/Chain/Offline/Persistence.hs +++ b/hydra-node/src/Hydra/Chain/Offline/Persistence.hs @@ -22,7 +22,7 @@ import Hydra.Chain ( import Hydra.Chain.Direct.State (initialChainState) import Hydra.ContestationPeriod (ContestationPeriod) import Hydra.HeadId (HeadId, HeadSeed (UnsafeHeadSeed)) -import Hydra.HeadLogic (StateChanged (SnapshotConfirmed, snapshot), Environment (participants)) +import Hydra.HeadLogic (StateChanged (SnapshotConfirmed, snapshot)) import Hydra.Ledger (IsTx (UTxOType)) import Hydra.Party (Party) import Hydra.Persistence (PersistenceIncremental (PersistenceIncremental, append, loadAll), createPersistenceIncremental) diff --git a/hydra-node/src/Hydra/Node.hs b/hydra-node/src/Hydra/Node.hs index 9b8813915d4..105551e393b 100644 --- a/hydra-node/src/Hydra/Node.hs +++ b/hydra-node/src/Hydra/Node.hs @@ -10,10 +10,6 @@ module Hydra.Node where import Hydra.Prelude -import Cardano.Ledger.BaseTypes (Globals) -import Cardano.Ledger.BaseTypes qualified as Ledger -import Cardano.Ledger.Crypto qualified as Ledger -import Cardano.Ledger.Shelley.API qualified as Shelley import Control.Concurrent.Class.MonadSTM ( MonadLabelledSTM, labelTVarIO, @@ -22,17 +18,14 @@ import Control.Concurrent.Class.MonadSTM ( ) import Control.Monad.Trans.Writer (execWriter, tell) import Hydra.API.Server (Server, sendOutput) -import Hydra.Cardano.Api (AsType (AsPaymentKey, AsSigningKey, AsVerificationKey), GenesisParameters (..), ShelleyEra, StandardCrypto, SystemStart (..), getVerificationKey) -import Hydra.Cardano.Api qualified as Shelley +import Hydra.Cardano.Api (AsType (AsPaymentKey, AsSigningKey, AsVerificationKey), getVerificationKey) import Hydra.Chain ( Chain (..), - ChainStateHistory, ChainStateType, HeadParameters (..), IsChainState, PostTxError, ) -import Hydra.Chain.Direct.Fixture (defaultGlobals) import Hydra.Chain.Direct.Tx (verificationKeyToOnChainId) import Hydra.Chain.Direct.Util (readFileTextEnvelopeThrow) import Hydra.Crypto (AsType (AsHydraKey)) @@ -41,20 +34,15 @@ import Hydra.HeadLogic ( Environment (..), Event (..), HeadState (..), - IdleState (IdleState), Outcome (..), aggregateState, collectEffects, defaultTTL, - recoverChainStateHistory, - recoverState, ) import Hydra.HeadLogic qualified as Logic import Hydra.HeadLogic.Outcome (StateChanged (..)) import Hydra.HeadLogic.State (getHeadParameters) import Hydra.Ledger (IsTx (), Ledger) -import Hydra.Ledger.Cardano qualified as Ledger -import Hydra.Ledger.Cardano.Configuration (newGlobals, readJsonFileThrow) import Hydra.Logging (Tracer, traceWith) import Hydra.Network (Network (..)) import Hydra.Network.Message (Message) @@ -62,7 +50,7 @@ import Hydra.Node.EventQueue (EventQueue (..), Queued (..)) import Hydra.Node.ParameterMismatch (ParamMismatch (..), ParameterMismatch (..)) import Hydra.Options (ChainConfig (..), RunOptions (..)) import Hydra.Party (Party (..), deriveParty) -import Hydra.Persistence (PersistenceIncremental (..), loadAll) +import Hydra.Persistence (PersistenceIncremental (..), ) -- * Environment Handling @@ -73,13 +61,15 @@ 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. + + otherVerificationKeys <- mapM (readFileTextEnvelopeThrow (AsVerificationKey AsPaymentKey)) cardanoVerificationKeys ownSigningKey <- case offlineConfig of -- online mode Nothing -> readFileTextEnvelopeThrow (AsSigningKey AsPaymentKey) cardanoSigningKey -- offline mode - Just _ -> die "Shouldn't be using cardanoSigningKey in offline mode!" - - otherVerificationKeys <- mapM (readFileTextEnvelopeThrow (AsVerificationKey AsPaymentKey)) cardanoVerificationKeys + --Note: die doesn't work here because it gets forced immediately by the IO action + -- we can rewrite this to not have to have any error call, but the CLI refactor eliminates this anyway + Just _ -> pure $ Hydra.Prelude.error "Shouldn't be using cardanoSigningKey in offline mode!" let participants = case offlineConfig of Nothing -> verificationKeyToOnChainId <$> (getVerificationKey ownSigningKey : otherVerificationKeys) Just _ -> [] @@ -282,72 +272,3 @@ createNodeState initialState = do { modifyHeadState = stateTVar tv , queryHeadState = readTVar tv } - --- | Load a 'HeadState' from persistence. -loadState :: - (MonadThrow m, IsChainState tx) => - Tracer m (HydraNodeLog tx) -> - PersistenceIncremental (StateChanged tx) m -> - ChainStateType tx -> - m (HeadState tx, ChainStateHistory tx) -loadState tracer persistence defaultChainState = do - events <- loadAll persistence - traceWith tracer LoadedState{numberOfEvents = fromIntegral $ length events} - let headState = recoverState initialState events - chainStateHistory = recoverChainStateHistory defaultChainState events - pure (headState, chainStateHistory) - where - initialState = Idle IdleState{chainState = defaultChainState} - -loadGlobalsFromGenesis :: Maybe FilePath -> IO 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 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/Node/Run.hs b/hydra-node/src/Hydra/Node/Run.hs index e2a802b8eba..e4e1d535e42 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -21,7 +21,7 @@ import Hydra.Chain (maximumNumberOfParties) import Hydra.Chain.CardanoClient (QueryPoint (..), queryGenesisParameters) import Hydra.Chain.Direct (loadChainContext, mkTinyWallet, withDirectChain) import Hydra.Chain.Direct.State (initialChainState) -import Hydra.Chain.Offline (withOfflineChain) +import Hydra.Chain.Offline (withOfflineChain, loadGlobalsFromGenesis, loadState) import Hydra.HeadId (HeadId (..)) import Hydra.HeadLogic ( Environment (..), @@ -45,8 +45,6 @@ import Hydra.Node ( checkHeadState, createNodeState, initEnvironment, - loadGlobalsFromGenesis, - loadState, runHydraNode, ) import Hydra.Node.EventQueue (EventQueue (..), createEventQueue) diff --git a/hydra-node/test/Hydra/NodeSpec.hs b/hydra-node/test/Hydra/NodeSpec.hs index c93479256af..739bbdb6088 100644 --- a/hydra-node/test/Hydra/NodeSpec.hs +++ b/hydra-node/test/Hydra/NodeSpec.hs @@ -32,7 +32,6 @@ import Hydra.Node ( HydraNodeLog (..), checkHeadState, createNodeState, - loadState, stepHydraNode, ) import Hydra.Node.EventQueue (EventQueue (..), createEventQueue) @@ -41,6 +40,7 @@ import Hydra.Options (defaultContestationPeriod) import Hydra.Party (Party, deriveParty) import Hydra.Persistence (PersistenceIncremental (..)) import Test.Hydra.Fixture (alice, aliceSk, bob, bobSk, carol, carolSk, deriveOnChainId, testHeadId, testHeadSeed) +import Hydra.Chain.Offline (loadState) spec :: Spec spec = parallel $ do From e2438b395b67b089ec6175db743fda55a78021dd Mon Sep 17 00:00:00 2001 From: card Date: Fri, 15 Dec 2023 10:12:27 -0500 Subject: [PATCH 31/44] wip: separate top-level command and run(offline)options type. needs to have conflicts minimized, warnings and debug code removed. this'll get rebased --- hydra-cluster/src/HydraNode.hs | 42 +- hydra-node/exe/hydra-node/Main.hs | 10 +- hydra-node/hydra-node.cabal | 3 + hydra-node/src/Hydra/Logging/Messages.hs | 4 +- hydra-node/src/Hydra/Node.hs | 42 +- hydra-node/src/Hydra/Node/Run.hs | 96 ++- hydra-node/src/Hydra/Options.hs | 755 ++--------------------- hydra-node/src/Hydra/Options/Common.hs | 221 +++++++ hydra-node/src/Hydra/Options/Offline.hs | 209 +++++++ hydra-node/src/Hydra/Options/Online.hs | 463 ++++++++++++++ hydra-node/test/Hydra/Node/RunSpec.hs | 7 +- hydra-node/test/Hydra/OptionsSpec.hs | 4 +- 12 files changed, 1080 insertions(+), 776 deletions(-) create mode 100644 hydra-node/src/Hydra/Options/Common.hs create mode 100644 hydra-node/src/Hydra/Options/Offline.hs create mode 100644 hydra-node/src/Hydra/Options/Online.hs diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs index 50aae0e0163..2a2ebb7e30a 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 (..), OfflineConfig, RunOptions (..), defaultChainConfig, toArgs) +import Hydra.Options (ChainConfig (..), LedgerConfig (..), OfflineConfig, RunOptions (..), RunOfflineOptions (..)) +import Hydra.Options.Online qualified as OnlineOptions +import Hydra.Options.Offline qualified as OfflineOptions 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) @@ -265,7 +267,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 @@ -304,18 +306,9 @@ withOfflineHydraNode tracer offlineConfig workDir hydraNodeId hydraSKey action = where logFilePath = workDir "logs" "hydra-node-" <> show hydraNodeId <.> "log" --- withPersistentDebguDirectory :: --- Tracer IO HydraNodeLog -> --- FilePath -> --- Int -> --- SigningKey HydraKey -> --- (HydraClient -> IO a) -> --- IO a withPersistentDebugDirectory newDir action = do systemTempDir <- getCanonicalTemporaryDirectory let newPath = systemTempDir "hydra-node" - - action newPath withOfflineHydraNode' :: @@ -328,7 +321,7 @@ withOfflineHydraNode' :: (Handle -> Handle -> ProcessHandle -> IO a) -> IO a withOfflineHydraNode' offlineConfig workDir hydraNodeId hydraSKey mGivenStdOut action = - withPersistentDebugDirectory "hydra-node-e2e" $ \dir -> do + withSystemTempDirectory "hydra-node-e2e" $ \dir -> do let cardanoLedgerProtocolParametersFile = dir "protocol-parameters.json" readConfigFile "protocol-parameters.json" >>= writeFileBS cardanoLedgerProtocolParametersFile let hydraSigningKey = dir (show hydraNodeId <> ".sk") @@ -338,24 +331,21 @@ withOfflineHydraNode' offlineConfig workDir hydraNodeId hydraSKey mGivenStdOut a { cardanoLedgerProtocolParametersFile } let p = - -- ( hydraNodeProcess $ - (hydraNodeProcess . (\x -> trace (show (toArgs x)) x) $ - RunOptions + -- ( hydraNodeOfflineProcess $ + (hydraNodeOfflineProcess {-. (\x -> trace (show (toArgs x)) x)-} $ + RunOfflineOptions { verbosity = Verbose "HydraNode" - , nodeId = NodeId $ show hydraNodeId , host = "127.0.0.1" - , port = fromIntegral $ 5_000 + hydraNodeId - , peers + , -- NOTE(Elaine): port 5000 is used on recent versions of macos + port = fromIntegral $ 5_100 + hydraNodeId , apiHost = "127.0.0.1" , apiPort = fromIntegral $ 4_000 + hydraNodeId , monitoringPort = Just $ fromIntegral $ 6_000 + hydraNodeId , hydraSigningKey , hydraVerificationKeys = [] - , hydraScriptsTxId = "9fdc525c20bc00d9dfa9d14904b65e01910c0dfe3bb39865523c1e20eaeb0903" , persistenceDir = workDir "state-" <> show hydraNodeId - , chainConfig = defaultChainConfig , ledgerConfig - , offlineConfig = Just offlineConfig + , offlineConfig } ) { std_out = maybe CreatePipe UseHandle mGivenStdOut @@ -367,7 +357,6 @@ withOfflineHydraNode' offlineConfig workDir hydraNodeId hydraSKey mGivenStdOut a (Nothing, Just out, Just err) -> action out err processHandle (_, _, _) -> error "Should not happen™" where - peers = [] -- | Run a hydra-node with given 'ChainConfig' and using the config from -- config/. @@ -410,7 +399,7 @@ withHydraNode' :: (Handle -> ProcessHandle -> IO a) -> IO a withHydraNode' chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds hydraScriptsTxId mGivenStdOut action = do - withPersistentDebugDirectory "hydra-node" $ \dir -> do + withSystemTempDirectory "hydra-node" $ \dir -> do let cardanoLedgerProtocolParametersFile = dir "protocol-parameters.json" readConfigFile "protocol-parameters.json" >>= writeFileBS cardanoLedgerProtocolParametersFile let hydraSigningKey = dir (show hydraNodeId <> ".sk") @@ -424,6 +413,7 @@ withHydraNode' chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds h } let p = ( hydraNodeProcess $ + -- ( hydraNodeProcess . (\x-> trace ( "ARGS DUMP:" <> show (OnlineOptions.toArgs x) ) x)$ RunOptions { verbosity = Verbose "HydraNode" , nodeId = NodeId $ show hydraNodeId @@ -439,7 +429,6 @@ withHydraNode' chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds h , persistenceDir = workDir "state-" <> show hydraNodeId , chainConfig , ledgerConfig - , offlineConfig = Nothing } ) { std_out = maybe CreatePipe UseHandle mGivenStdOut @@ -481,7 +470,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-node/exe/hydra-node/Main.hs b/hydra-node/exe/hydra-node/Main.hs index 6ed42044d63..e7cfcba88f2 100644 --- a/hydra-node/exe/hydra-node/Main.hs +++ b/hydra-node/exe/hydra-node/Main.hs @@ -10,13 +10,15 @@ 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 (..), + RunOfflineOptions (..), parseHydraCommand, ) +import Hydra.Options.Online qualified as OnlineOptions import Hydra.Utils (genHydraKeys) main :: IO () @@ -25,6 +27,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 +41,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/hydra-node.cabal b/hydra-node/hydra-node.cabal index 8834ea57bee..bd3bbfdb12a 100644 --- a/hydra-node/hydra-node.cabal +++ b/hydra-node/hydra-node.cabal @@ -102,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/src/Hydra/Logging/Messages.hs b/hydra-node/src/Hydra/Logging/Messages.hs index 47cf23a0215..52305404798 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 (RunOptions, RunOfflineOptions) +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 105551e393b..bfcb22a2473 100644 --- a/hydra-node/src/Hydra/Node.hs +++ b/hydra-node/src/Hydra/Node.hs @@ -48,7 +48,8 @@ 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 (..), RunOptions (..), RunOfflineOptions (..), defaultContestationPeriod) +import Hydra.Options.Offline qualified as OfflineOptions import Hydra.Party (Party (..), deriveParty) import Hydra.Persistence (PersistenceIncremental (..), ) @@ -61,18 +62,11 @@ 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. - + + otherVerificationKeys <- mapM (readFileTextEnvelopeThrow (AsVerificationKey AsPaymentKey)) cardanoVerificationKeys + ownSigningKey <- readFileTextEnvelopeThrow (AsSigningKey AsPaymentKey) cardanoSigningKey otherVerificationKeys <- mapM (readFileTextEnvelopeThrow (AsVerificationKey AsPaymentKey)) cardanoVerificationKeys - ownSigningKey <- case offlineConfig of - -- online mode - Nothing -> readFileTextEnvelopeThrow (AsSigningKey AsPaymentKey) cardanoSigningKey - -- offline mode - --Note: die doesn't work here because it gets forced immediately by the IO action - -- we can rewrite this to not have to have any error call, but the CLI refactor eliminates this anyway - Just _ -> pure $ Hydra.Prelude.error "Shouldn't be using cardanoSigningKey in offline mode!" - let participants = case offlineConfig of - Nothing -> verificationKeyToOnChainId <$> (getVerificationKey ownSigningKey : otherVerificationKeys) - Just _ -> [] + let participants = verificationKeyToOnChainId <$> (getVerificationKey ownSigningKey : otherVerificationKeys) pure $ Environment { party = deriveParty sk @@ -88,7 +82,6 @@ initEnvironment options = do RunOptions { hydraSigningKey , hydraVerificationKeys - , offlineConfig , chainConfig = DirectChainConfig { contestationPeriod @@ -97,6 +90,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 e4e1d535e42..bc692a62b70 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -45,6 +45,7 @@ import Hydra.Node ( checkHeadState, createNodeState, initEnvironment, + initEnvironmentOffline, runHydraNode, ) import Hydra.Node.EventQueue (EventQueue (..), createEventQueue) @@ -55,9 +56,14 @@ import Hydra.Options ( LedgerConfig (..), OfflineConfig (OfflineConfig, ledgerGenesisFile), RunOptions (..), - validateRunOptions, + RunOfflineOptions (..), + validateRunOptions ) +import Hydra.Options.Offline qualified as OfflineOptions +import Hydra.Options.Online qualified as OnlineOptions import Hydra.Persistence (createPersistenceIncremental) +import Hydra.Network (NodeId(NodeId)) + data ConfigurationException = ConfigurationException ProtocolParametersConversionError @@ -74,10 +80,72 @@ 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 + -- let DirectChainConfig{networkId, nodeSocket} = chainConfig + + 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 - let RunOptions{verbosity, monitoringPort, persistenceDir, offlineConfig} = opts + let RunOptions{verbosity, monitoringPort, persistenceDir} = opts env@Environment{party, otherParties, signingKey, contestationPeriod} <- initEnvironment opts withTracer verbosity $ \tracer' -> withMonitoring monitoringPort tracer' $ \tracer -> do @@ -88,20 +156,10 @@ run opts = do pparams <- case toLedgerPParams ShelleyBasedEraBabbage protocolParams of Left err -> throwIO (ConfigurationException err) Right bpparams -> pure bpparams - let onlineOrOfflineConfig = case offlineConfig of - Nothing -> Right chainConfig - Just offlineConfig' -> Left offlineConfig' let DirectChainConfig{networkId, nodeSocket} = chainConfig - globals <- case offlineConfig of - Nothing -> do - -- online - globals' <- newGlobals =<< queryGenesisParameters networkId nodeSocket QueryTip - pure globals' - Just OfflineConfig{ledgerGenesisFile} -> do - -- offline - loadGlobalsFromGenesis ledgerGenesisFile + globals <- newGlobals =<< queryGenesisParameters networkId nodeSocket QueryTip withCardanoLedger pparams globals $ \ledger -> do persistence <- createPersistenceIncremental $ persistenceDir <> "/state" @@ -110,14 +168,10 @@ run opts = do checkHeadState (contramap Node tracer) env hs nodeState <- createNodeState hs -- Chain - let withChain cont = case onlineOrOfflineConfig of - Left offlineConfig' -> - let headId = UnsafeHeadId "HeadId" - in withOfflineChain (contramap DirectChain tracer) offlineConfig' globals headId party contestationPeriod chainStateHistory (putEvent . OnChainEvent) cont - Right onlineConfig -> do + let withChain cont = do ctx <- loadChainContext chainConfig party hydraScriptsTxId - wallet <- mkTinyWallet (contramap DirectChain tracer) onlineConfig - withDirectChain (contramap DirectChain tracer) onlineConfig ctx wallet chainStateHistory (putEvent . OnChainEvent) cont + 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 @@ -150,7 +204,7 @@ run opts = do 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 -- TODO: export from cardano-api diff --git a/hydra-node/src/Hydra/Options.hs b/hydra-node/src/Hydra/Options.hs index 2bafd24e7db..c0a39fd780e 100644 --- a/hydra-node/src/Hydra/Options.hs +++ b/hydra-node/src/Hydra/Options.hs @@ -3,6 +3,9 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Hydra.Options ( +module Hydra.Options.Common, + module Hydra.Options.Offline, + module Hydra.Options.Online, module Hydra.Options, ParserResult (..), renderFailure, @@ -10,47 +13,62 @@ 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 ( + LedgerConfig(..), + InvalidOptions(..), + defaultLedgerConfig, + ledgerConfigParser, + hydraVerificationKeyFileParser, + hydraSigningKeyFileParser, + cardanoVerificationKeyFileParser, + verbosityParser, + hostParser, + portParser, + apiHostParser, + apiPortParser, + monitoringPortParser, + persistenceDirParser, + genChainPoint, + genFilePath, + genDirPath + ) +import Hydra.Options.Offline ( + RunOfflineOptions (..), + OfflineConfig (..), + validateRunOfflineOptions, + defaultOfflineConfig, + offlineOptionsParser, + runOfflineOptionsParser, + ) +import Hydra.Options.Online ( + ChainConfig(..), + RunOptions(..), + validateRunOptions, + defaultContestationPeriod, + runOptionsParser, + networkIdParser, + nodeSocketParser, + cardanoSigningKeyFileParser, + defaultChainConfig, + startChainFromParser, + toArgNetworkId + ) +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, @@ -60,27 +78,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) @@ -89,6 +101,7 @@ commandParser :: Parser Command commandParser = asum [ Run <$> runOptionsParser + , RunOffline <$> runOfflineOptionsParser , Publish <$> publishScriptsParser , GenHydraKey <$> genHydraKeyParser ] @@ -137,168 +150,6 @@ publishOptionsParser = <*> nodeSocketParser <*> cardanoSigningKeyFileParser -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." - ) - -data OfflineUTxOWriteBackConfig = WriteBackToInitialUTxO | WriteBackToUTxOFile FilePath - deriving (Eq, Show, Generic, FromJSON, ToJSON) - -data OfflineConfig = OfflineConfig - { initialUTxOFile :: FilePath - , ledgerGenesisFile :: Maybe FilePath - } - deriving (Eq, Show, Generic, FromJSON, ToJSON) - -defaultOfflineConfig :: OfflineConfig -defaultOfflineConfig = - OfflineConfig - { initialUTxOFile = "utxo.json" - , ledgerGenesisFile = Nothing - } - -offlineUTxOWriteBackOptionsParser :: Parser (Maybe OfflineUTxOWriteBackConfig) -offlineUTxOWriteBackOptionsParser = - optional $ - asum - [ WriteBackToUTxOFile - <$> option - str - ( long "write-back-to-utxo-file" - <> metavar "FILE" - <> help "Write back to given UTxO file." - ) - , flag' - WriteBackToInitialUTxO - ( long "write-back-to-initial-utxo" - <> help "Write back to initial UTxO file." - ) - ] - -offlineOptionsParser :: Parser OfflineConfig -offlineOptionsParser = - subparser . command "offline" $ - info - ( OfflineConfig - <$> initialUTxOFileParser - <*> ledgerGenesisFileParser - ) - (progDesc "Run Hydra in offline mode") - -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 - , offlineConfig :: Maybe OfflineConfig - } - 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 - , offlineConfig = Nothing - } - - shrink = genericShrink - --- FIXME(Elaine): this instance doesn't do stuff correctly but was necessary during rebasing -instance Arbitrary OfflineConfig where - arbitrary = do - ledgerGenesisFile <- oneof [pure Nothing, Just <$> genFilePath "ledgerGenesis"] - initialUTxOFile <- genFilePath "utxo.json" - - pure $ - OfflineConfig - { initialUTxOFile - , ledgerGenesisFile - } - - shrink = genericShrink - -runOptionsParser :: Parser RunOptions -runOptionsParser = - RunOptions - <$> verbosityParser - <*> nodeIdParser - <*> hostParser - <*> portParser - <*> many peerParser - <*> apiHostParser - <*> apiPortParser - <*> optional monitoringPortParser - <*> hydraSigningKeyFileParser - <*> many hydraVerificationKeyFileParser - <*> hydraScriptsTxIdParser - <*> persistenceDirParser - <*> chainConfigParser - <*> ledgerConfigParser - <*> optional offlineOptionsParser - newtype GenerateKeyPair = GenerateKeyPair { outputFile :: FilePath } @@ -324,338 +175,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' = OfflineChainConfig' OfflineConfig | DirectChainConfig' ChainConfig - deriving stock (Eq, Show, Generic) - deriving anyclass (ToJSON, FromJSON) - -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." - ) - -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 = @@ -690,57 +209,7 @@ 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 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, offlineConfig} - | numberOfOtherParties + 1 > maximumNumberOfParties = Left MaximumNumberOfPartiesExceeded - | isJust offlineConfig && numberOfOtherParties > 0 = 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 @@ -750,134 +219,4 @@ parseHydraCommand = getArgs <&> parseHydraCommandFromArgs >>= handleParseResult 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 - , offlineConfig - } = - 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 - <> argsOfflineConfig - 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 - - argsOfflineConfig = case offlineConfig of - Nothing -> [] - Just OfflineConfig{initialUTxOFile, ledgerGenesisFile} -> - ["offline"] - <> ["--initial-utxo", initialUTxOFile] - <> maybe [] (\s -> ["--ledger-genesis", s]) ledgerGenesisFile - -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 - , offlineConfig = Nothing - } - 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..af9ccb37032 --- /dev/null +++ b/hydra-node/src/Hydra/Options/Common.hs @@ -0,0 +1,221 @@ +{-# OPTIONS_GHC -Wno-orphans #-} +module Hydra.Options.Common ( + module Hydra.Options.Common, + ) where + +import Hydra.Prelude +import Hydra.Cardano.Api ( + ChainPoint (..), + SlotNo (..), + deserialiseFromRawBytes, + proxyToAsType, + ) + +import Hydra.Chain (maximumNumberOfParties) +import Hydra.Logging (Verbosity (..)) +import Hydra.Network (Host, NodeId (NodeId), PortNumber, readHost, readPort) +import Hydra.Ledger.Cardano () + +import Data.IP ( IP (IPv4), toIPv4, toIPv4w ) +import Data.ByteString qualified as BS +import Options.Applicative ( + Parser, + ParserInfo, + ParserResult (..), + short, + long, + flag, + auto, + value, + option, + str, + strOption, + metavar, + maybeReader, + showDefault, + help + ) + +import Test.QuickCheck (elements, listOf, listOf1, oneof, suchThat, 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..d42c6f83439 --- /dev/null +++ b/hydra-node/src/Hydra/Options/Offline.hs @@ -0,0 +1,209 @@ +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# OPTIONS_GHC -Wno-orphans #-} + + +module Hydra.Options.Offline ( + module Hydra.Options.Offline, +) where + +import Hydra.Prelude + +import Hydra.Logging (Verbosity (..)) +import Hydra.Network (PortNumber) +import Hydra.Options.Common ( + LedgerConfig(..), + InvalidOptions(MaximumNumberOfPartiesExceeded), + hydraSigningKeyFileParser, + hydraVerificationKeyFileParser, + ledgerConfigParser, + monitoringPortParser, + persistenceDirParser, + portParser, + verbosityParser, + hostParser, InvalidOptions, genFilePath, genDirPath, apiHostParser, apiPortParser, + ) + +import Data.IP ( IP(..) ) +import Options.Applicative ( + Parser, + long, + str, + option, + progDesc, + info, + value, + subparser, + command, + showDefault, + metavar, + help, + ) +import Test.QuickCheck.Gen (elements, oneof) +import Test.QuickCheck (listOf) +import Hydra.Cardano.Api.Prelude +import Options.Applicative.Extra (helper) + +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) + +-- FIXME(Elaine): this instance doesn't do stuff correctly but was necessary during rebasing +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..f3e24a042a9 --- /dev/null +++ b/hydra-node/src/Hydra/Options/Online.hs @@ -0,0 +1,463 @@ +module Hydra.Options.Online ( + module Hydra.Options.Online + ) where + +import Hydra.Prelude +import Hydra.Cardano.Api ( + ChainPoint (..), + SocketPath, + NetworkId (Testnet, Mainnet), + NetworkMagic (NetworkMagic), + SlotNo (..), + File (..), + AsType (..), + TxId(..), + deserialiseFromRawBytesHex, + HasTypeProxy (proxyToAsType), serialiseToRawBytesHexText, + ) +import Hydra.ContestationPeriod (ContestationPeriod (..)) + +import Hydra.Options.Common ( + cardanoVerificationKeyFileParser, + genFilePath, + defaultLedgerConfig, + genChainPoint, LedgerConfig (..), verbosityParser, hostParser, portParser, apiHostParser, apiPortParser, monitoringPortParser, hydraSigningKeyFileParser, hydraVerificationKeyFileParser, persistenceDirParser, ledgerConfigParser, genDirPath, InvalidOptions (..), + ) + +import Options.Applicative ( + Parser, + auto, + completer, + eitherReader, + flag', + help, + listCompleter, + long, + maybeReader, + metavar, + option, + short, + showDefault, + strOption, + value, + ) + + +import Hydra.Network (Host, NodeId (NodeId), readHost, PortNumber) +import Hydra.Ledger.Cardano () +import Hydra.Chain (maximumNumberOfParties) +import Hydra.Logging (Verbosity (..)) + +import Data.Text qualified as T +import Data.Text (unpack) +import Data.Time.Clock (nominalDiffTimeToSeconds) +import Data.IP (IP (IPv4), toIPv4) +import Options.Applicative.Builder (str) +import qualified Data.ByteString.Char8 as BSC +import Control.Arrow (left) + +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 6f677edf3d6..9ddc9a1fd21 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 From b4d21c4dabbe72119a9014f26d2c2d0e09038f4b Mon Sep 17 00:00:00 2001 From: rrruko Date: Fri, 15 Dec 2023 11:43:18 -0800 Subject: [PATCH 32/44] add to changelog Co-authored-by: card --- CHANGELOG.md | 6 ++++++ 1 file changed, 6 insertions(+) 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 From a892dd362582128aa55d8563dff98b863b3ef922 Mon Sep 17 00:00:00 2001 From: rrruko Date: Fri, 15 Dec 2023 11:57:51 -0800 Subject: [PATCH 33/44] randomize utxo in offline test Co-authored-by: card --- hydra-cluster/test/Test/EndToEndSpec.hs | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs index b47ff37d114..52528eedd23 100644 --- a/hydra-cluster/test/Test/EndToEndSpec.hs +++ b/hydra-cluster/test/Test/EndToEndSpec.hs @@ -75,7 +75,7 @@ import Hydra.Cluster.Util (chainConfigFor, keysFor, offlineConfigFor) 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) @@ -124,9 +124,16 @@ spec = around (showLogsOnFailure "EndToEndSpec") $ do ] (aliceCardanoVk, aliceCardanoSk) <- keysFor Alice (bobCardanoVk, _) <- keysFor Bob - offlineConfig <- offlineConfigFor startingState tmpDir networkId + 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 + } - initialUtxo <- Aeson.throwDecodeStrict @UTxO.UTxO =<< readFileBS (initialUTxOFile offlineConfig) let Just (aliceSeedTxIn, aliceSeedTxOut) = UTxO.find (\(TxOut addr _ _ _) -> addr == mkVkAddress networkId aliceCardanoVk) initialUtxo withOfflineHydraNode (contramap FromHydraNode tracer) offlineConfig tmpDir 0 aliceSk $ \node -> do From 266fc0a1a81034e5b82c4ce34c9e2e292195c318 Mon Sep 17 00:00:00 2001 From: rrruko Date: Fri, 15 Dec 2023 11:58:54 -0800 Subject: [PATCH 34/44] remove dead code Co-authored-by: card --- hydra-cluster/test/Test/EndToEndSpec.hs | 2 -- hydra-node/src/Hydra/Chain.hs | 2 -- .../src/Hydra/Chain/Offline/Persistence.hs | 25 ++----------------- 3 files changed, 2 insertions(+), 27 deletions(-) diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs index 52528eedd23..2413b9dae18 100644 --- a/hydra-cluster/test/Test/EndToEndSpec.hs +++ b/hydra-cluster/test/Test/EndToEndSpec.hs @@ -148,8 +148,6 @@ spec = around (showLogsOnFailure "EndToEndSpec") $ do waitMatch 10 node $ \v -> do guard $ v ^? key "tag" == Just "SnapshotConfirmed" - pure () - 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/src/Hydra/Chain.hs b/hydra-node/src/Hydra/Chain.hs index ee544446d83..8e9a9d7ecdc 100644 --- a/hydra-node/src/Hydra/Chain.hs +++ b/hydra-node/src/Hydra/Chain.hs @@ -147,8 +147,6 @@ data PostTxError tx CommittedTooMuchADAForMainnet {userCommittedLovelace :: Lovelace, mainnetLimitLovelace :: Lovelace} | -- | We can only draft commit tx for the user when in Initializing state FailedToDraftTxNotInitializing - | -- | We cannot draft a commit tx in offline mode - FailedToDraftTxOffline | -- | Committing UTxO addressed to the internal wallet is forbidden. SpendingNodeUtxoForbidden | FailedToConstructAbortTx diff --git a/hydra-node/src/Hydra/Chain/Offline/Persistence.hs b/hydra-node/src/Hydra/Chain/Offline/Persistence.hs index b7fefcea672..ddaa878c963 100644 --- a/hydra-node/src/Hydra/Chain/Offline/Persistence.hs +++ b/hydra-node/src/Hydra/Chain/Offline/Persistence.hs @@ -2,7 +2,6 @@ module Hydra.Chain.Offline.Persistence ( initializeStateIfOffline, - createPersistenceWithUTxOWriteBack, ) where import Hydra.Prelude @@ -49,8 +48,8 @@ initializeStateIfOffline chainStateHistory initialUTxO ownHeadId ownParty contes OnInitTx { headId = ownHeadId , headParameters = HeadParameters{parties = [ownParty], contestationPeriod} - , headSeed = UnsafeHeadSeed "OfflineHeadSeed_" -- FIXME(Elaine): might want to generate? - , participants = []-- error "Participants unimplemented!" -- FIXME(Elaine): might want to make arbitrary / garbage 28 byte value + , headSeed = UnsafeHeadSeed "OfflineHeadSeed_" + , participants = [] } } @@ -66,23 +65,3 @@ initializeStateIfOffline chainStateHistory initialUTxO ownHeadId ownParty contes , headId = ownHeadId } } - -createPersistenceWithUTxOWriteBack :: - (MonadIO m, MonadThrow m) => - -- The filepath to write the main state change event persistence to - FilePath -> - -- The filepath to write UTxO to. UTxO is written after every confirmed snapshot. - FilePath -> - m (PersistenceIncremental (StateChanged Tx) m) -createPersistenceWithUTxOWriteBack persistenceFilePath utxoFilePath = do - PersistenceIncremental{append, loadAll} <- createPersistenceIncremental persistenceFilePath - pure - PersistenceIncremental - { loadAll - , append = \stateChange -> do - append stateChange - case stateChange of - SnapshotConfirmed{snapshot = Snapshot{utxo}} -> - writeBinaryFileDurableAtomic utxoFilePath . toStrict $ Aeson.encode utxo - _ -> pure () - } From b860d64bb9b464e93e709f6e1cc9f248be27d313 Mon Sep 17 00:00:00 2001 From: rrruko Date: Fri, 15 Dec 2023 12:24:28 -0800 Subject: [PATCH 35/44] remove TODOs Co-authored-by: card --- hydra-cluster/src/HydraNode.hs | 7 ++----- hydra-node/src/Hydra/Chain/Offline/Handlers.hs | 3 +-- hydra-node/src/Hydra/Chain/Offline/Persistence.hs | 2 -- hydra-node/src/Hydra/Options/Offline.hs | 1 - 4 files changed, 3 insertions(+), 10 deletions(-) diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs index 2a2ebb7e30a..e9545bcde2c 100644 --- a/hydra-cluster/src/HydraNode.hs +++ b/hydra-cluster/src/HydraNode.hs @@ -331,13 +331,11 @@ withOfflineHydraNode' offlineConfig workDir hydraNodeId hydraSKey mGivenStdOut a { cardanoLedgerProtocolParametersFile } let p = - -- ( hydraNodeOfflineProcess $ - (hydraNodeOfflineProcess {-. (\x -> trace (show (toArgs x)) x)-} $ + (hydraNodeOfflineProcess $ RunOfflineOptions { verbosity = Verbose "HydraNode" , host = "127.0.0.1" - , -- NOTE(Elaine): port 5000 is used on recent versions of macos - port = fromIntegral $ 5_100 + hydraNodeId + , port = fromIntegral $ 5_000 + hydraNodeId , apiHost = "127.0.0.1" , apiPort = fromIntegral $ 4_000 + hydraNodeId , monitoringPort = Just $ fromIntegral $ 6_000 + hydraNodeId @@ -413,7 +411,6 @@ withHydraNode' chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds h } let p = ( hydraNodeProcess $ - -- ( hydraNodeProcess . (\x-> trace ( "ARGS DUMP:" <> show (OnlineOptions.toArgs x) ) x)$ RunOptions { verbosity = Verbose "HydraNode" , nodeId = NodeId $ show hydraNodeId diff --git a/hydra-node/src/Hydra/Chain/Offline/Handlers.hs b/hydra-node/src/Hydra/Chain/Offline/Handlers.hs index b3a30207d47..c0cbe3aeb0e 100644 --- a/hydra-node/src/Hydra/Chain/Offline/Handlers.hs +++ b/hydra-node/src/Hydra/Chain/Offline/Handlers.hs @@ -43,8 +43,7 @@ mkFakeL1Chain contestationPeriod localChainState tracer ownHeadId callback = headSeed = offlineHeadSeed _ <- case tx of InitTx{headParameters} -> - callback $ Observation{newChainState = cst, observedTx = OnInitTx{headId, headParameters, headSeed, participants = []}} - -- FIXME(Elaine): might want to make participants nonempty, a singleton list of just some random 28 byte garbage + callback $ Observation{newChainState = cst, observedTx = OnInitTx{headId, headParameters, headSeed, participants = []}} AbortTx{} -> callback $ Observation{newChainState = cst, observedTx = OnAbortTx{headId}} CollectComTx{} -> diff --git a/hydra-node/src/Hydra/Chain/Offline/Persistence.hs b/hydra-node/src/Hydra/Chain/Offline/Persistence.hs index ddaa878c963..f034c904b04 100644 --- a/hydra-node/src/Hydra/Chain/Offline/Persistence.hs +++ b/hydra-node/src/Hydra/Chain/Offline/Persistence.hs @@ -53,8 +53,6 @@ initializeStateIfOffline chainStateHistory initialUTxO ownHeadId ownParty contes } } - -- NOTE(Elaine): should be no need to update the chain state, that's L1, there's nothing relevant there - -- observation events are to construct the L2 we want, with the initial utxo callback $ Observation { newChainState = initialChainState diff --git a/hydra-node/src/Hydra/Options/Offline.hs b/hydra-node/src/Hydra/Options/Offline.hs index d42c6f83439..dd39a1bb4bd 100644 --- a/hydra-node/src/Hydra/Options/Offline.hs +++ b/hydra-node/src/Hydra/Options/Offline.hs @@ -107,7 +107,6 @@ toArgs ["--initial-utxo", initialUTxOFile offlineConfig] <> maybe [] (\s -> ["--ledger-genesis", s]) (ledgerGenesisFile offlineConfig) --- FIXME(Elaine): this instance doesn't do stuff correctly but was necessary during rebasing instance Arbitrary OfflineConfig where arbitrary = do ledgerGenesisFile <- oneof [pure Nothing, Just <$> genFilePath "ledgerGenesis"] From f0a8489aadb90c2cb51401e598b4642fbde3f54c Mon Sep 17 00:00:00 2001 From: rrruko Date: Fri, 15 Dec 2023 12:36:24 -0800 Subject: [PATCH 36/44] Hydra.Options: import toArgs from Online Co-authored-by: card --- hydra-node/src/Hydra/Options.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/hydra-node/src/Hydra/Options.hs b/hydra-node/src/Hydra/Options.hs index c0a39fd780e..5b5e55204c4 100644 --- a/hydra-node/src/Hydra/Options.hs +++ b/hydra-node/src/Hydra/Options.hs @@ -58,7 +58,8 @@ import Hydra.Options.Online ( cardanoSigningKeyFileParser, defaultChainConfig, startChainFromParser, - toArgNetworkId + toArgNetworkId, + toArgs ) import Hydra.Options.Online qualified as OnlineOptions import Hydra.Version (embeddedRevision, gitRevision, unknownVersion) From 68806881b476cb810c06cd21f97b0c9a713713d3 Mon Sep 17 00:00:00 2001 From: rrruko Date: Fri, 15 Dec 2023 12:54:35 -0800 Subject: [PATCH 37/44] resolve warnings Co-authored-by: card --- hydra-cluster/src/HydraNode.hs | 8 +------- hydra-cluster/test/Test/EndToEndSpec.hs | 6 +----- hydra-node/exe/hydra-node/Main.hs | 1 - hydra-node/src/Hydra/Chain/Offline/Persistence.hs | 5 ----- hydra-node/src/Hydra/Node/Run.hs | 2 +- hydra-node/src/Hydra/Options/Common.hs | 8 +++----- hydra-node/src/Hydra/Options/Offline.hs | 1 - 7 files changed, 6 insertions(+), 25 deletions(-) diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs index e9545bcde2c..efcd7bafe9e 100644 --- a/hydra-cluster/src/HydraNode.hs +++ b/hydra-cluster/src/HydraNode.hs @@ -31,9 +31,8 @@ import Hydra.Options.Offline qualified as OfflineOptions 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) -import System.Directory (createDirectoryIfMissing) import System.FilePath ((<.>), ()) -import System.IO.Temp (withSystemTempDirectory, getCanonicalTemporaryDirectory ) +import System.IO.Temp (withSystemTempDirectory) import System.Process ( CreateProcess (..), ProcessHandle, @@ -306,11 +305,6 @@ withOfflineHydraNode tracer offlineConfig workDir hydraNodeId hydraSKey action = where logFilePath = workDir "logs" "hydra-node-" <> show hydraNodeId <.> "log" -withPersistentDebugDirectory newDir action = do - systemTempDir <- getCanonicalTemporaryDirectory - let newPath = systemTempDir "hydra-node" - action newPath - withOfflineHydraNode' :: OfflineConfig -> FilePath -> diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs index 2413b9dae18..841660f92c5 100644 --- a/hydra-cluster/test/Test/EndToEndSpec.hs +++ b/hydra-cluster/test/Test/EndToEndSpec.hs @@ -71,7 +71,7 @@ import Hydra.Cluster.Scenarios ( testPreventResumeReconfiguredPeer, threeNodesNoErrorsOnOpen, ) -import Hydra.Cluster.Util (chainConfigFor, keysFor, offlineConfigFor) +import Hydra.Cluster.Util (chainConfigFor, keysFor) import Hydra.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod)) import Hydra.Crypto (generateSigningKey) import Hydra.Ledger (txId) @@ -118,10 +118,6 @@ 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 - let startingState = - [ (Alice, lovelaceToValue 100_000_000) - , (Bob, lovelaceToValue 100_000_000) - ] (aliceCardanoVk, aliceCardanoSk) <- keysFor Alice (bobCardanoVk, _) <- keysFor Bob initialUtxo <- generate $ do diff --git a/hydra-node/exe/hydra-node/Main.hs b/hydra-node/exe/hydra-node/Main.hs index e7cfcba88f2..f7eadbfddff 100644 --- a/hydra-node/exe/hydra-node/Main.hs +++ b/hydra-node/exe/hydra-node/Main.hs @@ -15,7 +15,6 @@ import Hydra.Options ( Command (GenHydraKey, Publish, Run, RunOffline), PublishOptions (..), RunOptions (..), - RunOfflineOptions (..), parseHydraCommand, ) import Hydra.Options.Online qualified as OnlineOptions diff --git a/hydra-node/src/Hydra/Chain/Offline/Persistence.hs b/hydra-node/src/Hydra/Chain/Offline/Persistence.hs index f034c904b04..72ff1a5c101 100644 --- a/hydra-node/src/Hydra/Chain/Offline/Persistence.hs +++ b/hydra-node/src/Hydra/Chain/Offline/Persistence.hs @@ -6,7 +6,6 @@ module Hydra.Chain.Offline.Persistence ( import Hydra.Prelude -import Data.Aeson qualified as Aeson import Hydra.Cardano.Api (Tx) import Hydra.Chain ( ChainEvent (Observation, observedTx), @@ -21,12 +20,8 @@ import Hydra.Chain ( import Hydra.Chain.Direct.State (initialChainState) import Hydra.ContestationPeriod (ContestationPeriod) import Hydra.HeadId (HeadId, HeadSeed (UnsafeHeadSeed)) -import Hydra.HeadLogic (StateChanged (SnapshotConfirmed, snapshot)) import Hydra.Ledger (IsTx (UTxOType)) import Hydra.Party (Party) -import Hydra.Persistence (PersistenceIncremental (PersistenceIncremental, append, loadAll), createPersistenceIncremental) -import Hydra.Snapshot (Snapshot (Snapshot, utxo)) -import UnliftIO.IO.File (writeBinaryFileDurableAtomic) initializeStateIfOffline :: ChainStateHistory Tx -> diff --git a/hydra-node/src/Hydra/Node/Run.hs b/hydra-node/src/Hydra/Node/Run.hs index bc692a62b70..739501f6a84 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -54,7 +54,7 @@ import Hydra.Options ( ChainConfig (..), InvalidOptions (..), LedgerConfig (..), - OfflineConfig (OfflineConfig, ledgerGenesisFile), + OfflineConfig (..), RunOptions (..), RunOfflineOptions (..), validateRunOptions diff --git a/hydra-node/src/Hydra/Options/Common.hs b/hydra-node/src/Hydra/Options/Common.hs index af9ccb37032..e4d8ecc8641 100644 --- a/hydra-node/src/Hydra/Options/Common.hs +++ b/hydra-node/src/Hydra/Options/Common.hs @@ -13,15 +13,13 @@ import Hydra.Cardano.Api ( import Hydra.Chain (maximumNumberOfParties) import Hydra.Logging (Verbosity (..)) -import Hydra.Network (Host, NodeId (NodeId), PortNumber, readHost, readPort) +import Hydra.Network (PortNumber, readPort) import Hydra.Ledger.Cardano () -import Data.IP ( IP (IPv4), toIPv4, toIPv4w ) +import Data.IP ( IP (IPv4), toIPv4w ) import Data.ByteString qualified as BS import Options.Applicative ( Parser, - ParserInfo, - ParserResult (..), short, long, flag, @@ -36,7 +34,7 @@ import Options.Applicative ( help ) -import Test.QuickCheck (elements, listOf, listOf1, oneof, suchThat, vectorOf) +import Test.QuickCheck (elements, listOf1, vectorOf) newtype LedgerConfig = CardanoLedgerConfig { cardanoLedgerProtocolParametersFile :: FilePath diff --git a/hydra-node/src/Hydra/Options/Offline.hs b/hydra-node/src/Hydra/Options/Offline.hs index dd39a1bb4bd..261b11b7214 100644 --- a/hydra-node/src/Hydra/Options/Offline.hs +++ b/hydra-node/src/Hydra/Options/Offline.hs @@ -42,7 +42,6 @@ import Options.Applicative ( ) import Test.QuickCheck.Gen (elements, oneof) import Test.QuickCheck (listOf) -import Hydra.Cardano.Api.Prelude import Options.Applicative.Extra (helper) data RunOfflineOptions = RunOfflineOptions From 3500d519f1c5c4766c6cd4b9ef56a963eb9fb11e Mon Sep 17 00:00:00 2001 From: rrruko Date: Fri, 15 Dec 2023 15:11:07 -0800 Subject: [PATCH 38/44] update log schema --- hydra-node/json-schemas/logs.yaml | 82 +++++++++++++++++++++++++++++++ 1 file changed, 82 insertions(+) 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: From a10c49232149a0a1a6d1e5c1f92dc63e308a4874 Mon Sep 17 00:00:00 2001 From: rrruko Date: Fri, 15 Dec 2023 15:11:15 -0800 Subject: [PATCH 39/44] fix test failures --- hydra-node/src/Hydra/Node.hs | 2 -- hydra-node/src/Hydra/Node/Run.hs | 2 +- hydra-node/test/Hydra/OptionsSpec.hs | 1 - 3 files changed, 1 insertion(+), 4 deletions(-) diff --git a/hydra-node/src/Hydra/Node.hs b/hydra-node/src/Hydra/Node.hs index bfcb22a2473..e08c1331df6 100644 --- a/hydra-node/src/Hydra/Node.hs +++ b/hydra-node/src/Hydra/Node.hs @@ -49,7 +49,6 @@ import Hydra.Network.Message (Message) import Hydra.Node.EventQueue (EventQueue (..), Queued (..)) import Hydra.Node.ParameterMismatch (ParamMismatch (..), ParameterMismatch (..)) import Hydra.Options (ChainConfig (..), RunOptions (..), RunOfflineOptions (..), defaultContestationPeriod) -import Hydra.Options.Offline qualified as OfflineOptions import Hydra.Party (Party (..), deriveParty) import Hydra.Persistence (PersistenceIncremental (..), ) @@ -63,7 +62,6 @@ initEnvironment options = do -- NOTE: This is a cardano-specific initialization step of loading -- --cardano-verification-key options and deriving 'OnChainId's from it. - otherVerificationKeys <- mapM (readFileTextEnvelopeThrow (AsVerificationKey AsPaymentKey)) cardanoVerificationKeys ownSigningKey <- readFileTextEnvelopeThrow (AsSigningKey AsPaymentKey) cardanoSigningKey otherVerificationKeys <- mapM (readFileTextEnvelopeThrow (AsVerificationKey AsPaymentKey)) cardanoVerificationKeys let participants = verificationKeyToOnChainId <$> (getVerificationKey ownSigningKey : otherVerificationKeys) diff --git a/hydra-node/src/Hydra/Node/Run.hs b/hydra-node/src/Hydra/Node/Run.hs index 739501f6a84..d72b636ebfb 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -146,7 +146,7 @@ run :: RunOptions -> IO () run opts = do either (throwIO . InvalidOptionException) pure $ validateRunOptions opts let RunOptions{verbosity, monitoringPort, persistenceDir} = opts - env@Environment{party, otherParties, signingKey, contestationPeriod} <- initEnvironment opts + env@Environment{party, otherParties, signingKey} <- initEnvironment opts withTracer verbosity $ \tracer' -> withMonitoring monitoringPort tracer' $ \tracer -> do traceWith tracer (NodeOptions opts) diff --git a/hydra-node/test/Hydra/OptionsSpec.hs b/hydra-node/test/Hydra/OptionsSpec.hs index 9ddc9a1fd21..0b58487982d 100644 --- a/hydra-node/test/Hydra/OptionsSpec.hs +++ b/hydra-node/test/Hydra/OptionsSpec.hs @@ -364,5 +364,4 @@ defaultRunOptions = , persistenceDir = "./" , chainConfig = defaultChainConfig , ledgerConfig = defaultLedgerConfig - , offlineConfig = Nothing } From e373bcecdfcdecc59fb7b87a0875c782d3d91ba7 Mon Sep 17 00:00:00 2001 From: Sebastian Nagel Date: Mon, 18 Dec 2023 15:08:11 +0100 Subject: [PATCH 40/44] Fix formatting --- hydra-cluster/src/HydraNode.hs | 6 +- hydra-cluster/test/Test/EndToEndSpec.hs | 9 +-- hydra-node/src/Hydra/Chain/Offline.hs | 73 +++++++++------------ hydra-node/src/Hydra/Logging/Messages.hs | 2 +- hydra-node/src/Hydra/Node.hs | 4 +- hydra-node/src/Hydra/Node/Run.hs | 19 +++--- hydra-node/src/Hydra/Options.hs | 51 +++++++-------- hydra-node/src/Hydra/Options/Common.hs | 26 ++++---- hydra-node/src/Hydra/Options/Offline.hs | 83 ++++++++++++------------ hydra-node/src/Hydra/Options/Online.hs | 53 ++++++++------- hydra-node/test/Hydra/NodeSpec.hs | 2 +- 11 files changed, 162 insertions(+), 166 deletions(-) diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs index efcd7bafe9e..38cb83f2ecf 100644 --- a/hydra-cluster/src/HydraNode.hs +++ b/hydra-cluster/src/HydraNode.hs @@ -25,9 +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 (..), OfflineConfig, RunOptions (..), RunOfflineOptions (..)) -import Hydra.Options.Online qualified as OnlineOptions +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) @@ -325,7 +325,7 @@ withOfflineHydraNode' offlineConfig workDir hydraNodeId hydraSKey mGivenStdOut a { cardanoLedgerProtocolParametersFile } let p = - (hydraNodeOfflineProcess $ + ( hydraNodeOfflineProcess $ RunOfflineOptions { verbosity = Verbose "HydraNode" , host = "127.0.0.1" diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs index 841660f92c5..0784e7fc808 100644 --- a/hydra-cluster/test/Test/EndToEndSpec.hs +++ b/hydra-cluster/test/Test/EndToEndSpec.hs @@ -125,10 +125,11 @@ spec = around (showLogsOnFailure "EndToEndSpec") $ do b <- genUTxOFor bobCardanoVk pure $ a <> b Aeson.encodeFile (tmpDir "utxo.json") initialUtxo - let offlineConfig = OfflineConfig - { initialUTxOFile = tmpDir "utxo.json" - , ledgerGenesisFile = Nothing - } + let offlineConfig = + OfflineConfig + { initialUTxOFile = tmpDir "utxo.json" + , ledgerGenesisFile = Nothing + } let Just (aliceSeedTxIn, aliceSeedTxOut) = UTxO.find (\(TxOut addr _ _ _) -> addr == mkVkAddress networkId aliceCardanoVk) initialUtxo diff --git a/hydra-node/src/Hydra/Chain/Offline.hs b/hydra-node/src/Hydra/Chain/Offline.hs index 6546a483d1e..479f1210cd3 100644 --- a/hydra-node/src/Hydra/Chain/Offline.hs +++ b/hydra-node/src/Hydra/Chain/Offline.hs @@ -1,67 +1,56 @@ module Hydra.Chain.Offline ( withOfflineChain, loadGlobalsFromGenesis, - loadState - + loadState, ) where import Hydra.Prelude -import Hydra.Chain.Offline.Handlers (mkFakeL1Chain) - -import Hydra.Logging (Tracer, traceWith) - +import Cardano.Ledger.BaseTypes (epochInfoPure) +import Cardano.Ledger.BaseTypes qualified as Ledger +import Cardano.Ledger.Crypto qualified as Ledger +import Cardano.Ledger.Shelley.API qualified as Ledger +import Cardano.Ledger.Shelley.API qualified as Shelley +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 ( + GenesisParameters (..), + ShelleyEra, + StandardCrypto, + Tx, + ) +import Hydra.Cardano.Api qualified as Shelley import Hydra.Chain ( ChainComponent, ChainEvent (Tick), ChainStateHistory, + IsChainState (ChainStateType), chainSlot, - chainTime, IsChainState (ChainStateType), + chainTime, ) -import Hydra.HeadId (HeadId) - +import Hydra.Chain.Direct.Fixture (defaultGlobals) 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.HeadLogic (HeadState (Idle), IdleState (..), StateChanged, recoverChainStateHistory, recoverState) import Hydra.Ledger (ChainSlot (ChainSlot), IsTx (UTxOType)) -import Hydra.Ledger.Cardano.Configuration (readJsonFileThrow, newGlobals) - +import Hydra.Ledger.Cardano.Configuration (newGlobals, readJsonFileThrow) +import Hydra.Logging (Tracer, traceWith) +import Hydra.Node (HydraNodeLog (..)) import Hydra.Options (OfflineConfig (OfflineConfig, initialUTxOFile, ledgerGenesisFile)) - -import Cardano.Ledger.Shelley.API qualified as Ledger -import Cardano.Ledger.BaseTypes qualified as Ledger -import Cardano.Ledger.Crypto qualified as Ledger - +import Hydra.Party (Party) +import Hydra.Persistence (PersistenceIncremental (..)) import Ouroboros.Consensus.HardFork.History (interpretQuery, mkInterpreter, neverForksSummary, slotToWallclock, wallclockToSlot) import Ouroboros.Consensus.HardFork.History qualified as Consensus - -import Cardano.Ledger.Slot (SlotNo (SlotNo, unSlotNo)) - -import Cardano.Slotting.Time (SystemStart (SystemStart), mkSlotLength, toRelativeTime) -import Cardano.Slotting.Time qualified as Slotting - -import Cardano.Ledger.BaseTypes (epochInfoPure) - -import Cardano.Slotting.EpochInfo (EpochInfo (EpochInfo), epochInfoFirst, epochInfoSlotToUTCTime) - import Ouroboros.Consensus.Util.Time (nominalDelay) -import Hydra.Cardano.Api ( - StandardCrypto, - Tx, GenesisParameters (..), ShelleyEra, - ) -import Hydra.Chain.Offline.Persistence (initializeStateIfOffline) -import Hydra.ContestationPeriod (ContestationPeriod) -import Hydra.Party (Party) -import Hydra.Persistence (PersistenceIncremental(..)) -import Hydra.Node (HydraNodeLog (..)) -import Hydra.HeadLogic (StateChanged, IdleState (..), recoverChainStateHistory, recoverState, HeadState(Idle)) -import qualified Cardano.Ledger.Shelley.API as Shelley -import Hydra.Cardano.Api qualified as Shelley -import Hydra.Chain.Direct.Fixture (defaultGlobals) - withOfflineChain :: Tracer IO DirectChainLog -> OfflineConfig -> @@ -215,4 +204,4 @@ fromShelleyGenesis Shelley.Lovelace (fromIntegral sgMaxLovelaceSupply) , protocolInitialUpdateableProtocolParameters = Shelley.sgProtocolParams sg - } \ No newline at end of file + } diff --git a/hydra-node/src/Hydra/Logging/Messages.hs b/hydra-node/src/Hydra/Logging/Messages.hs index 52305404798..f472c98c1e6 100644 --- a/hydra-node/src/Hydra/Logging/Messages.hs +++ b/hydra-node/src/Hydra/Logging/Messages.hs @@ -15,7 +15,7 @@ import Hydra.Chain.Direct.Handlers (DirectChainLog) import Hydra.Network.Authenticate (AuthLog) import Hydra.Network.Reliability (ReliabilityLog) import Hydra.Node (HydraNodeLog) -import Hydra.Options (RunOptions, RunOfflineOptions) +import Hydra.Options (RunOfflineOptions, RunOptions) import Hydra.Options.Offline () data HydraLog tx net diff --git a/hydra-node/src/Hydra/Node.hs b/hydra-node/src/Hydra/Node.hs index e08c1331df6..7442d78112b 100644 --- a/hydra-node/src/Hydra/Node.hs +++ b/hydra-node/src/Hydra/Node.hs @@ -48,9 +48,9 @@ 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 (..), RunOfflineOptions (..), defaultContestationPeriod) +import Hydra.Options (ChainConfig (..), RunOfflineOptions (..), RunOptions (..), defaultContestationPeriod) import Hydra.Party (Party (..), deriveParty) -import Hydra.Persistence (PersistenceIncremental (..), ) +import Hydra.Persistence (PersistenceIncremental (..)) -- * Environment Handling diff --git a/hydra-node/src/Hydra/Node/Run.hs b/hydra-node/src/Hydra/Node/Run.hs index d72b636ebfb..40cf80531b0 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -21,7 +21,7 @@ import Hydra.Chain (maximumNumberOfParties) import Hydra.Chain.CardanoClient (QueryPoint (..), queryGenesisParameters) import Hydra.Chain.Direct (loadChainContext, mkTinyWallet, withDirectChain) import Hydra.Chain.Direct.State (initialChainState) -import Hydra.Chain.Offline (withOfflineChain, loadGlobalsFromGenesis, loadState) +import Hydra.Chain.Offline (loadGlobalsFromGenesis, loadState, withOfflineChain) import Hydra.HeadId (HeadId (..)) import Hydra.HeadLogic ( Environment (..), @@ -38,6 +38,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 ( @@ -55,15 +56,13 @@ import Hydra.Options ( InvalidOptions (..), LedgerConfig (..), OfflineConfig (..), - RunOptions (..), RunOfflineOptions (..), - validateRunOptions + RunOptions (..), + validateRunOptions, ) import Hydra.Options.Offline qualified as OfflineOptions import Hydra.Options.Online qualified as OnlineOptions import Hydra.Persistence (createPersistenceIncremental) -import Hydra.Network (NodeId(NodeId)) - data ConfigurationException = ConfigurationException ProtocolParametersConversionError @@ -107,8 +106,8 @@ runOffline opts = do 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 + 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 @@ -169,9 +168,9 @@ run opts = do nodeState <- createNodeState hs -- Chain 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 + 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 diff --git a/hydra-node/src/Hydra/Options.hs b/hydra-node/src/Hydra/Options.hs index 5b5e55204c4..158fab71e04 100644 --- a/hydra-node/src/Hydra/Options.hs +++ b/hydra-node/src/Hydra/Options.hs @@ -3,7 +3,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Hydra.Options ( -module Hydra.Options.Common, + module Hydra.Options.Common, module Hydra.Options.Offline, module Hydra.Options.Online, module Hydra.Options, @@ -21,45 +21,45 @@ import Hydra.Cardano.Api ( import Hydra.Contract qualified as Contract import Hydra.Ledger.Cardano () import Hydra.Options.Common ( - LedgerConfig(..), - InvalidOptions(..), - defaultLedgerConfig, - ledgerConfigParser, - hydraVerificationKeyFileParser, - hydraSigningKeyFileParser, - cardanoVerificationKeyFileParser, - verbosityParser, - hostParser, - portParser, + InvalidOptions (..), + LedgerConfig (..), apiHostParser, apiPortParser, - monitoringPortParser, - persistenceDirParser, + cardanoVerificationKeyFileParser, + defaultLedgerConfig, genChainPoint, + genDirPath, genFilePath, - genDirPath + hostParser, + hydraSigningKeyFileParser, + hydraVerificationKeyFileParser, + ledgerConfigParser, + monitoringPortParser, + persistenceDirParser, + portParser, + verbosityParser, ) import Hydra.Options.Offline ( - RunOfflineOptions (..), OfflineConfig (..), - validateRunOfflineOptions, + RunOfflineOptions (..), defaultOfflineConfig, offlineOptionsParser, runOfflineOptionsParser, + validateRunOfflineOptions, ) import Hydra.Options.Online ( - ChainConfig(..), - RunOptions(..), - validateRunOptions, + ChainConfig (..), + RunOptions (..), + cardanoSigningKeyFileParser, + defaultChainConfig, defaultContestationPeriod, - runOptionsParser, networkIdParser, nodeSocketParser, - cardanoSigningKeyFileParser, - defaultChainConfig, + runOptionsParser, startChainFromParser, toArgNetworkId, - toArgs + toArgs, + validateRunOptions, ) import Hydra.Options.Online qualified as OnlineOptions import Hydra.Version (embeddedRevision, gitRevision, unknownVersion) @@ -176,7 +176,6 @@ outputFileParser = <> help "Basename of files to generate key-pair into. Signing key will be suffixed '.sk' and verification key '.vk'" ) - hydraNodeCommand :: ParserInfo Command hydraNodeCommand = info @@ -210,8 +209,6 @@ hydraNodeVersion = <|> gitRevision <|> Just unknownVersion - - -- | Parse command-line arguments into a `Option` or exit with failure and error message. parseHydraCommand :: IO Command parseHydraCommand = getArgs <&> parseHydraCommandFromArgs >>= handleParseResult @@ -219,5 +216,3 @@ parseHydraCommand = getArgs <&> parseHydraCommandFromArgs >>= handleParseResult -- | Pure parsing of `Option` from a list of arguments. parseHydraCommandFromArgs :: [String] -> ParserResult Command parseHydraCommandFromArgs = execParserPure defaultPrefs hydraNodeCommand - - diff --git a/hydra-node/src/Hydra/Options/Common.hs b/hydra-node/src/Hydra/Options/Common.hs index e4d8ecc8641..64db9a66605 100644 --- a/hydra-node/src/Hydra/Options/Common.hs +++ b/hydra-node/src/Hydra/Options/Common.hs @@ -1,37 +1,38 @@ {-# OPTIONS_GHC -Wno-orphans #-} + module Hydra.Options.Common ( module Hydra.Options.Common, - ) where +) where -import Hydra.Prelude 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 Hydra.Ledger.Cardano () -import Data.IP ( IP (IPv4), toIPv4w ) import Data.ByteString qualified as BS +import Data.IP (IP (IPv4), toIPv4w) import Options.Applicative ( Parser, - short, - long, - flag, auto, - value, + flag, + help, + long, + maybeReader, + metavar, option, + short, + showDefault, str, strOption, - metavar, - maybeReader, - showDefault, - help + value, ) import Test.QuickCheck (elements, listOf1, vectorOf) @@ -98,7 +99,6 @@ genChainPoint = ChainPoint <$> (SlotNo <$> arbitrary) <*> someHeaderHash let hash = either (error "invalid bytes") id $ deserialiseFromRawBytes (proxyToAsType Proxy) . BS.pack $ bytes pure hash - cardanoVerificationKeyFileParser :: Parser FilePath cardanoVerificationKeyFileParser = option diff --git a/hydra-node/src/Hydra/Options/Offline.hs b/hydra-node/src/Hydra/Options/Offline.hs index 261b11b7214..f4ea7a3e389 100644 --- a/hydra-node/src/Hydra/Options/Offline.hs +++ b/hydra-node/src/Hydra/Options/Offline.hs @@ -1,9 +1,8 @@ {-# LANGUAGE ApplicativeDo #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -Wno-orphans #-} - module Hydra.Options.Offline ( module Hydra.Options.Offline, ) where @@ -13,8 +12,13 @@ import Hydra.Prelude import Hydra.Logging (Verbosity (..)) import Hydra.Network (PortNumber) import Hydra.Options.Common ( - LedgerConfig(..), - InvalidOptions(MaximumNumberOfPartiesExceeded), + InvalidOptions (MaximumNumberOfPartiesExceeded), + LedgerConfig (..), + apiHostParser, + apiPortParser, + genDirPath, + genFilePath, + hostParser, hydraSigningKeyFileParser, hydraVerificationKeyFileParser, ledgerConfigParser, @@ -22,31 +26,29 @@ import Hydra.Options.Common ( persistenceDirParser, portParser, verbosityParser, - hostParser, InvalidOptions, genFilePath, genDirPath, apiHostParser, apiPortParser, ) -import Data.IP ( IP(..) ) +import Data.IP (IP (..)) import Options.Applicative ( Parser, + command, + help, + info, long, - str, + metavar, option, progDesc, - info, - value, - subparser, - command, showDefault, - metavar, - help, + str, + subparser, + value, ) -import Test.QuickCheck.Gen (elements, oneof) -import Test.QuickCheck (listOf) import Options.Applicative.Extra (helper) +import Test.QuickCheck (listOf) +import Test.QuickCheck.Gen (elements, oneof) data RunOfflineOptions = RunOfflineOptions - { - verbosity :: Verbosity + { verbosity :: Verbosity , host :: IP , port :: PortNumber , apiHost :: IP @@ -57,7 +59,8 @@ data RunOfflineOptions = RunOfflineOptions , persistenceDir :: FilePath , ledgerConfig :: LedgerConfig , offlineConfig :: OfflineConfig -} deriving stock (Eq, Show, Generic) + } + deriving stock (Eq, Show, Generic) deriving anyclass (ToJSON, FromJSON) -- | Convert an 'Options' instance into the corresponding list of command-line arguments. @@ -78,7 +81,8 @@ toArgs , persistenceDir , ledgerConfig , offlineConfig - } = ["offline"] + } = + ["offline"] <> isVerbose verbosity <> ["--host", show host] <> ["--port", show port] @@ -103,8 +107,8 @@ toArgs } = ledgerConfig argsOfflineConfig = - ["--initial-utxo", initialUTxOFile offlineConfig] - <> maybe [] (\s -> ["--ledger-genesis", s]) (ledgerGenesisFile offlineConfig) + ["--initial-utxo", initialUTxOFile offlineConfig] + <> maybe [] (\s -> ["--ledger-genesis", s]) (ledgerGenesisFile offlineConfig) instance Arbitrary OfflineConfig where arbitrary = do @@ -147,21 +151,23 @@ runOfflineOptionsParser = subparser $ command "offline" $ info - (helper <*> (RunOfflineOptions - <$> verbosityParser - <*> hostParser - <*> portParser - <*> apiHostParser - <*> apiPortParser - <*> optional monitoringPortParser - <*> hydraSigningKeyFileParser - <*> many hydraVerificationKeyFileParser - <*> persistenceDirParser - <*> ledgerConfigParser - <*> offlineOptionsParser)) + ( 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 @@ -177,11 +183,9 @@ defaultOfflineConfig = offlineOptionsParser :: Parser OfflineConfig offlineOptionsParser = - OfflineConfig - <$> initialUTxOFileParser - <*> ledgerGenesisFileParser - - + OfflineConfig + <$> initialUTxOFileParser + <*> ledgerGenesisFileParser initialUTxOFileParser :: Parser FilePath initialUTxOFileParser = @@ -204,4 +208,3 @@ ledgerGenesisFileParser = <> 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 index f3e24a042a9..1610eafbe56 100644 --- a/hydra-node/src/Hydra/Options/Online.hs +++ b/hydra-node/src/Hydra/Options/Online.hs @@ -1,27 +1,41 @@ module Hydra.Options.Online ( - module Hydra.Options.Online - ) where + module Hydra.Options.Online, +) where -import Hydra.Prelude import Hydra.Cardano.Api ( + AsType (..), ChainPoint (..), - SocketPath, - NetworkId (Testnet, Mainnet), + File (..), + HasTypeProxy (proxyToAsType), + NetworkId (Mainnet, Testnet), NetworkMagic (NetworkMagic), SlotNo (..), - File (..), - AsType (..), - TxId(..), + SocketPath, + TxId (..), deserialiseFromRawBytesHex, - HasTypeProxy (proxyToAsType), serialiseToRawBytesHexText, + serialiseToRawBytesHexText, ) import Hydra.ContestationPeriod (ContestationPeriod (..)) +import Hydra.Prelude import Hydra.Options.Common ( + InvalidOptions (..), + LedgerConfig (..), + apiHostParser, + apiPortParser, cardanoVerificationKeyFileParser, - genFilePath, defaultLedgerConfig, - genChainPoint, LedgerConfig (..), verbosityParser, hostParser, portParser, apiHostParser, apiPortParser, monitoringPortParser, hydraSigningKeyFileParser, hydraVerificationKeyFileParser, persistenceDirParser, ledgerConfigParser, genDirPath, InvalidOptions (..), + genChainPoint, + genDirPath, + genFilePath, + hostParser, + hydraSigningKeyFileParser, + hydraVerificationKeyFileParser, + ledgerConfigParser, + monitoringPortParser, + persistenceDirParser, + portParser, + verbosityParser, ) import Options.Applicative ( @@ -42,19 +56,18 @@ import Options.Applicative ( value, ) - -import Hydra.Network (Host, NodeId (NodeId), readHost, PortNumber) -import Hydra.Ledger.Cardano () import Hydra.Chain (maximumNumberOfParties) +import Hydra.Ledger.Cardano () import Hydra.Logging (Verbosity (..)) +import Hydra.Network (Host, NodeId (NodeId), PortNumber, readHost) -import Data.Text qualified as T +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 Data.IP (IP (IPv4), toIPv4) import Options.Applicative.Builder (str) -import qualified Data.ByteString.Char8 as BSC -import Control.Arrow (left) import Test.QuickCheck (elements, listOf, oneof, suchThat) @@ -113,7 +126,6 @@ chainConfigParser = <*> optional startChainFromParser <*> contestationPeriodParser - networkIdParser :: Parser NetworkId networkIdParser = pMainnet <|> fmap Testnet pTestnetMagic where @@ -248,7 +260,6 @@ contestationPeriodParser = then fail "negative contestation period" else pure $ UnsafeContestationPeriod $ truncate s - data RunOptions = RunOptions { verbosity :: Verbosity , nodeId :: NodeId @@ -387,7 +398,6 @@ defaultRunOptions = where localhost = IPv4 $ toIPv4 [127, 0, 0, 1] - instance Arbitrary RunOptions where arbitrary = do verbosity <- elements [Quiet, Verbose "HydraNode"] @@ -424,7 +434,6 @@ instance Arbitrary RunOptions where shrink = genericShrink - hydraScriptsTxIdParser :: Parser TxId hydraScriptsTxIdParser = option diff --git a/hydra-node/test/Hydra/NodeSpec.hs b/hydra-node/test/Hydra/NodeSpec.hs index 739bbdb6088..56f1e4c33ba 100644 --- a/hydra-node/test/Hydra/NodeSpec.hs +++ b/hydra-node/test/Hydra/NodeSpec.hs @@ -11,6 +11,7 @@ import Hydra.API.Server (Server (..)) import Hydra.API.ServerOutput (ServerOutput (..)) import Hydra.Cardano.Api (SigningKey) import Hydra.Chain (Chain (..), ChainEvent (..), HeadParameters (..), IsChainState, OnChainTx (..), PostTxError (NoSeedInput)) +import Hydra.Chain.Offline (loadState) import Hydra.ContestationPeriod (ContestationPeriod (..)) import Hydra.Crypto (HydraKey, sign) import Hydra.HeadLogic ( @@ -40,7 +41,6 @@ import Hydra.Options (defaultContestationPeriod) import Hydra.Party (Party, deriveParty) import Hydra.Persistence (PersistenceIncremental (..)) import Test.Hydra.Fixture (alice, aliceSk, bob, bobSk, carol, carolSk, deriveOnChainId, testHeadId, testHeadSeed) -import Hydra.Chain.Offline (loadState) spec :: Spec spec = parallel $ do From bd68a8e4bcec5303dc05f0606667808a027b42a3 Mon Sep 17 00:00:00 2001 From: rrruko Date: Mon, 18 Dec 2023 07:16:14 -0800 Subject: [PATCH 41/44] address some feedback --- hydra-node/src/Hydra/Node/Run.hs | 1 - hydra-node/src/Hydra/Options/Offline.hs | 5 +---- hydra-node/src/Hydra/Options/Online.hs | 4 +--- 3 files changed, 2 insertions(+), 8 deletions(-) diff --git a/hydra-node/src/Hydra/Node/Run.hs b/hydra-node/src/Hydra/Node/Run.hs index 40cf80531b0..841fb02a359 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -94,7 +94,6 @@ runOffline opts = do pparams <- case toLedgerPParams ShelleyBasedEraBabbage protocolParams of Left err -> throwIO (ConfigurationException err) Right bpparams -> pure bpparams - -- let DirectChainConfig{networkId, nodeSocket} = chainConfig globals <- loadGlobalsFromGenesis (ledgerGenesisFile offlineConfig) diff --git a/hydra-node/src/Hydra/Options/Offline.hs b/hydra-node/src/Hydra/Options/Offline.hs index f4ea7a3e389..3a61aa643f6 100644 --- a/hydra-node/src/Hydra/Options/Offline.hs +++ b/hydra-node/src/Hydra/Options/Offline.hs @@ -1,11 +1,8 @@ {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE RecordWildCards #-} -{-# OPTIONS_GHC -Wno-orphans #-} -module Hydra.Options.Offline ( - module Hydra.Options.Offline, -) where +module Hydra.Options.Offline where import Hydra.Prelude diff --git a/hydra-node/src/Hydra/Options/Online.hs b/hydra-node/src/Hydra/Options/Online.hs index 1610eafbe56..e76b073fd88 100644 --- a/hydra-node/src/Hydra/Options/Online.hs +++ b/hydra-node/src/Hydra/Options/Online.hs @@ -1,6 +1,4 @@ -module Hydra.Options.Online ( - module Hydra.Options.Online, -) where +module Hydra.Options.Online where import Hydra.Cardano.Api ( AsType (..), From 0306ce89299e3dab6de5db63ca6f53b2bf3a8003 Mon Sep 17 00:00:00 2001 From: rrruko Date: Mon, 18 Dec 2023 07:26:06 -0800 Subject: [PATCH 42/44] deduplicate fromShelleyGenesis --- hydra-node/src/Hydra/Chain/Offline.hs | 54 --------------------------- hydra-node/src/Hydra/Node/Run.hs | 22 ++++++++++- 2 files changed, 20 insertions(+), 56 deletions(-) diff --git a/hydra-node/src/Hydra/Chain/Offline.hs b/hydra-node/src/Hydra/Chain/Offline.hs index 479f1210cd3..3b5b29f008d 100644 --- a/hydra-node/src/Hydra/Chain/Offline.hs +++ b/hydra-node/src/Hydra/Chain/Offline.hs @@ -1,6 +1,5 @@ module Hydra.Chain.Offline ( withOfflineChain, - loadGlobalsFromGenesis, loadState, ) where @@ -152,56 +151,3 @@ loadState tracer persistence defaultChainState = do pure (headState, chainStateHistory) where initialState = Idle IdleState{chainState = defaultChainState} - -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 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/Node/Run.hs b/hydra-node/src/Hydra/Node/Run.hs index 841fb02a359..c74448d4171 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -14,14 +14,17 @@ 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 (loadGlobalsFromGenesis, loadState, withOfflineChain) +import Hydra.Chain.Offline (loadState, withOfflineChain) import Hydra.HeadId (HeadId (..)) import Hydra.HeadLogic ( Environment (..), @@ -205,7 +208,22 @@ identifyNode :: RunOptions -> RunOptions identifyNode opt@RunOptions{verbosity = Verbose "HydraNode", nodeId} = opt{OnlineOptions.verbosity = Verbose $ "HydraNode-" <> show nodeId} identifyNode opt = opt --- TODO: export from cardano-api +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 From 6a54f774a0124206dd84aed77afa6965fcf8dea8 Mon Sep 17 00:00:00 2001 From: rrruko Date: Mon, 18 Dec 2023 07:35:25 -0800 Subject: [PATCH 43/44] move back loadState --- hydra-node/src/Hydra/Chain/Offline.hs | 17 ----------------- hydra-node/src/Hydra/Node.hs | 20 ++++++++++++++++++++ hydra-node/src/Hydra/Node/Run.hs | 3 ++- hydra-node/test/Hydra/NodeSpec.hs | 2 +- 4 files changed, 23 insertions(+), 19 deletions(-) diff --git a/hydra-node/src/Hydra/Chain/Offline.hs b/hydra-node/src/Hydra/Chain/Offline.hs index 3b5b29f008d..73c790d3341 100644 --- a/hydra-node/src/Hydra/Chain/Offline.hs +++ b/hydra-node/src/Hydra/Chain/Offline.hs @@ -1,6 +1,5 @@ module Hydra.Chain.Offline ( withOfflineChain, - loadState, ) where import Hydra.Prelude @@ -135,19 +134,3 @@ withOfflineChain tracer OfflineConfig{ledgerGenesisFile, initialUTxOFile} global case res of Left () -> error "'connectTo' cannot terminate but did?" Right a -> pure a - --- | Load a 'HeadState' from persistence. -loadState :: - (MonadThrow m, IsChainState tx) => - Tracer m (HydraNodeLog tx) -> - PersistenceIncremental (StateChanged tx) m -> - ChainStateType tx -> - m (HeadState tx, ChainStateHistory tx) -loadState tracer persistence defaultChainState = do - events <- loadAll persistence - traceWith tracer LoadedState{numberOfEvents = fromIntegral $ length events} - let headState = recoverState initialState events - chainStateHistory = recoverChainStateHistory defaultChainState events - pure (headState, chainStateHistory) - where - initialState = Idle IdleState{chainState = defaultChainState} diff --git a/hydra-node/src/Hydra/Node.hs b/hydra-node/src/Hydra/Node.hs index 7442d78112b..0ee41e37a88 100644 --- a/hydra-node/src/Hydra/Node.hs +++ b/hydra-node/src/Hydra/Node.hs @@ -21,6 +21,7 @@ import Hydra.API.Server (Server, sendOutput) import Hydra.Cardano.Api (AsType (AsPaymentKey, AsSigningKey, AsVerificationKey), getVerificationKey) import Hydra.Chain ( Chain (..), + ChainStateHistory, ChainStateType, HeadParameters (..), IsChainState, @@ -34,10 +35,13 @@ import Hydra.HeadLogic ( Environment (..), Event (..), HeadState (..), + IdleState (..), Outcome (..), aggregateState, collectEffects, defaultTTL, + recoverChainStateHistory, + recoverState, ) import Hydra.HeadLogic qualified as Logic import Hydra.HeadLogic.Outcome (StateChanged (..)) @@ -286,3 +290,19 @@ createNodeState initialState = do { modifyHeadState = stateTVar tv , queryHeadState = readTVar tv } + +-- | Load a 'HeadState' from persistence. +loadState :: + (MonadThrow m, IsChainState tx) => + Tracer m (HydraNodeLog tx) -> + PersistenceIncremental (StateChanged tx) m -> + ChainStateType tx -> + m (HeadState tx, ChainStateHistory tx) +loadState tracer persistence defaultChainState = do + events <- loadAll persistence + traceWith tracer LoadedState{numberOfEvents = fromIntegral $ length events} + let headState = recoverState initialState events + chainStateHistory = recoverChainStateHistory defaultChainState events + pure (headState, chainStateHistory) + where + initialState = Idle IdleState{chainState = defaultChainState} diff --git a/hydra-node/src/Hydra/Node/Run.hs b/hydra-node/src/Hydra/Node/Run.hs index c74448d4171..da026f6efcb 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -24,7 +24,7 @@ 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 (loadState, withOfflineChain) +import Hydra.Chain.Offline (withOfflineChain) import Hydra.HeadId (HeadId (..)) import Hydra.HeadLogic ( Environment (..), @@ -50,6 +50,7 @@ import Hydra.Node ( createNodeState, initEnvironment, initEnvironmentOffline, + loadState, runHydraNode, ) import Hydra.Node.EventQueue (EventQueue (..), createEventQueue) diff --git a/hydra-node/test/Hydra/NodeSpec.hs b/hydra-node/test/Hydra/NodeSpec.hs index 56f1e4c33ba..c93479256af 100644 --- a/hydra-node/test/Hydra/NodeSpec.hs +++ b/hydra-node/test/Hydra/NodeSpec.hs @@ -11,7 +11,6 @@ import Hydra.API.Server (Server (..)) import Hydra.API.ServerOutput (ServerOutput (..)) import Hydra.Cardano.Api (SigningKey) import Hydra.Chain (Chain (..), ChainEvent (..), HeadParameters (..), IsChainState, OnChainTx (..), PostTxError (NoSeedInput)) -import Hydra.Chain.Offline (loadState) import Hydra.ContestationPeriod (ContestationPeriod (..)) import Hydra.Crypto (HydraKey, sign) import Hydra.HeadLogic ( @@ -33,6 +32,7 @@ import Hydra.Node ( HydraNodeLog (..), checkHeadState, createNodeState, + loadState, stepHydraNode, ) import Hydra.Node.EventQueue (EventQueue (..), createEventQueue) From bea0b767a4ee5b7484c6bb62160f5b5014084859 Mon Sep 17 00:00:00 2001 From: rrruko Date: Mon, 18 Dec 2023 07:43:38 -0800 Subject: [PATCH 44/44] organize imports --- hydra-node/src/Hydra/Chain/Offline.hs | 14 ++------------ 1 file changed, 2 insertions(+), 12 deletions(-) diff --git a/hydra-node/src/Hydra/Chain/Offline.hs b/hydra-node/src/Hydra/Chain/Offline.hs index 73c790d3341..47d484c62e9 100644 --- a/hydra-node/src/Hydra/Chain/Offline.hs +++ b/hydra-node/src/Hydra/Chain/Offline.hs @@ -6,29 +6,22 @@ import Hydra.Prelude import Cardano.Ledger.BaseTypes (epochInfoPure) import Cardano.Ledger.BaseTypes qualified as Ledger -import Cardano.Ledger.Crypto qualified as Ledger import Cardano.Ledger.Shelley.API qualified as Ledger -import Cardano.Ledger.Shelley.API qualified as Shelley 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 ( - GenesisParameters (..), - ShelleyEra, StandardCrypto, Tx, ) -import Hydra.Cardano.Api qualified as Shelley import Hydra.Chain ( ChainComponent, ChainEvent (Tick), ChainStateHistory, - IsChainState (ChainStateType), chainSlot, chainTime, ) -import Hydra.Chain.Direct.Fixture (defaultGlobals) import Hydra.Chain.Direct.Handlers ( DirectChainLog (), newLocalChainState, @@ -37,14 +30,11 @@ import Hydra.Chain.Offline.Handlers (mkFakeL1Chain) import Hydra.Chain.Offline.Persistence (initializeStateIfOffline) import Hydra.ContestationPeriod (ContestationPeriod) import Hydra.HeadId (HeadId) -import Hydra.HeadLogic (HeadState (Idle), IdleState (..), StateChanged, recoverChainStateHistory, recoverState) import Hydra.Ledger (ChainSlot (ChainSlot), IsTx (UTxOType)) -import Hydra.Ledger.Cardano.Configuration (newGlobals, readJsonFileThrow) -import Hydra.Logging (Tracer, traceWith) -import Hydra.Node (HydraNodeLog (..)) +import Hydra.Ledger.Cardano.Configuration (readJsonFileThrow) +import Hydra.Logging (Tracer) import Hydra.Options (OfflineConfig (OfflineConfig, initialUTxOFile, ledgerGenesisFile)) import Hydra.Party (Party) -import Hydra.Persistence (PersistenceIncremental (..)) import Ouroboros.Consensus.HardFork.History (interpretQuery, mkInterpreter, neverForksSummary, slotToWallclock, wallclockToSlot) import Ouroboros.Consensus.HardFork.History qualified as Consensus import Ouroboros.Consensus.Util.Time (nominalDelay)