diff --git a/CHANGELOG.md b/CHANGELOG.md index 777d47ff2e6..5c10e79a4c7 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -30,6 +30,7 @@ changes. - Hydra.Options split into Hydra.Options.Common, Hydra.Options.Offline, Hydra.Options.Online, re-exported from Hydra.Options. +- Report error on unsupported era. ## [0.14.0] - 2023-12-04 diff --git a/fourmolu.yaml b/fourmolu.yaml index 031b5d9090e..505a5b73c80 100644 --- a/fourmolu.yaml +++ b/fourmolu.yaml @@ -12,3 +12,4 @@ fixities: - infixr 1 & - infixl 3 <|> - infixr 3 && + - infixl 1 <&> diff --git a/hydra-cluster/bench/Bench/EndToEnd.hs b/hydra-cluster/bench/Bench/EndToEnd.hs index 7cd2cd4d764..aad655cc063 100644 --- a/hydra-cluster/bench/Bench/EndToEnd.hs +++ b/hydra-cluster/bench/Bench/EndToEnd.hs @@ -257,7 +257,7 @@ commitUTxO node clients Dataset{clientDatasets} = doCommit (client, ClientDataset{initialUTxO, clientKeys = ClientKeys{externalSigningKey}}) = do requestCommitTx client initialUTxO <&> signTx externalSigningKey - >>= submitTx node + >>= submitTx node pure initialUTxO processTransactions :: [HydraClient] -> Dataset -> IO (Map.Map TxId Event) diff --git a/hydra-cluster/config/devnet/genesis-conway.json b/hydra-cluster/config/devnet/genesis-conway.json index 14d9c0f65c8..5bad6d55103 100644 --- a/hydra-cluster/config/devnet/genesis-conway.json +++ b/hydra-cluster/config/devnet/genesis-conway.json @@ -1,4 +1,5 @@ { + "genDelegs": {}, "poolVotingThresholds": { "pvtCommitteeNormal": 0.51, "pvtCommitteeNoConfidence": 0.51, diff --git a/hydra-cluster/config/devnet/genesis-shelley.json b/hydra-cluster/config/devnet/genesis-shelley.json index 555a4f9ff82..37e81defc7c 100644 --- a/hydra-cluster/config/devnet/genesis-shelley.json +++ b/hydra-cluster/config/devnet/genesis-shelley.json @@ -1,5 +1,5 @@ { - "epochLength": 432000, + "epochLength": 5, "activeSlotsCoeff": 1.0, "slotLength": 0.1, "securityParam": 2160, diff --git a/hydra-cluster/src/CardanoNode.hs b/hydra-cluster/src/CardanoNode.hs index e137b96548e..66725cd7a63 100644 --- a/hydra-cluster/src/CardanoNode.hs +++ b/hydra-cluster/src/CardanoNode.hs @@ -4,13 +4,13 @@ module CardanoNode where import Hydra.Prelude -import Control.Lens ((^?!)) +import Control.Lens ((?~), (^?!)) import Control.Tracer (Tracer, traceWith) -import Data.Aeson ((.=)) +import Data.Aeson (Value (String), (.=)) import Data.Aeson qualified as Aeson -import Data.Aeson.KeyMap qualified as Aeson.KeyMap -import Data.Aeson.Lens (key, _Number) +import Data.Aeson.Lens (atKey, key, _Number) import Data.Fixed (Centi) +import Data.Text qualified as Text import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds) import Hydra.Cardano.Api (AsType (AsPaymentKey), File (..), NetworkId, PaymentKey, SigningKey, SocketPath, VerificationKey, generateSigningKey, getVerificationKey) import Hydra.Cardano.Api qualified as Api @@ -77,7 +77,7 @@ defaultCardanoNodeArgs :: CardanoNodeArgs defaultCardanoNodeArgs = CardanoNodeArgs { nodeSocket = "node.socket" - , nodeConfigFile = "configuration.json" + , nodeConfigFile = "cardano-node.json" , nodeByronGenesisFile = "genesis-byron.json" , nodeShelleyGenesisFile = "genesis-shelley.json" , nodeAlonzoGenesisFile = "genesis-alonzo.json" @@ -117,28 +117,7 @@ withCardanoNodeDevnet :: (RunningNode -> IO a) -> IO a withCardanoNodeDevnet tracer stateDirectory action = do - createDirectoryIfMissing True stateDirectory - [dlgCert, signKey, vrfKey, kesKey, opCert] <- - mapM - copyDevnetCredential - [ "byron-delegation.cert" - , "byron-delegate.key" - , "vrf.skey" - , "kes.skey" - , "opcert.cert" - ] - let args = - defaultCardanoNodeArgs - { nodeDlgCertFile = Just dlgCert - , nodeSignKeyFile = Just signKey - , nodeVrfKeyFile = Just vrfKey - , nodeKesKeyFile = Just kesKey - , nodeOpCertFile = Just opCert - } - copyDevnetFiles args - refreshSystemStart stateDirectory args - writeTopology [] args - + args <- setupCardanoDevnet stateDirectory withCardanoNode tracer networkId stateDirectory args $ \rn -> do traceWith tracer MsgNodeIsReady action rn @@ -146,35 +125,6 @@ withCardanoNodeDevnet tracer stateDirectory action = do -- NOTE: This needs to match what's in config/genesis-shelley.json networkId = defaultNetworkId - copyDevnetCredential file = do - let destination = stateDirectory file - unlessM (doesFileExist destination) $ - readConfigFile ("devnet" file) - >>= writeFileBS destination - setFileMode destination ownerReadMode - pure file - - copyDevnetFiles args = do - readConfigFile ("devnet" "cardano-node.json") - >>= writeFileBS - (stateDirectory nodeConfigFile args) - readConfigFile ("devnet" "genesis-byron.json") - >>= writeFileBS - (stateDirectory nodeByronGenesisFile args) - readConfigFile ("devnet" "genesis-shelley.json") - >>= writeFileBS - (stateDirectory nodeShelleyGenesisFile args) - readConfigFile ("devnet" "genesis-alonzo.json") - >>= writeFileBS - (stateDirectory nodeAlonzoGenesisFile args) - readConfigFile ("devnet" "genesis-conway.json") - >>= writeFileBS - (stateDirectory nodeConwayGenesisFile args) - - writeTopology peers args = - Aeson.encodeFile (stateDirectory nodeTopologyFile args) $ - mkTopology peers - -- | Run a cardano-node as normal network participant on a known network. withCardanoNodeOnKnownNetwork :: Tracer IO NodeLog -> @@ -205,7 +155,7 @@ withCardanoNodeOnKnownNetwork tracer workDir knownNetwork action = do readNetworkId = do shelleyGenesis :: Aeson.Value <- unsafeDecodeJson =<< readFileBS (workDir "shelley-genesis.json") if shelleyGenesis ^?! key "networkId" == "Mainnet" - then pure $ Api.Mainnet + then pure Api.Mainnet else do let magic = shelleyGenesis ^?! key "networkMagic" . _Number pure $ Api.Testnet (Api.NetworkMagic $ truncate magic) @@ -241,6 +191,73 @@ withCardanoNodeOnKnownNetwork tracer workDir knownNetwork action = do fetchConfigFile path = parseRequestThrow path >>= httpBS <&> getResponseBody +-- | Setup the cardano-node to run a local devnet producing blocks. This copies +-- the appropriate files and prepares 'CardanoNodeArgs' for 'withCardanoNode'. +setupCardanoDevnet :: FilePath -> IO CardanoNodeArgs +setupCardanoDevnet stateDirectory = do + createDirectoryIfMissing True stateDirectory + [dlgCert, signKey, vrfKey, kesKey, opCert] <- + mapM + copyDevnetCredential + [ "byron-delegation.cert" + , "byron-delegate.key" + , "vrf.skey" + , "kes.skey" + , "opcert.cert" + ] + let args = + defaultCardanoNodeArgs + { nodeDlgCertFile = Just dlgCert + , nodeSignKeyFile = Just signKey + , nodeVrfKeyFile = Just vrfKey + , nodeKesKeyFile = Just kesKey + , nodeOpCertFile = Just opCert + } + copyDevnetFiles args + refreshSystemStart stateDirectory args + writeTopology [] args + pure args + where + copyDevnetCredential file = do + let destination = stateDirectory file + unlessM (doesFileExist destination) $ + readConfigFile ("devnet" file) + >>= writeFileBS destination + setFileMode destination ownerReadMode + pure file + + copyDevnetFiles args = do + readConfigFile ("devnet" "cardano-node.json") + >>= writeFileBS + (stateDirectory nodeConfigFile args) + readConfigFile ("devnet" "genesis-byron.json") + >>= writeFileBS + (stateDirectory nodeByronGenesisFile args) + readConfigFile ("devnet" "genesis-shelley.json") + >>= writeFileBS + (stateDirectory nodeShelleyGenesisFile args) + readConfigFile ("devnet" "genesis-alonzo.json") + >>= writeFileBS + (stateDirectory nodeAlonzoGenesisFile args) + readConfigFile ("devnet" "genesis-conway.json") + >>= writeFileBS + (stateDirectory nodeConwayGenesisFile args) + + writeTopology peers args = + Aeson.encodeFile (stateDirectory nodeTopologyFile args) $ + mkTopology peers + +-- | Modify the cardano-node configuration to fork into conway at given era +-- number. +forkIntoConwayInEpoch :: FilePath -> CardanoNodeArgs -> Natural -> IO () +forkIntoConwayInEpoch stateDirectory args n = do + config <- + unsafeDecodeJsonFile @Aeson.Value (stateDirectory nodeConfigFile args) + <&> atKey "TestConwayHardForkAtEpoch" ?~ toJSON n + Aeson.encodeFile + (stateDirectory nodeConfigFile args) + config + withCardanoNode :: Tracer IO NodeLog -> NetworkId -> @@ -341,19 +358,19 @@ refreshSystemStart stateDirectory args = do systemStart <- initSystemStart let startTime = round @_ @Int $ utcTimeToPOSIXSeconds systemStart byronGenesis <- - unsafeDecodeJsonFile (stateDirectory nodeByronGenesisFile args) - <&> addField "startTime" startTime + unsafeDecodeJsonFile @Aeson.Value (stateDirectory nodeByronGenesisFile args) + <&> atKey "startTime" ?~ toJSON startTime let systemStartUTC = posixSecondsToUTCTime . fromRational . toRational $ startTime shelleyGenesis <- - unsafeDecodeJsonFile (stateDirectory nodeShelleyGenesisFile args) - <&> addField "systemStart" systemStartUTC + unsafeDecodeJsonFile @Aeson.Value (stateDirectory nodeShelleyGenesisFile args) + <&> atKey "systemStart" ?~ toJSON systemStartUTC config <- - unsafeDecodeJsonFile (stateDirectory nodeConfigFile args) - <&> addField "ByronGenesisFile" (nodeByronGenesisFile args) - <&> addField "ShelleyGenesisFile" (nodeShelleyGenesisFile args) + unsafeDecodeJsonFile @Aeson.Value (stateDirectory nodeConfigFile args) + <&> (atKey "ByronGenesisFile" ?~ toJSON (Text.pack $ nodeByronGenesisFile args)) + . (atKey "ShelleyGenesisFile" ?~ String (Text.pack $ nodeShelleyGenesisFile args)) Aeson.encodeFile (stateDirectory nodeByronGenesisFile args) @@ -402,9 +419,6 @@ data NodeLog -- Helpers -- -addField :: ToJSON a => Aeson.Key -> a -> Aeson.Value -> Aeson.Value -addField k v = withObject (Aeson.KeyMap.insert k (toJSON v)) - -- | Do something with an a JSON object. Fails if the given JSON value isn't an -- object. withObject :: (Aeson.Object -> Aeson.Object) -> Aeson.Value -> Aeson.Value diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs index 38cb83f2ecf..3922f732a69 100644 --- a/hydra-cluster/src/HydraNode.hs +++ b/hydra-cluster/src/HydraNode.hs @@ -367,7 +367,7 @@ withHydraNode :: withHydraNode tracer chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds hydraScriptsTxId action = do withLogFile logFilePath $ \logFileHandle -> do withHydraNode' chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds hydraScriptsTxId (Just logFileHandle) $ do - \_ processHandle -> do + \_ _ processHandle -> do race (checkProcessHasNotDied ("hydra-node (" <> show hydraNodeId <> ")") processHandle) (withConnectionToNode tracer hydraNodeId action) @@ -388,7 +388,7 @@ withHydraNode' :: TxId -> -- | If given use this as std out. Maybe Handle -> - (Handle -> ProcessHandle -> IO a) -> + (Handle -> Handle -> ProcessHandle -> IO a) -> IO a withHydraNode' chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds hydraScriptsTxId mGivenStdOut action = do withSystemTempDirectory "hydra-node" $ \dir -> do @@ -423,13 +423,13 @@ withHydraNode' chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds h } ) { std_out = maybe CreatePipe UseHandle mGivenStdOut - , std_err = Inherit + , std_err = CreatePipe } - withCreateProcess p $ \_stdin mCreatedHandle mErr processHandle -> - case (mCreatedHandle, mGivenStdOut, mErr) of - (Just out, _, _) -> action out processHandle - (Nothing, Just out, _) -> action out processHandle - (_, _, _) -> error "Should not happen™" + withCreateProcess p $ \_stdin mCreatedStdOut mCreatedStdErr processHandle -> + case (mCreatedStdOut <|> mGivenStdOut, mCreatedStdErr) of + (Just out, Just err) -> action out err processHandle + (Nothing, _) -> error "Should not happen™" + (_, Nothing) -> error "Should not happen™" where peers = [ Host diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs index 0784e7fc808..50e91c5844d 100644 --- a/hydra-cluster/test/Test/EndToEndSpec.hs +++ b/hydra-cluster/test/Test/EndToEndSpec.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -{-# OPTIONS_GHC -Wno-name-shadowing #-} module Test.EndToEndSpec where @@ -8,17 +7,26 @@ 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 CardanoClient (QueryPoint (..), queryEpochNo, queryGenesisParameters, queryTip, queryTipSlotNo, submitTx, waitForUTxO) +import CardanoNode ( + CardanoNodeArgs (..), + RunningNode (..), + forkIntoConwayInEpoch, + setupCardanoDevnet, + unsafeDecodeJsonFile, + withCardanoNode, + withCardanoNodeDevnet, + ) import Control.Concurrent.STM (newTVarIO, readTVarIO) import Control.Concurrent.STM.TVar (modifyTVar') import Control.Lens ((^..), (^?)) import Data.Aeson (Result (..), Value (Null, Object, String), fromJSON, object, (.=)) import Data.Aeson qualified as Aeson -import Data.Aeson.Lens (key, values, _JSON) +import Data.Aeson.Lens (key, values, _Double, _JSON) import Data.ByteString qualified as BS import Data.Map qualified as Map import Data.Set qualified as Set +import Data.Text qualified as Text import Data.Time (secondsToDiffTime) import Hydra.Cardano.Api ( AddressInEra, @@ -34,6 +42,7 @@ import Hydra.Cardano.Api ( mkVkAddress, serialiseAddress, signTx, + unEpochNo, pattern TxOut, pattern TxValidityLowerBound, ) @@ -54,6 +63,8 @@ import Hydra.Cluster.Fixture ( carol, carolSk, carolVk, + cperiod, + defaultNetworkId, ) import Hydra.Cluster.Scenarios ( EndToEndLog (..), @@ -73,12 +84,10 @@ import Hydra.Cluster.Scenarios ( ) import Hydra.Cluster.Util (chainConfigFor, keysFor) import Hydra.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod)) -import Hydra.Crypto (generateSigningKey) import Hydra.Ledger (txId) import Hydra.Ledger.Cardano (genKeyPair, genUTxOFor, mkRangedTx, mkSimpleTx) import Hydra.Logging (Tracer, showLogsOnFailure) import Hydra.Options -import Hydra.Party (deriveParty) import HydraNode ( HydraClient (..), getMetrics, @@ -96,9 +105,14 @@ import HydraNode ( withOfflineHydraNode, ) import System.Directory (removeDirectoryRecursive) +import System.Exit (ExitCode (ExitFailure)) import System.FilePath (()) -import System.IO (hGetLine) +import System.IO ( + hGetContents, + hGetLine, + ) import System.IO.Error (isEOFError) +import System.Process (waitForProcess) import Test.QuickCheck (generate) import Prelude qualified @@ -116,7 +130,7 @@ 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 -> do let networkId = Testnet (NetworkMagic 42) -- from defaultChainConfig (aliceCardanoVk, aliceCardanoSk) <- keysFor Alice (bobCardanoVk, _) <- keysFor Bob @@ -471,7 +485,7 @@ spec = around (showLogsOnFailure "EndToEndSpec") $ do withCardanoNodeDevnet (contramap FromCardanoNode tracer) dir $ \node@RunningNode{nodeSocket} -> do chainConfig <- chainConfigFor Alice dir nodeSocket [] (UnsafeContestationPeriod 1) hydraScriptsTxId <- publishHydraScriptsAs node Faucet - withHydraNode' chainConfig dir 1 aliceSk [] [1] hydraScriptsTxId Nothing $ \stdOut _processHandle -> do + withHydraNode' chainConfig dir 1 aliceSk [] [1] hydraScriptsTxId Nothing $ \stdOut _ _processHandle -> do waitForLog 10 stdOut "JSON object with key NodeOptions" $ \line -> line ^? key "message" . key "tag" == Just (Aeson.String "NodeOptions") @@ -495,6 +509,58 @@ spec = around (showLogsOnFailure "EndToEndSpec") $ do logfile <- readFileBS logFilePath BS.length logfile `shouldSatisfy` (> 0) + describe "forking eras" $ do + it "does report on unsupported era" $ \tracer -> do + withClusterTempDir "unsupported-era" $ \tmpDir -> do + args <- setupCardanoDevnet tmpDir + forkIntoConwayInEpoch tmpDir args 1 + withCardanoNode (contramap FromCardanoNode tracer) defaultNetworkId tmpDir args $ + \node@RunningNode{nodeSocket} -> do + hydraScriptsTxId <- publishHydraScriptsAs node Faucet + chainConfig <- chainConfigFor Alice tmpDir nodeSocket [] cperiod + withHydraNode' chainConfig tmpDir 1 aliceSk [] [1] hydraScriptsTxId Nothing $ \out err ph -> do + -- Assert nominal startup + waitForLog 5 out "missing NodeOptions" (Text.isInfixOf "NodeOptions") + + waitUntilEpoch tmpDir args node 1 + + waitForProcess ph `shouldReturn` ExitFailure 1 + errorOutputs <- hGetContents err + errorOutputs `shouldContain` "Received blocks in unsupported era" + errorOutputs `shouldContain` "upgrade your hydra-node" + + it "does report on unsupported era on startup" $ \tracer -> do + withClusterTempDir "unsupported-era-startup" $ \tmpDir -> do + args <- setupCardanoDevnet tmpDir + forkIntoConwayInEpoch tmpDir args 1 + withCardanoNode (contramap FromCardanoNode tracer) defaultNetworkId tmpDir args $ + \node@RunningNode{nodeSocket} -> do + hydraScriptsTxId <- publishHydraScriptsAs node Faucet + chainConfig <- chainConfigFor Alice tmpDir nodeSocket [] cperiod + + waitUntilEpoch tmpDir args node 2 + + withHydraNode' chainConfig tmpDir 1 aliceSk [] [1] hydraScriptsTxId Nothing $ \_out err ph -> do + waitForProcess ph `shouldReturn` ExitFailure 1 + errorOutputs <- hGetContents err + errorOutputs `shouldContain` "Connected to cardano-node in unsupported era" + errorOutputs `shouldContain` "upgrade your hydra-node" + +-- | Wait until given number of epoch. This uses the epoch and slot lengths from +-- the 'ShelleyGenesisFile' of the node args passed in. +waitUntilEpoch :: FilePath -> CardanoNodeArgs -> RunningNode -> Natural -> IO () +waitUntilEpoch stateDirectory args RunningNode{networkId, nodeSocket} toEpochNo = do + fromEpochNo :: Natural <- fromIntegral . unEpochNo <$> queryEpochNo networkId nodeSocket QueryTip + toEpochNo `shouldSatisfy` (> fromEpochNo) + shellyGenesisFile :: Aeson.Value <- unsafeDecodeJsonFile (stateDirectory nodeShelleyGenesisFile args) + let slotLength = + fromMaybe (error "Field epochLength not found") $ + shellyGenesisFile ^? key "slotLength" . _Double + epochLength = + fromMaybe (error "Field epochLength not found") $ + shellyGenesisFile ^? key "epochLength" . _Double + threadDelay . realToFrac $ fromIntegral (toEpochNo - fromEpochNo) * epochLength * slotLength + waitForLog :: DiffTime -> Handle -> Text -> (Text -> Bool) -> IO () waitForLog delay nodeOutput failureMessage predicate = do seenLogs <- newTVarIO [] @@ -525,8 +591,6 @@ waitForLog delay nodeOutput failureMessage predicate = do timedTx :: FilePath -> Tracer IO EndToEndLog -> RunningNode -> TxId -> IO () timedTx tmpDir tracer node@RunningNode{networkId, nodeSocket} hydraScriptsTxId = do (aliceCardanoVk, _) <- keysFor Alice - let aliceSk = generateSigningKey "alice-timed" - let alice = deriveParty aliceSk let contestationPeriod = UnsafeContestationPeriod 2 aliceChainConfig <- chainConfigFor Alice tmpDir nodeSocket [] contestationPeriod let hydraTracer = contramap FromHydraNode tracer diff --git a/hydra-node/exe/hydra-node/Main.hs b/hydra-node/exe/hydra-node/Main.hs index f7eadbfddff..d6cf2e9efd7 100644 --- a/hydra-node/exe/hydra-node/Main.hs +++ b/hydra-node/exe/hydra-node/Main.hs @@ -10,7 +10,7 @@ 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, runOffline) +import Hydra.Node.Run (run, runOffline) import Hydra.Options ( Command (GenHydraKey, Publish, Run, RunOffline), PublishOptions (..), @@ -25,9 +25,9 @@ main = do command <- parseHydraCommand case command of Run options -> - run (identifyNode options) `catch` (die . explain) + run (identifyNode options) `catch` \(SomeException e) -> die $ displayException e RunOffline options -> - runOffline options `catch` (die . explain) + runOffline options `catch` \(SomeException e) -> die $ displayException e Publish options -> publish options GenHydraKey outputFile -> diff --git a/hydra-node/src/Hydra/Chain/CardanoClient.hs b/hydra-node/src/Hydra/Chain/CardanoClient.hs index e50bccb8fa4..bdc8f880d02 100644 --- a/hydra-node/src/Hydra/Chain/CardanoClient.hs +++ b/hydra-node/src/Hydra/Chain/CardanoClient.hs @@ -11,8 +11,9 @@ import Hydra.Cardano.Api hiding (Block) import Cardano.Api.UTxO qualified as UTxO import Cardano.Ledger.Core (PParams) import Data.Set qualified as Set -import Ouroboros.Consensus.HardFork.Combinator.AcrossEras (EraMismatch) +import Ouroboros.Consensus.Cardano.Block (EraMismatch (..)) import Test.QuickCheck (oneof) +import Text.Printf (printf) data QueryException = QueryAcquireException AcquiringFailure @@ -29,7 +30,12 @@ instance Eq QueryException where (QueryEraMismatchException em1, QueryEraMismatchException em2) -> em1 == em2 _ -> False -instance Exception QueryException +instance Exception QueryException where + displayException = \case + QueryAcquireException failure -> show failure + QueryEraMismatchException EraMismatch{ledgerEraName, otherEraName} -> + printf "Connected to cardano-node in unsupported era %s. Please upgrade your hydra-node to era %s." otherEraName ledgerEraName + QueryProtocolParamsConversionException err -> show err -- * CardanoClient handle @@ -217,6 +223,24 @@ queryEraHistory :: NetworkId -> SocketPath -> QueryPoint -> IO (EraHistory Carda queryEraHistory networkId socket queryPoint = runQuery networkId socket queryPoint $ QueryEraHistory CardanoModeIsMultiEra +-- | Query the current epoch number. +-- +-- Throws at least 'QueryException' if query fails. +queryEpochNo :: + NetworkId -> + SocketPath -> + QueryPoint -> + IO EpochNo +queryEpochNo networkId socket queryPoint = do + let query = + QueryInEra + BabbageEraInCardanoMode + ( QueryInShelleyBasedEra + ShelleyBasedEraBabbage + QueryEpoch + ) + runQuery networkId socket queryPoint query >>= throwOnEraMismatch + -- | Query the protocol parameters at given point. -- -- Throws at least 'QueryException' if query fails. diff --git a/hydra-node/src/Hydra/Chain/Direct.hs b/hydra-node/src/Hydra/Chain/Direct.hs index fdda726cb6e..db0cacc9596 100644 --- a/hydra-node/src/Hydra/Chain/Direct.hs +++ b/hydra-node/src/Hydra/Chain/Direct.hs @@ -25,6 +25,7 @@ import Control.Monad.Trans.Except (runExcept) import Hydra.Cardano.Api ( Block (..), BlockInMode (..), + CardanoEra (BabbageEra), CardanoMode, ChainPoint, ChainTip, @@ -100,6 +101,7 @@ import Ouroboros.Network.Protocol.LocalTxSubmission.Client ( LocalTxSubmissionClient (..), SubmitResult (..), ) +import Text.Printf (printf) -- | Build the 'ChainContext' from a 'ChainConfig' and additional information. loadChainContext :: @@ -249,10 +251,21 @@ instance Exception ConnectException newtype IntersectionNotFoundException = IntersectionNotFound { requestedPoint :: ChainPoint } - deriving stock (Show) + deriving newtype (Show) instance Exception IntersectionNotFoundException +data ChainClientException = EraNotSupportedException + { otherEraName :: Text + , ledgerEraName :: Text + } + deriving stock (Show) + +instance Exception ChainClientException where + displayException = \case + EraNotSupportedException{ledgerEraName, otherEraName} -> + printf "Received blocks in unsupported era %s. Please upgrade your hydra-node to era %s." otherEraName ledgerEraName + -- | The block type used in the node-to-client protocols. type BlockType = BlockInMode CardanoMode @@ -297,11 +310,7 @@ chainSyncClient handler wallet startingPoint = -- Observe Hydra transactions onRollForward handler header txs pure clientStIdle - _ -> - -- NOTE: We are just ignoring different era blocks. It's not - -- entirely clear if we would reach this point on a "next-era" - -- network (e.g. Conway) or just have a handshake problem before. - pure clientStIdle + (BlockInMode era _ _) -> throwIO $ EraNotSupportedException{ledgerEraName = show era, otherEraName = show BabbageEra} , recvMsgRollBackward = \point _tip -> ChainSyncClient $ do -- Re-initialize the tiny wallet reset wallet diff --git a/hydra-node/src/Hydra/Node/Run.hs b/hydra-node/src/Hydra/Node/Run.hs index da026f6efcb..ff623490ff8 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -72,16 +72,15 @@ 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 +instance Exception ConfigurationException where + displayException = \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 runOffline :: RunOfflineOptions -> IO () runOffline opts = do @@ -218,13 +217,10 @@ loadGlobalsFromGenesis ledgerGenesisFile = do let genesisParameters = fromShelleyGenesis <$> shelleyGenesis - globals <- - maybe - (pure $ defaultGlobals{Ledger.systemStart = systemStart}) - newGlobals - genesisParameters - - pure globals + maybe + (pure $ defaultGlobals{Ledger.systemStart = systemStart}) + newGlobals + genesisParameters -- | Taken from Cardano.Api.GenesisParameters, a private module in cardano-api fromShelleyGenesis :: Shelley.ShelleyGenesis Ledger.StandardCrypto -> GenesisParameters Shelley.ShelleyEra diff --git a/hydra-tui/src/Hydra/Client.hs b/hydra-tui/src/Hydra/Client.hs index 715a03d168f..0b019ce706c 100644 --- a/hydra-tui/src/Hydra/Client.hs +++ b/hydra-tui/src/Hydra/Client.hs @@ -98,8 +98,8 @@ withClient Options{hydraNodeHost = Host{hostname, port}, cardanoSigningKey, card externalCommit' sk payload = runReq defaultHttpConfig request <&> responseBody - >>= \DraftCommitTxResponse{commitTx} -> - submitTransaction cardanoNetworkId cardanoNodeSocket $ signTx sk commitTx + >>= \DraftCommitTxResponse{commitTx} -> + submitTransaction cardanoNetworkId cardanoNodeSocket $ signTx sk commitTx where request = Req.req