diff --git a/src/base/lib/Convex/NodeQueries.hs b/src/base/lib/Convex/NodeQueries.hs index 9f41cc8b..1af4efd0 100644 --- a/src/base/lib/Convex/NodeQueries.hs +++ b/src/base/lib/Convex/NodeQueries.hs @@ -32,6 +32,7 @@ module Convex.NodeQueries( queryEpoch, queryLocalState, queryProtocolParameters, + queryProtocolParametersUpdate, queryStakePools, queryStakeAddresses, queryUTxOFilter @@ -267,6 +268,13 @@ queryProtocolParameters :: LocalNodeConnectInfo -> IO (PParams StandardConway) queryProtocolParameters connectInfo = runEraQuery connectInfo $ EraQuery{eqQuery = CAPI.QueryProtocolParameters, eqResult = id} +-- | Get all the protocol parameter updates from the local cardano node +-- Throws 'QueryException' if the node's era is not conway or if the connection +-- to the node cannot be acquired +queryProtocolParametersUpdate :: LocalNodeConnectInfo -> IO (Map (CAPI.Hash CAPI.GenesisKey) CAPI.ProtocolParametersUpdate) +queryProtocolParametersUpdate connectInfo = runEraQuery @CAPI.ConwayEra connectInfo $ + EraQuery{eqQuery = CAPI.QueryProtocolParametersUpdate, eqResult = id} + -- | Get the stake and the IDs of the stake pool for a set of stake credentials -- Throws 'QueryException' if the node's era is not supported or if the connection -- to the node cannot be acquired diff --git a/src/devnet/config/devnet/cardano-node.json b/src/devnet/config/devnet/cardano-node.json index 88801310..079020b4 100644 --- a/src/devnet/config/devnet/cardano-node.json +++ b/src/devnet/config/devnet/cardano-node.json @@ -13,6 +13,8 @@ "LastKnownBlockVersion-Major": 6, "LastKnownBlockVersion-Minor": 0, + "ExperimentalHardForksEnabled": true, + "ExperimentalProtocolsEnabled": true, "TestShelleyHardForkAtEpoch": 0, "TestAllegraHardForkAtEpoch": 0, "TestMaryHardForkAtEpoch": 0, @@ -74,8 +76,5 @@ "mapSubtrace": { "cardano.node.metrics": { "subtrace": "Neutral" } } - }, - - "ExperimentalHardForksEnabled": true, - "ExperimentalProtocolsEnabled": true + } } diff --git a/src/devnet/config/devnet/genesis-shelley.json b/src/devnet/config/devnet/genesis-shelley.json index 9e55b255..e0966aa9 100644 --- a/src/devnet/config/devnet/genesis-shelley.json +++ b/src/devnet/config/devnet/genesis-shelley.json @@ -30,7 +30,7 @@ "nOpt": 100, "poolDeposit": 0, "protocolVersion": { - "major": 7, + "major": 2, "minor": 0 }, "rho": 0.003, diff --git a/src/devnet/convex-devnet.cabal b/src/devnet/convex-devnet.cabal index 02f0b8c7..224c97fa 100644 --- a/src/devnet/convex-devnet.cabal +++ b/src/devnet/convex-devnet.cabal @@ -52,7 +52,6 @@ library build-depends: base >= 4.14.0 , aeson - , lens-aeson , text , time , bytestring @@ -108,6 +107,9 @@ test-suite convex-devnet-test , tasty-hunit , convex-devnet , convex-base + , convex-node-client + , ouroboros-consensus-cardano + , ouroboros-consensus-protocol , cardano-api , contra-tracer , cardano-ledger-api diff --git a/src/devnet/lib/Convex/Devnet/CardanoNode/Types.hs b/src/devnet/lib/Convex/Devnet/CardanoNode/Types.hs index 1fa4f837..9d458211 100644 --- a/src/devnet/lib/Convex/Devnet/CardanoNode/Types.hs +++ b/src/devnet/lib/Convex/Devnet/CardanoNode/Types.hs @@ -12,7 +12,6 @@ module Convex.Devnet.CardanoNode.Types ( defaultStakePoolNodeParams, -- * Genesis config changes GenesisConfigChanges (..), - forkIntoConwayInEpoch, allowLargeTransactions, setEpochLength ) where @@ -27,13 +26,11 @@ import Cardano.Ledger.BaseTypes (EpochSize) import qualified Cardano.Ledger.Core as Core import Cardano.Ledger.Shelley.API (Coin) import Cardano.Ledger.Shelley.Genesis (ShelleyGenesis (..)) -import Control.Lens (over, set) +import Control.Lens (over) import Data.Aeson (FromJSON, ToJSON) import qualified Data.Aeson as Aeson -import Data.Aeson.Lens (atKey) import Data.Ratio ((%)) import GHC.Generics (Generic) -import Numeric.Natural (Natural) import Ouroboros.Consensus.Shelley.Eras (ShelleyEra, StandardCrypto) type Port = Int @@ -122,11 +119,6 @@ instance Semigroup GenesisConfigChanges where instance Monoid GenesisConfigChanges where mempty = GenesisConfigChanges id id id id --- | Set the 'TestConwayHardForkAtEpoch' field to the given value (can be 0) -forkIntoConwayInEpoch :: Natural -> GenesisConfigChanges -forkIntoConwayInEpoch n = - mempty{ cfNodeConfig = set (atKey "TestConwayHardForkAtEpoch") (Just $ Aeson.toJSON n) } - {-| Change the alonzo genesis config to allow transactions with up to twice the normal size -} allowLargeTransactions :: GenesisConfigChanges diff --git a/src/devnet/test/Spec.hs b/src/devnet/test/Spec.hs index af647364..f78b25cb 100644 --- a/src/devnet/test/Spec.hs +++ b/src/devnet/test/Spec.hs @@ -4,15 +4,19 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE GADTs #-} module Main where import qualified Cardano.Api as C import qualified Cardano.Api.Shelley as C -import Cardano.Ledger.Api.PParams (ppMaxTxSizeL) +import qualified Cardano.Api.Ledger as L +import Data.IORef (newIORef, modifyIORef, readIORef) +import Cardano.Ledger.Api.PParams qualified as L import Cardano.Ledger.Slot (EpochSize (..)) +import qualified Cardano.Ledger.Block as Ledger import Control.Concurrent (threadDelay) import Control.Lens (view) -import Control.Monad (unless) +import Control.Monad (void, unless) import Control.Monad.Except (runExceptT) import Control.Tracer (Tracer) import Convex.Devnet.CardanoNode (NodeLog (..), @@ -27,8 +31,7 @@ import Convex.Devnet.CardanoNode.Types (GenesisConfigChanges (..), StakePoolNodeParams (..), allowLargeTransactions, defaultPortsConfig, - defaultStakePoolNodeParams, - forkIntoConwayInEpoch) + defaultStakePoolNodeParams) import Convex.Devnet.Logging (contramap, showLogsOnFailure, traceWith) import Convex.Devnet.Utils (failAfter, failure, @@ -54,6 +57,10 @@ import System.FilePath (()) import Test.Tasty (defaultMain, testGroup) import Test.Tasty.HUnit (assertBool, assertEqual, testCase) +import Convex.NodeClient.Types (runNodeClient) +import Convex.NodeClient.Fold (foldClient, LedgerStateArgs(NoLedgerStateArgs)) +import Ouroboros.Consensus.Shelley.Ledger.Block qualified as Consensus +import Ouroboros.Consensus.Protocol.Praos.Header qualified as Consensus main :: IO () main = do @@ -61,7 +68,7 @@ main = do defaultMain $ testGroup "test" [ testCase "cardano-node is available" checkCardanoNode , testCase "start local node" startLocalNode - , testCase "transition to conway era" transitionToConway + , testCase "check transition to conway era and protocol version 10" checkTransitionToConway , testCase "make a payment" makePayment , testCase "start local stake pool node" startLocalStakePoolNode , testCase "stake pool registration" registeredStakePoolNode @@ -83,21 +90,42 @@ startLocalNode = do showLogsOnFailure $ \tr -> do failAfter 5 $ withTempDir "cardano-cluster" $ \tmp -> do - withCardanoNodeDevnet tr tmp $ \RunningNode{rnNodeSocket, rnNodeConfigFile, rnConnectInfo} -> do + withCardanoNodeDevnet tr tmp $ \RunningNode{rnNodeSocket, rnNodeConfigFile} -> do runExceptT (loadConnectInfo rnNodeConfigFile rnNodeSocket) >>= \case Left err -> failure (show err) - Right{} -> do - Queries.queryEra rnConnectInfo - >>= assertBool "Should be in conway era" . (==) (C.anyCardanoEra C.ConwayEra) + Right{} -> pure () + +checkTransitionToConway :: IO () +checkTransitionToConway = do + showLogsOnFailure $ \tr -> do + failAfter 5 $ + withTempDir "cardano-cluster" $ \tmp -> do + withCardanoNodeDevnet (contramap TLNode tr) tmp $ \runningNode@RunningNode{rnConnectInfo, rnNodeSocket, rnNodeConfigFile} -> do + Queries.queryEra rnConnectInfo >>= assertEqual "Should be in conway era" (C.anyCardanoEra C.ConwayEra) + let lovelacePerUtxo = 100_000_000 + numUtxos = 10 + void $ W.createSeededWallet (contramap TLWallet tr) runningNode numUtxos lovelacePerUtxo + majorProtVersionsRef <- newIORef [] + res <- C.liftIO $ runExceptT $ runNodeClient rnNodeConfigFile rnNodeSocket $ \_localNodeConnectInfo env -> do + pure $ foldClient () NoLedgerStateArgs env $ \_catchingUp _ _ bim -> do + case bim of + (C.BlockInMode C.ConwayEra + (C.ShelleyBlock C.ShelleyBasedEraConway + (Consensus.ShelleyBlock + (Ledger.Block (Consensus.Header hb _) _) _))) -> do + modifyIORef majorProtVersionsRef $ \majorProtVersions -> + L.pvMajor (Consensus.hbProtVer hb) : majorProtVersions + pure Nothing + (C.BlockInMode _ _block) -> do + failure "Block should be a ShelleyBlock in Conway era" + case res of + Left err -> failure $ show err + Right () -> do + majorProtVersions <- readIORef majorProtVersionsRef + expectedVersion <- L.mkVersion (10 :: Integer) + assertBool "Should have correct conway era protocol version" $ + not (null majorProtVersions) && all (== expectedVersion) majorProtVersions -transitionToConway :: IO () -transitionToConway = do - showLogsOnFailure $ \tr -> do - failAfter 5 $ - withTempDir "cardano-cluster" $ \tmp -> do - withCardanoNodeDevnetConfig tr tmp (forkIntoConwayInEpoch 0) defaultPortsConfig $ \RunningNode{rnConnectInfo} -> do - Queries.queryEra rnConnectInfo - >>= assertBool "Should be in conway era" . (==) (C.anyCardanoEra C.ConwayEra) startLocalStakePoolNode :: IO () startLocalStakePoolNode = do @@ -211,7 +239,7 @@ runWalletServer = changeMaxTxSize :: IO () changeMaxTxSize = - let getMaxTxSize = fmap (view ppMaxTxSizeL) . queryProtocolParameters . rnConnectInfo in + let getMaxTxSize = fmap (view L.ppMaxTxSizeL) . queryProtocolParameters . rnConnectInfo in showLogsOnFailure $ \tr -> do withTempDir "cardano-cluster" $ \tmp -> do standardTxSize <- withCardanoNodeDevnet (contramap TLNode tr) tmp getMaxTxSize