Skip to content

Commit

Permalink
Merge pull request #1184 from input-output-hk/abailly-iohk/explain-co…
Browse files Browse the repository at this point in the history
…nfiguration-errors

Explain configuration errors
  • Loading branch information
abailly-iohk committed Dec 1, 2023
2 parents c1185cf + ed04d04 commit a8ce92d
Show file tree
Hide file tree
Showing 5 changed files with 153 additions and 117 deletions.
105 changes: 4 additions & 101 deletions hydra-node/exe/hydra-node/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -4,135 +4,38 @@ module Main where

import Hydra.Prelude hiding (fromList)

import Hydra.API.Server (Server (..), withAPIServer)
import Hydra.API.ServerOutput (ServerOutput (..))
import Hydra.Cardano.Api (
ProtocolParametersConversionError,
ShelleyBasedEra (..),
serialiseToRawBytesHex,
toLedgerPParams,
)
import Hydra.Chain.CardanoClient (QueryPoint (..), queryGenesisParameters)
import Hydra.Chain.Direct (loadChainContext, mkTinyWallet, withDirectChain)
import Hydra.Chain.Direct.ScriptRegistry (publishHydraScripts)
import Hydra.Chain.Direct.State (initialChainState)
import Hydra.Chain.Direct.Util (readKeyPair)
import Hydra.HeadLogic (
Environment (..),
Event (..),
defaultTTL,
)
import Hydra.Ledger.Cardano qualified as Ledger
import Hydra.Ledger.Cardano.Configuration (
newGlobals,
newLedgerEnv,
protocolParametersFromJson,
readJsonFileThrow,
)
import Hydra.Logging (Verbosity (..), traceWith, withTracer)
import Hydra.Logging.Messages (HydraLog (..))
import Hydra.Logging.Monitoring (withMonitoring)
import Hydra.Network.Authenticate (Authenticated (Authenticated))
import Hydra.Network.Message (Connectivity (..))
import Hydra.Node (
HydraNode (..),
checkHeadState,
createNodeState,
initEnvironment,
loadState,
runHydraNode,
)
import Hydra.Node.EventQueue (EventQueue (..), createEventQueue)
import Hydra.Node.Network (NetworkConfiguration (..), withNetwork)
import Hydra.Logging (Verbosity (..))
import Hydra.Node.Run (explain, run)
import Hydra.Options (
ChainConfig (..),
Command (GenHydraKey, Publish, Run),
LedgerConfig (..),
PublishOptions (..),
RunOptions (..),
explain,
parseHydraCommand,
validateRunOptions,
)
import Hydra.Persistence (createPersistenceIncremental)
import Hydra.Utils (genHydraKeys)

newtype ConfigurationParseException = ConfigurationParseException ProtocolParametersConversionError
deriving stock (Show)

instance Exception ConfigurationParseException

main :: IO ()
main = do
command <- parseHydraCommand
case command of
Run options -> do
either (die . explain) pure $ validateRunOptions options
run (identifyNode options)
Run options ->
run (identifyNode options) `catch` (die . explain)
Publish options ->
publish options
GenHydraKey outputFile ->
either (die . show) pure =<< genHydraKeys outputFile
where
run opts = do
let RunOptions{verbosity, monitoringPort, persistenceDir} = opts
env@Environment{party, otherParties, signingKey} <- initEnvironment opts
withTracer verbosity $ \tracer' ->
withMonitoring monitoringPort tracer' $ \tracer -> do
traceWith tracer (NodeOptions opts)
eq@EventQueue{putEvent} <- createEventQueue
let RunOptions{hydraScriptsTxId, chainConfig, ledgerConfig} = opts
protocolParams <- readJsonFileThrow protocolParametersFromJson (cardanoLedgerProtocolParametersFile ledgerConfig)
pparams <- case toLedgerPParams ShelleyBasedEraBabbage protocolParams of
Left err -> throwIO (ConfigurationParseException err)
Right bpparams -> pure bpparams
withCardanoLedger chainConfig 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 otherParties hydraScriptsTxId
wallet <- mkTinyWallet (contramap DirectChain tracer) chainConfig
withDirectChain (contramap DirectChain tracer) chainConfig ctx wallet chainStateHistory (putEvent . OnChainEvent) $ \chain -> do
-- 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
-- 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
}

connectionMessages Server{sendOutput} = \case
Connected nodeid -> sendOutput $ PeerConnected nodeid
Disconnected nodeid -> sendOutput $ PeerDisconnected nodeid

publish opts = do
(_, sk) <- readKeyPair (publishSigningKey opts)
let PublishOptions{publishNetworkId = networkId, publishNodeSocket} = opts
txId <- publishHydraScripts networkId publishNodeSocket sk
putStr (decodeUtf8 (serialiseToRawBytesHex txId))

withCardanoLedger chainConfig protocolParams action = do
let DirectChainConfig{networkId, nodeSocket} = chainConfig
globals <- newGlobals =<< queryGenesisParameters networkId nodeSocket QueryTip
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
2 changes: 2 additions & 0 deletions hydra-node/hydra-node.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -96,6 +96,7 @@ library
Hydra.Node.EventQueue
Hydra.Node.Network
Hydra.Node.ParameterMismatch
Hydra.Node.Run
Hydra.Options
Hydra.Party
Hydra.Persistence
Expand Down Expand Up @@ -284,6 +285,7 @@ test-suite tests
Hydra.Network.ReliabilitySpec
Hydra.NetworkSpec
Hydra.Node.EventQueueSpec
Hydra.Node.RunSpec
Hydra.NodeSpec
Hydra.OptionsSpec
Hydra.PartySpec
Expand Down
126 changes: 126 additions & 0 deletions hydra-node/src/Hydra/Node/Run.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,126 @@
{-# LANGUAGE DuplicateRecordFields #-}

module Hydra.Node.Run where

import Hydra.Prelude hiding (fromList)

import Hydra.API.Server (Server (..), withAPIServer)
import Hydra.API.ServerOutput (ServerOutput (..))
import Hydra.Cardano.Api (
ProtocolParametersConversionError,
ShelleyBasedEra (..),
toLedgerPParams,
)
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.HeadLogic (
Environment (..),
Event (..),
defaultTTL,
)
import Hydra.Ledger.Cardano qualified as Ledger
import Hydra.Ledger.Cardano.Configuration (
newGlobals,
newLedgerEnv,
protocolParametersFromJson,
readJsonFileThrow,
)
import Hydra.Logging (Verbosity (..), traceWith, withTracer)
import Hydra.Logging.Messages (HydraLog (..))
import Hydra.Logging.Monitoring (withMonitoring)
import Hydra.Network.Authenticate (Authenticated (Authenticated))
import Hydra.Network.Message (Connectivity (..))
import Hydra.Node (
HydraNode (..),
checkHeadState,
createNodeState,
initEnvironment,
loadState,
runHydraNode,
)
import Hydra.Node.EventQueue (EventQueue (..), createEventQueue)
import Hydra.Node.Network (NetworkConfiguration (..), withNetwork)
import Hydra.Options (
ChainConfig (..),
InvalidOptions (..),
LedgerConfig (..),
RunOptions (..),
validateRunOptions,
)
import Hydra.Persistence (createPersistenceIncremental)

data ConfigurationException
= ConfigurationException ProtocolParametersConversionError
| InvalidOptionException InvalidOptions
deriving stock (Show)
deriving anyclass (Exception)

explain :: ConfigurationException -> String
explain = \case
InvalidOptionException MaximumNumberOfPartiesExceeded ->
"Maximum number of parties is currently set to: " <> show maximumNumberOfParties
InvalidOptionException CardanoAndHydraKeysMissmatch ->
"Number of loaded cardano and hydra keys needs to match"
ConfigurationException err ->
"Incorrect protocol parameters configuration provided: " <> show err

run :: RunOptions -> IO ()
run opts = do
either (throwIO . InvalidOptionException) pure $ validateRunOptions opts
let RunOptions{verbosity, monitoringPort, persistenceDir} = opts
env@Environment{party, otherParties, signingKey} <- initEnvironment opts
withTracer verbosity $ \tracer' ->
withMonitoring monitoringPort tracer' $ \tracer -> do
traceWith tracer (NodeOptions opts)
eq@EventQueue{putEvent} <- createEventQueue
let RunOptions{hydraScriptsTxId, chainConfig, ledgerConfig} = opts
protocolParams <- readJsonFileThrow protocolParametersFromJson (cardanoLedgerProtocolParametersFile ledgerConfig)
pparams <- case toLedgerPParams ShelleyBasedEraBabbage protocolParams of
Left err -> throwIO (ConfigurationException err)
Right bpparams -> pure bpparams
withCardanoLedger chainConfig 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 otherParties hydraScriptsTxId
wallet <- mkTinyWallet (contramap DirectChain tracer) chainConfig
withDirectChain (contramap DirectChain tracer) chainConfig ctx wallet chainStateHistory (putEvent . OnChainEvent) $ \chain -> do
-- 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
-- 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 chainConfig protocolParams action = do
let DirectChainConfig{networkId, nodeSocket} = chainConfig
globals <- newGlobals =<< queryGenesisParameters networkId nodeSocket QueryTip
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
17 changes: 1 addition & 16 deletions hydra-node/src/Hydra/Options.hs
Original file line number Diff line number Diff line change
Expand Up @@ -36,7 +36,6 @@ 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.Party (Party)
import Hydra.Version (embeddedRevision, gitRevision, unknownVersion)
import Options.Applicative (
Parser,
Expand Down Expand Up @@ -78,15 +77,6 @@ import Options.Applicative.Help (vsep)
import Paths_hydra_node (version)
import Test.QuickCheck (elements, listOf, listOf1, oneof, suchThat, vectorOf)

data ParamMismatch
= ContestationPeriodMismatch {loadedCp :: ContestationPeriod, configuredCp :: ContestationPeriod}
| PartiesMismatch {loadedParties :: [Party], configuredParties :: [Party]}
deriving stock (Generic, Eq, Show)
deriving anyclass (ToJSON, FromJSON)

instance Arbitrary ParamMismatch where
arbitrary = genericArbitrary

data Command
= Run RunOptions
| Publish PublishOptions
Expand Down Expand Up @@ -619,7 +609,7 @@ contestationPeriodParser =
option
(parseNatural <|> parseNominalDiffTime)
( long "contestation-period"
<> metavar "CONTESTATION-PERIOD"
<> metavar "SECONDS"
<> value defaultContestationPeriod
<> showDefault
<> completer (listCompleter ["60", "180", "300"])
Expand All @@ -643,11 +633,6 @@ data InvalidOptions
| CardanoAndHydraKeysMissmatch
deriving stock (Eq, Show)

explain :: InvalidOptions -> String
explain = \case
MaximumNumberOfPartiesExceeded -> "Maximum number of parties is currently set to: " <> show maximumNumberOfParties
CardanoAndHydraKeysMissmatch -> "Number of loaded cardano and hydra keys needs to match"

-- | 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
Expand Down
20 changes: 20 additions & 0 deletions hydra-node/test/Hydra/Node/RunSpec.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,20 @@
module Hydra.Node.RunSpec where

import Hydra.Node.Run (ConfigurationException, run)
import Hydra.Options (ChainConfig (..), RunOptions (..), defaultRunOptions, genFilePath)
import Hydra.Prelude
import Test.Hydra.Prelude
import Test.QuickCheck (generate)

spec :: Spec
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}

run options `shouldThrow` aConfigurationException

aConfigurationException :: Selector ConfigurationException
aConfigurationException = const True

0 comments on commit a8ce92d

Please sign in to comment.