diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs index c2e3b528870..760db5ebdb2 100644 --- a/hydra-cluster/test/Test/EndToEndSpec.hs +++ b/hydra-cluster/test/Test/EndToEndSpec.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DuplicateRecordFields #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} {-# OPTIONS_GHC -Wno-name-shadowing #-} @@ -19,7 +20,22 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL import qualified Data.Map as Map import qualified Data.Set as Set -import Hydra.Cardano.Api (AddressInEra, Key (SigningKey), NetworkId (Testnet), NetworkMagic (NetworkMagic), PaymentKey, Tx, TxId, TxIn (..), VerificationKey, lovelaceToValue, mkVkAddress, serialiseAddress, serialiseToRawBytesHexText, writeFileTextEnvelope) +import Data.Text (pack) +import Hydra.Cardano.Api ( + AddressInEra, + Key (SigningKey), + NetworkId (Testnet), + NetworkMagic (NetworkMagic), + PaymentKey, + Tx, + TxId, + TxIn (..), + VerificationKey, + lovelaceToValue, + mkVkAddress, + serialiseAddress, + writeFileTextEnvelope, + ) import Hydra.Chain (HeadParameters (contestationPeriod, parties)) import Hydra.Cluster.Faucet ( Marked (Fuel, Normal), @@ -53,7 +69,7 @@ import Hydra.HeadLogic (HeadState (Open), OpenState (parameters)) import Hydra.Ledger (txId) import Hydra.Ledger.Cardano (genKeyPair, mkSimpleTx) import Hydra.Logging (Tracer, showLogsOnFailure) -import Hydra.Options (ChainConfig (startChainFrom)) +import Hydra.Options import Hydra.Party (deriveParty) import HydraNode ( EndToEndLog (..), @@ -75,7 +91,7 @@ import System.IO (hGetLine) import System.IO.Error (isEOFError) import System.Process (CreateProcess (..), StdStream (..), proc, readCreateProcess, withCreateProcess) import System.Timeout (timeout) -import Test.QuickCheck (generate) +import Test.QuickCheck (generate, suchThat) import Text.Regex.TDFA ((=~)) import Text.Regex.TDFA.Text () import qualified Prelude @@ -361,7 +377,7 @@ spec = around showLogsOnFailure $ do line ^? key "message" . key "tag" == Just (Aeson.String "NodeOptions") it "detects misconfiguration" $ \tracer -> do - withTempDir "temp-dir-to-check-hydra-logs" $ \dir -> do + withTempDir "temp-dir-to-check-hydra-misconfiguration" $ \dir -> do withCardanoNodeDevnet (contramap FromCardanoNode tracer) dir $ \node@RunningNode{nodeSocket} -> do hydraScriptsTxId <- publishHydraScriptsAs node Faucet let persistenceDir = dir "persistence" @@ -377,18 +393,17 @@ spec = around showLogsOnFailure $ do -- generate node state to save to a file openState :: OpenState Tx <- generate arbitrary let headParameters = parameters openState - UnsafeContestationPeriod stateContestationPeriod = contestationPeriod headParameters + stateContestationPeriod = Hydra.Chain.contestationPeriod headParameters - -- grab one value for CP different from what we have in the state - let (differentContestationPeriod : _) = - filter (\a -> a /= stateContestationPeriod) [1 .. stateContestationPeriod] + -- generate one value for CP different from what we have in the state + differentContestationPeriod <- generate $ arbitrary `suchThat` (/= stateContestationPeriod) -- alter the state to trigger the errors let alteredNodeState = Open ( openState { parameters = - headParameters{contestationPeriod = UnsafeContestationPeriod differentContestationPeriod, parties = []} + headParameters{contestationPeriod = differentContestationPeriod, parties = []} } ) @@ -398,27 +413,23 @@ spec = around showLogsOnFailure $ do BSL.writeFile (persistenceDir "state") (Aeson.encode alteredNodeState) let nodeArgs = - [ "-n" - , "hydra-node-1" - , "--testnet-magic" - , "42" - , "--cardano-signing-key" - , cardanoSK - , "--hydra-signing-key" - , hydraSK - , "--contestation-period" - , show (contestationPeriod headParameters) - , "--persistence-dir" - , persistenceDir - , "--node-socket" - , nodeSocket - , "--hydra-scripts-tx-id" - , toString $ serialiseToRawBytesHexText hydraScriptsTxId - , "--ledger-genesis" - , "config/devnet/genesis-shelley.json" - , "--ledger-protocol-parameters" - , "config/protocol-parameters.json" - ] + toArgs + defaultRunOptions + { chainConfig = + defaultChainConfig + { cardanoSigningKey = cardanoSK + , nodeSocket + , contestationPeriod = Hydra.Chain.contestationPeriod headParameters + } + , hydraSigningKey = hydraSK + , hydraScriptsTxId + , persistenceDir + , ledgerConfig = + defaultLedgerConfig + { cardanoLedgerGenesisFile = "config/devnet/genesis-shelley.json" + , cardanoLedgerProtocolParametersFile = "config/protocol-parameters.json" + } + } -- expecting misconfiguration withCreateProcess (proc "hydra-node" nodeArgs){std_out = CreatePipe, std_err = CreatePipe} $ @@ -428,9 +439,11 @@ spec = around showLogsOnFailure $ do outline ^? key "message" . key "tag" == Just (Aeson.String "Misconfiguration") -- node should exit with appropriate exception - waitForLog 10 nodeStdErr "Detect PersistenceException" $ \errline -> + waitForLog 10 nodeStdErr "Detect ParamMismatchError" $ \errline -> let allLogLines = lines errline - in "hydra-node: PersistenceException \"OpenState: Contestation period does not match. Parties mismatch. \"" `elem` allLogLines + expectedLog = + "hydra-node: ParamMismatchError \"Loaded state does not match given command line options. Please check the state in: " <> pack persistenceDir <> " against provided command line options.\"" + in expectedLog `elem` allLogLines waitForLog :: NominalDiffTime -> Handle -> Text -> (Text -> Bool) -> IO () waitForLog delay nodeOutput failureMessage predicate = do @@ -579,7 +592,7 @@ initAndClose tracer clusterIx hydraScriptsTxId node@RunningNode{nodeSocket, netw case fromJSON $ toJSON newUTxO of Error err -> failure $ "newUTxO isn't valid JSON?: " <> err - Success u -> + Data.Aeson.Success u -> failAfter 5 $ waitForUTxO networkId nodeSocket u -- diff --git a/hydra-node/exe/hydra-node/Main.hs b/hydra-node/exe/hydra-node/Main.hs index 32cd40a6b1c..d9415302d29 100644 --- a/hydra-node/exe/hydra-node/Main.hs +++ b/hydra-node/exe/hydra-node/Main.hs @@ -49,13 +49,18 @@ import Hydra.Node ( import Hydra.Options ( Command (Publish, Run), LedgerConfig (..), + ParamMismatch (..), PublishOptions (..), RunOptions (..), explain, parseHydraCommand, validateRunOptions, ) -import Hydra.Persistence (Persistence (load), PersistenceException (..), createPersistence, createPersistenceIncremental) +import Hydra.Persistence (Persistence (load), createPersistence, createPersistenceIncremental) + +data ParamMismatchError = ParamMismatchError String deriving (Eq, Show) + +instance Exception ParamMismatchError main :: IO () main = do @@ -87,7 +92,12 @@ main = do let paramsMismatch = checkParamsAgainstExistingState headState env when (not $ null paramsMismatch) $ do traceWith tracer (Misconfiguration paramsMismatch) - throwIO $ PersistenceException $ concat paramsMismatch + throwIO $ + ParamMismatchError $ + "Loaded state does not match given command line options." + <> " Please check the state in: " + <> persistenceDir + <> " against provided command line options." pure headState nodeState <- createNodeState hs ctx <- loadChainContext chainConfig party otherParties hydraScriptsTxId @@ -127,27 +137,25 @@ main = do action (Ledger.cardanoLedger globals ledgerEnv) -- check if hydra-node parameters are matching with the hydra-node state. - -- REVIEW: Should we also check against items we receive on-chain here? e.g. 'OpenThreadOutput' if in Open state? - checkParamsAgainstExistingState :: HeadState Ledger.Tx -> Environment -> [String] + checkParamsAgainstExistingState :: HeadState Ledger.Tx -> Environment -> [ParamMismatch] checkParamsAgainstExistingState hs env = case hs of Idle _ -> [] - Initial InitialState{parameters} -> validateParameters "InitialState: " parameters - Open OpenState{parameters} -> validateParameters "OpenState: " parameters - Closed ClosedState{parameters} -> validateParameters "ClosedState: " parameters + Initial InitialState{parameters} -> validateParameters parameters + Open OpenState{parameters} -> validateParameters parameters + Closed ClosedState{parameters} -> validateParameters parameters where - validateParameters st params = - let res = flip execState [] $ do - when (Hydra.Chain.contestationPeriod params /= cp) $ - modify (<> ["Contestation period does not match. "]) - when (sort (Hydra.Chain.parties params) /= sort envParties) $ - modify (<> ["Parties mismatch. "]) - in case res of - [] -> [] - items -> st : items + validateParameters HeadParameters{contestationPeriod = loadedCp, parties} = + flip execState [] $ do + when (loadedCp /= configuredCp) $ + modify (<> [ContestationPeriodMismatch{loadedCp, configuredCp}]) + when (loadedParties /= configuredParties) $ + modify (<> [PartiesMismatch{loadedParties, configuredParties}]) + where + loadedParties = sort parties - Environment{contestationPeriod = cp, otherParties, party} = env - envParties = party : otherParties + Environment{contestationPeriod = configuredCp, otherParties, party} = env + configuredParties = sort (party : otherParties) identifyNode :: RunOptions -> RunOptions identifyNode opt@RunOptions{verbosity = Verbose "HydraNode", nodeId} = opt{verbosity = Verbose $ "HydraNode-" <> show nodeId} diff --git a/hydra-node/json-schemas/logs.yaml b/hydra-node/json-schemas/logs.yaml index a233f178b46..87c628199fa 100644 --- a/hydra-node/json-schemas/logs.yaml +++ b/hydra-node/json-schemas/logs.yaml @@ -154,13 +154,15 @@ properties: additionalProperties: false required: - tag - - misconfiguredItems + - misconfigurationErrors properties: tag: type: string enum: ["Misconfiguration"] - misconfiguredItems: + misconfigurationErrors: type: array + items: + $ref: "#definitions/ParamMismatch" definitions: APIServer: @@ -436,6 +438,53 @@ definitions: # adtitional 'timestamp' and 'seq'. ServerOutput: {} + ParamMismatch: + oneOf: + - title: ContestationPeriodMismatch + description: >- + The configured contestation period does not match with the value from the loaded state. + type: object + additionalProperties: false + required: + - tag + - loadedCp + - configuredCp + properties: + tag: + type: string + enum: ["ContestationPeriodMismatch"] + loadedCp: + <<: { "$ref": "api.yaml#/components/schemas/ContestationPeriod" } + description: >- + Contestation period present in the node state. + configuredCp: + <<: { "$ref": "api.yaml#/components/schemas/ContestationPeriod" } + description: >- + Contestation period configured as the node argument. + - title: PartiesMismatch + description: >- + The configured parties do not match with the value from the loaded state. + type: object + additionalProperties: false + required: + - tag + - loadedParties + - configuredParties + properties: + tag: + type: string + enum: ["PartiesMismatch"] + loadedParties: + type: array + <<: { "$ref": "api.yaml#/components/schemas/Party" } + description: >- + Parties present in the node state. + configuredParties: + type: array + <<: { "$ref": "api.yaml#/components/schemas/Party" } + description: >- + Parties configured as the node argument. + # TODO: Fill the gap! Network: {} diff --git a/hydra-node/src/Hydra/Logging/Messages.hs b/hydra-node/src/Hydra/Logging/Messages.hs index 27a1f253b2a..1fec6fab34f 100644 --- a/hydra-node/src/Hydra/Logging/Messages.hs +++ b/hydra-node/src/Hydra/Logging/Messages.hs @@ -13,7 +13,7 @@ import Hydra.Prelude import Hydra.API.Server (APIServerLog) import Hydra.Chain.Direct.Handlers (DirectChainLog) import Hydra.Node (HydraNodeLog) -import Hydra.Options (RunOptions) +import Hydra.Options (ParamMismatch, RunOptions) data HydraLog tx net = DirectChain {directChain :: DirectChainLog} @@ -23,7 +23,7 @@ data HydraLog tx net | CreatedState | LoadedState | NodeOptions {runOptions :: RunOptions} - | Misconfiguration {misconfiguredItems :: [String]} + | Misconfiguration {misconfigurationErrors :: [ParamMismatch]} deriving (Generic) deriving instance (Eq net, Eq (HydraNodeLog tx)) => Eq (HydraLog tx net) diff --git a/hydra-node/src/Hydra/Options.hs b/hydra-node/src/Hydra/Options.hs index c911c954b42..7b977b0ffb5 100644 --- a/hydra-node/src/Hydra/Options.hs +++ b/hydra-node/src/Hydra/Options.hs @@ -10,7 +10,7 @@ import Hydra.Prelude import Control.Arrow (left) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC -import Data.IP (IP (IPv4), toIPv4w) +import Data.IP (IP (IPv4), toIPv4, toIPv4w) import Data.Text (unpack) import qualified Data.Text as T import Data.Time.Clock (nominalDiffTimeToSeconds) @@ -21,7 +21,7 @@ import Hydra.Cardano.Api ( NetworkId (..), NetworkMagic (..), SlotNo (..), - TxId, + TxId (..), UsingRawBytesHex (..), deserialiseFromRawBytes, deserialiseFromRawBytesBase16, @@ -34,6 +34,7 @@ import qualified Hydra.Contract 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 (gitDescribe) import Options.Applicative ( Parser, @@ -79,6 +80,14 @@ import Test.QuickCheck (elements, listOf, listOf1, oneof, suchThat, vectorOf) maximumNumberOfParties :: Int maximumNumberOfParties = 4 +data ParamMismatch + = ContestationPeriodMismatch {loadedCp :: ContestationPeriod, configuredCp :: ContestationPeriod} + | PartiesMismatch {loadedParties :: [Party], configuredParties :: [Party]} + deriving (Generic, Eq, Show, ToJSON) + +instance Arbitrary ParamMismatch where + arbitrary = genericArbitrary + data Command = Run RunOptions | Publish PublishOptions @@ -716,6 +725,27 @@ toArgs , contestationPeriod } = chainConfig +defaultRunOptions :: RunOptions +defaultRunOptions = + RunOptions + { verbosity = Verbose "HydraNode" + , nodeId = NodeId "hydra-node-1" + , host = localhost + , port = 5001 + , peers = [] + , apiHost = localhost + , apiPort = 4001 + , monitoringPort = Nothing + , hydraSigningKey = "hydra.sk" + , hydraVerificationKeys = [] + , hydraScriptsTxId = TxId "0101010101010101010101010101010101010101010101010101010101010101" + , persistenceDir = "./" + , chainConfig = defaultChainConfig + , ledgerConfig = defaultLedgerConfig + } + where + localhost = IPv4 $ toIPv4 [127, 0, 0, 1] + toArgNetworkId :: NetworkId -> [String] toArgNetworkId = \case Mainnet -> ["--mainnet"]