From b68acf370dd5995339557b1514bf80153781b58c Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Thu, 9 Mar 2023 13:09:31 +1100 Subject: [PATCH 1/2] Update Nix --- flake.lock | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/flake.lock b/flake.lock index 8471d74170a..4b34feef4ce 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1674756171, - "narHash": "sha256-edcHqVXXg11ueHMYhUzA4Cp9FgrhV/IbvA4XCB8DwFU=", + "lastModified": 1678160279, + "narHash": "sha256-IKbD0uqteVoo4KRcYh/QrLQ/HQJXwgCQS2Mq7grhSdM=", "owner": "input-output-hk", "repo": "cardano-haskell-packages", - "rev": "bedbed3bcca19ef64b8a776bceeea052c2b69ea5", + "rev": "e20bffc8ac331810efa671a1bb49932595fa21f6", "type": "github" }, "original": { @@ -1102,11 +1102,11 @@ "tullia": "tullia_3" }, "locked": { - "lastModified": 1677977488, - "narHash": "sha256-y7qsroBhVMWGz10oWRflBpigfQjAYG46nt/oPCCKcRE=", + "lastModified": 1678323114, + "narHash": "sha256-8rEON1D5XknEihsnFSnuNGMESdm2yhQhaYScPZUZY4k=", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "8d21196826dac2f92ec43d30fd183452621af379", + "rev": "7396e07c4179e91e4c15822c04a10cc359e12b49", "type": "github" }, "original": { @@ -1246,11 +1246,11 @@ ] }, "locked": { - "lastModified": 1677230996, - "narHash": "sha256-L/PDahK725s1k+sg6MOtVG6sBiKEmgHhRjaequBRbXI=", + "lastModified": 1678326995, + "narHash": "sha256-cGIHTWB3ENLTCc2/3eLMPL5eBE87grCDOBS4lBllaZg=", "owner": "input-output-hk", "repo": "iohk-nix", - "rev": "82e833b60c47bf0f352443879af1766712e9ca6f", + "rev": "6f1ca44c8bf714df4866e8bf30030a70f55e64e2", "type": "github" }, "original": { @@ -2495,11 +2495,11 @@ "stackage_2": { "flake": false, "locked": { - "lastModified": 1677975082, - "narHash": "sha256-K0tzntuS5Au+9u99NbU2A+3D1QomI6Wq4jELKfIaga4=", + "lastModified": 1678320603, + "narHash": "sha256-9VkqjZoE4CWGK+KTkdXPyqbY+M3SK9hsuUJudYumkEw=", "owner": "input-output-hk", "repo": "stackage.nix", - "rev": "d6da80d17fed290baf047fa8c74dac70dc996baa", + "rev": "c7d5450bacf98fc1937f00c6a4e2a49424ebccf3", "type": "github" }, "original": { From 17edf34f0877507dea552e63ee85bd00a2a648e6 Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Thu, 9 Mar 2023 18:50:36 +1100 Subject: [PATCH 2/2] Take all dependecies from Hackage or CHaP This also updates the version of `ledger` for repliminary support for the Conway era. The `network` and `consensus` dependencies are also updated. --- .gitattributes | 1 + .github/workflows/check-mainnet-config.yml | 1 + bench/locli/locli.cabal | 1 + bench/locli/src/Cardano/Unlog/LogObject.hs | 2 +- bench/locli/src/Data/CDF.hs | 5 - .../Benchmarking/GeneratorTx/NodeToNode.hs | 3 +- .../Benchmarking/GeneratorTx/SizedMetadata.hs | 9 +- .../GeneratorTx/SubmissionClient.hs | 3 +- .../src/Cardano/Benchmarking/Script/Core.hs | 2 + .../Cardano/TxGenerator/Setup/NodeConfig.hs | 8 +- .../src/Cardano/TxGenerator/Tx.hs | 1 + .../src/Cardano/TxGenerator/Utils.hs | 5 +- bench/tx-generator/tx-generator.cabal | 3 + cabal.project | 31 +- cardano-api/cardano-api.cabal | 4 + cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs | 11 + cardano-api/src/Cardano/Api.hs | 1 + cardano-api/src/Cardano/Api/Block.hs | 13 + .../Cardano/Api/Convenience/Constraints.hs | 1 + cardano-api/src/Cardano/Api/Eras.hs | 38 +- cardano-api/src/Cardano/Api/Fees.hs | 38 ++ cardano-api/src/Cardano/Api/InMode.hs | 25 + cardano-api/src/Cardano/Api/LedgerState.hs | 104 +++- cardano-api/src/Cardano/Api/Modes.hs | 24 +- cardano-api/src/Cardano/Api/Orphans.hs | 8 +- cardano-api/src/Cardano/Api/Protocol.hs | 8 +- .../src/Cardano/Api/ProtocolParameters.hs | 20 + cardano-api/src/Cardano/Api/Query.hs | 12 + cardano-api/src/Cardano/Api/Script.hs | 34 ++ .../src/Cardano/Api/SerialiseLedgerCddl.hs | 2 + cardano-api/src/Cardano/Api/Tx.hs | 32 +- cardano-api/src/Cardano/Api/TxBody.hs | 502 +++++++++++++++++- cardano-api/src/Cardano/Api/Utils.hs | 1 + cardano-api/test/Test/Cardano/Api/Json.hs | 2 + cardano-cli/cardano-cli.cabal | 4 +- .../src/Cardano/CLI/Shelley/Commands.hs | 2 +- .../src/Cardano/CLI/Shelley/Orphans.hs | 6 + .../src/Cardano/CLI/Shelley/Parsers.hs | 5 +- .../src/Cardano/CLI/Shelley/Run/Genesis.hs | 22 +- .../src/Cardano/CLI/Shelley/Run/Query.hs | 14 + .../Test/Golden/Shelley/Genesis/Create.hs | 9 +- .../golden/conway/genesis.conway.spec.json | 3 + .../golden/shelley/genesis.conway.spec.json | 3 + cardano-client-demo/cardano-client-demo.cabal | 1 + .../cardano-node-chairman.cabal | 3 +- cardano-node/cardano-node.cabal | 34 +- .../src/Cardano/Node/Configuration/Logging.hs | 7 +- .../src/Cardano/Node/Configuration/POM.hs | 20 +- cardano-node/src/Cardano/Node/Orphans.hs | 7 + cardano-node/src/Cardano/Node/Parsers.hs | 2 +- cardano-node/src/Cardano/Node/Protocol.hs | 2 + .../src/Cardano/Node/Protocol/Byron.hs | 2 +- .../src/Cardano/Node/Protocol/Cardano.hs | 41 +- .../src/Cardano/Node/Protocol/Conway.hs | 57 ++ .../src/Cardano/Node/Protocol/Shelley.hs | 2 +- cardano-node/src/Cardano/Node/Startup.hs | 3 +- .../src/Cardano/Node/Tracing/Documentation.hs | 2 +- .../src/Cardano/Node/Tracing/StateRep.hs | 2 +- .../src/Cardano/Node/Tracing/Tracers.hs | 2 +- .../Tracing/Tracers/BlockReplayProgress.hs | 2 +- .../Cardano/Node/Tracing/Tracers/ChainDB.hs | 44 +- .../Cardano/Node/Tracing/Tracers/Consensus.hs | 13 +- .../Node/Tracing/Tracers/NodeToNode.hs | 6 +- .../src/Cardano/Node/Tracing/Tracers/P2P.hs | 6 + .../src/Cardano/Node/Tracing/Tracers/Peer.hs | 2 + .../Cardano/Node/Tracing/Tracers/Startup.hs | 18 +- cardano-node/src/Cardano/Node/Types.hs | 21 +- .../Tracing/OrphanInstances/Consensus.hs | 44 +- .../Tracing/OrphanInstances/Network.hs | 10 +- cardano-node/src/Cardano/Tracing/Peer.hs | 2 + cardano-node/src/Cardano/Tracing/Tracers.hs | 7 +- cardano-submit-api/cardano-submit-api.cabal | 1 + cardano-testnet/cardano-testnet.cabal | 1 + cardano-testnet/src/Testnet/Babbage.hs | 7 +- cardano-testnet/src/Testnet/Cardano.hs | 8 + cardano-testnet/src/Testnet/Options.hs | 1 - cardano-testnet/src/Testnet/Shelley.hs | 4 + cardano-tracer/cardano-tracer.cabal | 9 +- .../src/Cardano/Tracer/Acceptors/Client.hs | 3 +- .../src/Cardano/Tracer/Acceptors/Server.hs | 3 +- .../test/Cardano/Tracer/Test/Forwarder.hs | 13 +- configuration/cardano/mainnet-config.json | 2 + configuration/cardano/mainnet-config.yaml | 2 + .../cardano/mainnet-conway-genesis.json | 3 + .../chairman/byron-shelley/configuration.yaml | 1 + .../babbage/conway-babbage-test-genesis.json | 3 + scripts/babbage/mkfiles.sh | 4 + .../src/Cardano/Logging/Forwarding.hs | 15 +- trace-dispatcher/trace-dispatcher.cabal | 3 +- trace-forward/trace-forward.cabal | 2 + 90 files changed, 1279 insertions(+), 191 deletions(-) create mode 100644 cardano-cli/test/data/golden/conway/genesis.conway.spec.json create mode 100644 cardano-cli/test/data/golden/shelley/genesis.conway.spec.json create mode 100644 cardano-node/src/Cardano/Node/Protocol/Conway.hs create mode 100644 configuration/cardano/mainnet-conway-genesis.json create mode 100644 scripts/babbage/conway-babbage-test-genesis.json diff --git a/.gitattributes b/.gitattributes index 249fa015696..6370e879f22 100644 --- a/.gitattributes +++ b/.gitattributes @@ -3,4 +3,5 @@ configuration/cardano/mainnet-config.json text eol=lf configuration/cardano/mainnet-alonzo-genesis.json text eol=lf configuration/cardano/mainnet-byron-genesis.json text eol=lf +configuration/cardano/mainnet-conway-genesis.json text eol=lf configuration/cardano/mainnet-shelley-genesis.json text eol=lf diff --git a/.github/workflows/check-mainnet-config.yml b/.github/workflows/check-mainnet-config.yml index cb9ef0dee9a..3d2cdbe7b66 100644 --- a/.github/workflows/check-mainnet-config.yml +++ b/.github/workflows/check-mainnet-config.yml @@ -48,6 +48,7 @@ jobs: copyFile "mainnet-alonzo-genesis.json" copyFile "mainnet-byron-genesis.json" + copyFile "mainnet-conway-genesis.json" copyFile "mainnet-config.json" copyFile "mainnet-shelley-genesis.json" copyFile "mainnet-topology.json" diff --git a/bench/locli/locli.cabal b/bench/locli/locli.cabal index 6d9998d30ee..7c998aae5bd 100644 --- a/bench/locli/locli.cabal +++ b/bench/locli/locli.cabal @@ -120,6 +120,7 @@ library , ouroboros-consensus -- for Data.SOP.Strict: , ouroboros-network + , ouroboros-network-api , process , quiet , scientific diff --git a/bench/locli/src/Cardano/Unlog/LogObject.hs b/bench/locli/src/Cardano/Unlog/LogObject.hs index 33fd80ce8af..e400ee7e2fa 100644 --- a/bench/locli/src/Cardano/Unlog/LogObject.hs +++ b/bench/locli/src/Cardano/Unlog/LogObject.hs @@ -252,7 +252,7 @@ interpreters = map3ple Map.fromList . unzip3 . fmap ent $ <*> pure 1 -- Ledger snapshots: - , (,,,) "TraceLedgerEvent.TookSnapshot" "LedgerEvent.TookSnapshot" "ChainDB.LedgerEvent.TookSnapshot" $ + , (,,,) "TraceSnapshotEvent.TookSnapshot" "LedgerEvent.TookSnapshot" "ChainDB.LedgerEvent.TookSnapshot" $ \_ -> pure LOLedgerTookSnapshot -- Tx receive path & mempool: diff --git a/bench/locli/src/Data/CDF.hs b/bench/locli/src/Data/CDF.hs index 6421faee008..d66e25e7f97 100644 --- a/bench/locli/src/Data/CDF.hs +++ b/bench/locli/src/Data/CDF.hs @@ -265,11 +265,6 @@ class KnownCDF a where instance KnownCDF I where cdfIx = CDFI instance KnownCDF (CDF I) where cdfIx = CDF2 -type family CDFProj a where - CDFProj (CDF I a) = I a - CDFProj (CDF (CDF I) a) = CDF I a --- indexCDF i d = snd $ cdfSamples (trace (printf "i=%d of %d" i (length $ cdfSamples d) :: String) d) !! i - liftCDFVal :: forall a p. Real a => a -> CDFIx p -> p a liftCDFVal x = \case CDFI -> I x diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/NodeToNode.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/NodeToNode.hs index 0f8f5946ad3..0fa80a2d405 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/NodeToNode.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/NodeToNode.hs @@ -33,12 +33,13 @@ import Ouroboros.Consensus.Node.Run (RunNode) import Ouroboros.Consensus.Shelley.Eras (StandardCrypto) import Ouroboros.Network.Channel (Channel (..)) +import Ouroboros.Network.ControlMessage (continueForever) import Ouroboros.Network.DeltaQ (defaultGSV) import Ouroboros.Network.Driver (runPeerWithLimits) import Ouroboros.Network.KeepAlive import Ouroboros.Network.Magic import Ouroboros.Network.Mux (MuxPeer (..), OuroborosApplication (..), OuroborosBundle, - RunMiniProtocol (..), continueForever) + RunMiniProtocol (..)) import Ouroboros.Network.NodeToClient (IOManager, chainSyncPeerNull) import Ouroboros.Network.NodeToNode (NetworkConnectTracers (..)) import qualified Ouroboros.Network.NodeToNode as NtN diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs index e51c3d32986..d7d26c6d606 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs @@ -34,6 +34,7 @@ assume_cbor_properties && prop_bsCostsMary && prop_bsCostsAlonzo && prop_bsCostsBabbage + && prop_bsCostsConway -- The cost of map entries in metadata follows a step function. -- This assumes the map indices are [0..n]. @@ -42,11 +43,13 @@ prop_mapCostsAllegra :: Bool prop_mapCostsMary :: Bool prop_mapCostsAlonzo :: Bool prop_mapCostsBabbage :: Bool +prop_mapCostsConway :: Bool prop_mapCostsShelley = measureMapCosts AsShelleyEra == assumeMapCosts AsShelleyEra prop_mapCostsAllegra = measureMapCosts AsAllegraEra == assumeMapCosts AsAllegraEra prop_mapCostsMary = measureMapCosts AsMaryEra == assumeMapCosts AsMaryEra prop_mapCostsAlonzo = measureMapCosts AsAlonzoEra == assumeMapCosts AsAlonzoEra prop_mapCostsBabbage = measureMapCosts AsBabbageEra == assumeMapCosts AsBabbageEra +prop_mapCostsConway = measureMapCosts AsConwayEra == assumeMapCosts AsConwayEra assumeMapCosts :: forall era . IsShelleyBasedEra era => AsType era -> [Int] assumeMapCosts _proxy = stepFunction [ @@ -63,6 +66,7 @@ assumeMapCosts _proxy = stepFunction [ ShelleyBasedEraMary -> 39 ShelleyBasedEraAlonzo -> 42 ShelleyBasedEraBabbage -> 42 + ShelleyBasedEraConway -> 42 -- Bytestring costs are not LINEAR !! -- Costs are piecewise linear for payload sizes [0..23] and [24..64]. @@ -70,12 +74,14 @@ prop_bsCostsShelley :: Bool prop_bsCostsAllegra :: Bool prop_bsCostsMary :: Bool prop_bsCostsAlonzo :: Bool -prop_bsCostsBabbage :: Bool +prop_bsCostsBabbage :: Bool +prop_bsCostsConway :: Bool prop_bsCostsShelley = measureBSCosts AsShelleyEra == [37..60] ++ [62..102] prop_bsCostsAllegra = measureBSCosts AsAllegraEra == [39..62] ++ [64..104] prop_bsCostsMary = measureBSCosts AsMaryEra == [39..62] ++ [64..104] prop_bsCostsAlonzo = measureBSCosts AsAlonzoEra == [42..65] ++ [67..107] prop_bsCostsBabbage = measureBSCosts AsBabbageEra == [42..65] ++ [67..107] +prop_bsCostsConway = measureBSCosts AsConwayEra == [42..65] ++ [67..107] stepFunction :: [(Int, Int)] -> [Int] stepFunction f = scanl1 (+) steps @@ -149,6 +155,7 @@ mkMetadata size ShelleyBasedEraMary -> 39 ShelleyBasedEraAlonzo -> 39 -- TODO: check minSize for Alonzo ShelleyBasedEraBabbage -> 39 -- TODO: check minSize for Babbage + ShelleyBasedEraConway -> 39 -- TODO: check minSize for Conway nettoSize = size - minSize -- At 24 the CBOR representation changes. diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs index 4d7b1ca8d32..92604f37eb4 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs @@ -156,7 +156,7 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback = TokNonBlocking -> pure $ SendMsgReplyTxIds (NonBlockingReply $ txToIdSize <$> newTxs) (client stateC) - + requestTxs :: LocalState era -> [GenTxId CardanoBlock] @@ -192,6 +192,7 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback = ShelleyBasedEraMary -> toConsensusGenTx $ TxInMode tx MaryEraInCardanoMode ShelleyBasedEraAlonzo -> toConsensusGenTx $ TxInMode tx AlonzoEraInCardanoMode ShelleyBasedEraBabbage -> toConsensusGenTx $ TxInMode tx BabbageEraInCardanoMode + ShelleyBasedEraConway -> toConsensusGenTx $ TxInMode tx ConwayEraInCardanoMode fromGenTxId :: GenTxId CardanoBlock -> TxId fromGenTxId (Block.GenTxIdShelley (Mempool.ShelleyTxId i)) = fromShelleyTxId i diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs index bf2e8589c0b..548665473ea 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs @@ -74,6 +74,7 @@ liftCoreWithEra era coreCall = withEra era ( liftIO . runExceptT . coreCall) withEra :: AnyCardanoEra -> (forall era. IsShelleyBasedEra era => AsType era -> ActionM x) -> ActionM x withEra era action = do case era of + AnyCardanoEra ConwayEra -> action AsConwayEra AnyCardanoEra BabbageEra -> action AsBabbageEra AnyCardanoEra AlonzoEra -> action AsAlonzoEra AnyCardanoEra MaryEra -> action AsMaryEra @@ -189,6 +190,7 @@ queryRemoteProtocolParameters = do AnyCardanoEra MaryEra -> callQuery $ QueryInEra MaryEraInCardanoMode $ QueryInShelleyBasedEra ShelleyBasedEraMary QueryProtocolParameters AnyCardanoEra AlonzoEra -> callQuery $ QueryInEra AlonzoEraInCardanoMode $ QueryInShelleyBasedEra ShelleyBasedEraAlonzo QueryProtocolParameters AnyCardanoEra BabbageEra -> callQuery $ QueryInEra BabbageEraInCardanoMode $ QueryInShelleyBasedEra ShelleyBasedEraBabbage QueryProtocolParameters + AnyCardanoEra ConwayEra -> callQuery $ QueryInEra ConwayEraInCardanoMode $ QueryInShelleyBasedEra ShelleyBasedEraConway QueryProtocolParameters getProtocolParameters :: ActionM ProtocolParameters getProtocolParameters = do diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Setup/NodeConfig.hs b/bench/tx-generator/src/Cardano/TxGenerator/Setup/NodeConfig.hs index 06a2054a0b4..7dcfcde328d 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Setup/NodeConfig.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Setup/NodeConfig.hs @@ -35,13 +35,13 @@ getGenesis (SomeConsensusProtocol CardanoBlockType proto) ProtocolInfoArgsCardano _ ProtocolParamsShelleyBased{shelleyBasedGenesis = genesis} - _ _ _ _ _ _ _ _ _ _ = proto + _ _ _ _ _ _ _ _ _ _ _ _ = proto -- | extract the path to genesis file from a NodeConfiguration for Cardano protocol getGenesisPath :: NodeConfiguration -> Maybe GenesisFile getGenesisPath nodeConfig = case ncProtocolConfig nodeConfig of - NodeProtocolConfigurationCardano _ shelleyConfig _ _ -> Just $ npcShelleyGenesisFile shelleyConfig + NodeProtocolConfigurationCardano _ shelleyConfig _ _ _ -> Just $ npcShelleyGenesisFile shelleyConfig _ -> Nothing mkConsensusProtocol :: NodeConfiguration -> IO (Either TxGenError SomeConsensusProtocol) @@ -49,9 +49,9 @@ mkConsensusProtocol nodeConfig = case ncProtocolConfig nodeConfig of NodeProtocolConfigurationByron _ -> pure $ Left $ TxGenError "NodeProtocolConfigurationByron not supported" NodeProtocolConfigurationShelley _ -> pure $ Left $ TxGenError "NodeProtocolConfigurationShelley not supported" - NodeProtocolConfigurationCardano byronConfig shelleyConfig alonzoConfig hardforkConfig + NodeProtocolConfigurationCardano byronConfig shelleyConfig alonzoConfig conwayConfig hardforkConfig -> first ProtocolError - <$> runExceptT (mkSomeConsensusProtocolCardano byronConfig shelleyConfig alonzoConfig hardforkConfig Nothing) + <$> runExceptT (mkSomeConsensusProtocolCardano byronConfig shelleyConfig alonzoConfig conwayConfig hardforkConfig Nothing) -- | Creates a NodeConfiguration from a config file; -- the result is devoid of any keys/credentials diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Tx.hs b/bench/tx-generator/src/Cardano/TxGenerator/Tx.hs index 6dd704cae47..9009ba41696 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Tx.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Tx.hs @@ -120,6 +120,7 @@ genTx protocolParameters (collateral, collFunds) fee metadata inFunds outputs ShelleyBasedEraMary -> TxValidityNoUpperBound ValidityNoUpperBoundInMaryEra ShelleyBasedEraAlonzo -> TxValidityNoUpperBound ValidityNoUpperBoundInAlonzoEra ShelleyBasedEraBabbage -> TxValidityNoUpperBound ValidityNoUpperBoundInBabbageEra + ShelleyBasedEraConway -> TxValidityNoUpperBound ValidityNoUpperBoundInConwayEra txSizeInBytes :: forall era. IsShelleyBasedEra era => diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Utils.hs b/bench/tx-generator/src/Cardano/TxGenerator/Utils.hs index 8c7d9b56438..6e99351a6a6 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Utils.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Utils.hs @@ -21,7 +21,8 @@ liftAnyEra f x = case x of InAnyCardanoEra AllegraEra a -> InAnyCardanoEra AllegraEra $ f a InAnyCardanoEra MaryEra a -> InAnyCardanoEra MaryEra $ f a InAnyCardanoEra AlonzoEra a -> InAnyCardanoEra AlonzoEra $ f a - InAnyCardanoEra BabbageEra a -> InAnyCardanoEra BabbageEra $ f a + InAnyCardanoEra BabbageEra a -> InAnyCardanoEra BabbageEra $ f a + InAnyCardanoEra ConwayEra a -> InAnyCardanoEra ConwayEra $ f a keyAddress :: forall era. IsShelleyBasedEra era => NetworkId -> SigningKey PaymentKey -> AddressInEra era keyAddress networkId k @@ -61,7 +62,7 @@ mkTxValidityUpperBound = TxValidityUpperBound (fromJust $ validityUpperBoundSupportedInEra (cardanoEra @era)) mkTxOutValueAdaOnly :: forall era . IsShelleyBasedEra era => Lovelace -> TxOutValue era -mkTxOutValueAdaOnly l = either +mkTxOutValueAdaOnly l = either (`TxOutAdaOnly` l) (\p -> TxOutValue p $ lovelaceToValue l) (multiAssetSupportedInEra (cardanoEra @era)) diff --git a/bench/tx-generator/tx-generator.cabal b/bench/tx-generator/tx-generator.cabal index 8365586c730..031cf7cd637 100644 --- a/bench/tx-generator/tx-generator.cabal +++ b/bench/tx-generator/tx-generator.cabal @@ -117,9 +117,12 @@ library , ouroboros-consensus , ouroboros-consensus-byron , ouroboros-consensus-cardano + , ouroboros-consensus-diffusion , ouroboros-consensus-shelley , ouroboros-network + , ouroboros-network-api , ouroboros-network-framework + , ouroboros-network-protocols , plutus-ledger-api , plutus-scripts-bench , plutus-tx diff --git a/cabal.project b/cabal.project index ff384e6027b..ef12193ab6d 100644 --- a/cabal.project +++ b/cabal.project @@ -16,7 +16,7 @@ index-state: 2023-03-06T05:24:58Z index-state: , hackage.haskell.org 2023-03-06T05:24:58Z - , cardano-haskell-packages 2022-12-14T00:40:15Z + , cardano-haskell-packages 2023-02-28T09:20:07Z packages: cardano-api @@ -95,7 +95,8 @@ constraints: -- TODO: these should be set in cabal files, but avoiding setting them in lower dependencies for initial CHaP release , cardano-prelude >= 0.1.0.1 , base-deriving-via >= 0.1.0.0 - , cardano-binary >= 1.5.0 + -- The cardano-binary API changes in 1.6.*. + , cardano-binary == 1.5.* , cardano-binary-test >= 1.3.0 , cardano-crypto-class >= 2.0.0.1 , cardano-crypto-praos >= 2.0.0.0.1 @@ -178,29 +179,3 @@ allow-newer: -- IMPORTANT -- Do NOT add more source-repository-package stanzas here unless they are strictly -- temporary! Please read the section in CONTRIBUTING about updating dependencies. - --- And has the adjustments for the ledger refactor -source-repository-package - type: git - location: https://github.com/input-output-hk/ouroboros-network - tag: 679c7da2079a5e9972a1c502b6a4d6af3eb76945 - --sha256: 138mqd5cv0b13giwjvlz3pr6l1cwgpn38n0q3m11mrjwwmmxl0mw - subdir: - monoidal-synchronisation - network-mux - ouroboros-consensus - ouroboros-consensus-byron - ouroboros-consensus-cardano - ouroboros-consensus-protocol - ouroboros-consensus-shelley - ouroboros-network - ouroboros-network-framework - ouroboros-network-testing - ouroboros-consensus-cardano-tools - --- Waiting for proper Windows ghc-9.2 release. -source-repository-package - type: git - location: https://github.com/input-output-hk/snap-core - tag: b87b2ffa52bf58867a7239ebe74f61b1a2c762d2 - --sha256: 0ndm57z5zpxd5n8s47kh8k1jfqf3b78qv7gkgrx9wwaajs9bf196 diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 97ecd5bd666..7ed7681015f 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -121,6 +121,7 @@ library , cardano-data ^>= 0.1 , cardano-ledger-alonzo ^>= 0.1 , cardano-ledger-babbage ^>= 0.1 + , cardano-ledger-conway , cardano-ledger-byron ^>= 0.1 , cardano-ledger-core ^>= 0.1 , cardano-ledger-shelley-ma ^>= 0.1 @@ -145,10 +146,13 @@ library , ouroboros-consensus , ouroboros-consensus-byron , ouroboros-consensus-cardano + , ouroboros-consensus-diffusion , ouroboros-consensus-protocol , ouroboros-consensus-shelley , ouroboros-network + , ouroboros-network-api , ouroboros-network-framework + , ouroboros-network-protocols , parsec , plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib} ^>=1.1 , prettyprinter diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index 83284d2e27b..ad7e4a4e525 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -909,6 +909,12 @@ genTxOutDatumHashTxContext era = case era of , TxOutDatumInTx ScriptDataInBabbageEra <$> genHashableScriptData , TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInBabbageEra <$> genHashableScriptData ] + ConwayEra -> Gen.choice + [ pure TxOutDatumNone + , TxOutDatumHash ScriptDataInConwayEra <$> genHashScriptData + , TxOutDatumInTx ScriptDataInConwayEra <$> genHashableScriptData + , TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInConwayEra <$> genHashableScriptData + ] genTxOutDatumHashUTxOContext :: CardanoEra era -> Gen (TxOutDatum CtxUTxO era) genTxOutDatumHashUTxOContext era = case era of @@ -925,6 +931,11 @@ genTxOutDatumHashUTxOContext era = case era of , TxOutDatumHash ScriptDataInBabbageEra <$> genHashScriptData , TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInBabbageEra <$> genHashableScriptData ] + ConwayEra -> Gen.choice + [ pure TxOutDatumNone + , TxOutDatumHash ScriptDataInConwayEra <$> genHashScriptData + , TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInConwayEra <$> genHashableScriptData + ] mkDummyHash :: forall h a. CRYPTO.HashAlgorithm h => Int -> CRYPTO.Hash h a mkDummyHash = coerce . CRYPTO.hashWithSerialiser @h CBOR.toCBOR diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 48f3019a7da..8bf30748da8 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -18,6 +18,7 @@ module Cardano.Api ( MaryEra, AlonzoEra, BabbageEra, + ConwayEra, CardanoEra(..), IsCardanoEra(..), AnyCardanoEra(..), diff --git a/cardano-api/src/Cardano/Api/Block.hs b/cardano-api/src/Cardano/Api/Block.hs index 22a972d0e3c..f91229d615c 100644 --- a/cardano-api/src/Cardano/Api/Block.hs +++ b/cardano-api/src/Cardano/Api/Block.hs @@ -153,6 +153,12 @@ instance Show (Block era) where . showsPrec 11 block ) + showsPrec p (ShelleyBlock ShelleyBasedEraConway block) = + showParen (p >= 11) + ( showString "ShelleyBlock ShelleyBasedEraConway " + . showsPrec 11 block + ) + getBlockTxs :: forall era . Block era -> [Tx era] getBlockTxs (ByronBlock Consensus.ByronBlock { Consensus.byronBlockRaw }) = case byronBlockRaw of @@ -190,6 +196,7 @@ obtainConsensusShelleyCompatibleEra ShelleyBasedEraAllegra f = f obtainConsensusShelleyCompatibleEra ShelleyBasedEraMary f = f obtainConsensusShelleyCompatibleEra ShelleyBasedEraAlonzo f = f obtainConsensusShelleyCompatibleEra ShelleyBasedEraBabbage f = f +obtainConsensusShelleyCompatibleEra ShelleyBasedEraConway f = f -- ---------------------------------------------------------------------------- -- Block in a consensus mode @@ -247,6 +254,10 @@ fromConsensusBlock CardanoMode = BlockInMode (ShelleyBlock ShelleyBasedEraBabbage b') BabbageEraInCardanoMode + Consensus.BlockConway b' -> + BlockInMode (ShelleyBlock ShelleyBasedEraConway b') + ConwayEraInCardanoMode + toConsensusBlock :: ConsensusBlockForMode mode ~ block => Consensus.LedgerSupportsProtocol @@ -269,6 +280,7 @@ toConsensusBlock bInMode = BlockInMode (ShelleyBlock ShelleyBasedEraMary b') MaryEraInCardanoMode -> Consensus.BlockMary b' BlockInMode (ShelleyBlock ShelleyBasedEraAlonzo b') AlonzoEraInCardanoMode -> Consensus.BlockAlonzo b' BlockInMode (ShelleyBlock ShelleyBasedEraBabbage b') BabbageEraInCardanoMode -> Consensus.BlockBabbage b' + BlockInMode (ShelleyBlock ShelleyBasedEraConway b') ConwayEraInCardanoMode -> Consensus.BlockConway b' -- ---------------------------------------------------------------------------- -- Block headers @@ -307,6 +319,7 @@ getBlockHeader (ShelleyBlock shelleyEra block) = case shelleyEra of ShelleyBasedEraMary -> go ShelleyBasedEraAlonzo -> go ShelleyBasedEraBabbage -> go + ShelleyBasedEraConway -> go where go :: Consensus.ShelleyCompatible (ConsensusProtocol era) (ShelleyLedgerEra era) => BlockHeader diff --git a/cardano-api/src/Cardano/Api/Convenience/Constraints.hs b/cardano-api/src/Cardano/Api/Convenience/Constraints.hs index 72ed57fb748..2ac8569f0bd 100644 --- a/cardano-api/src/Cardano/Api/Convenience/Constraints.hs +++ b/cardano-api/src/Cardano/Api/Convenience/Constraints.hs @@ -17,3 +17,4 @@ getIsCardanoEraConstraint AllegraEra f = f getIsCardanoEraConstraint MaryEra f = f getIsCardanoEraConstraint AlonzoEra f = f getIsCardanoEraConstraint BabbageEra f = f +getIsCardanoEraConstraint ConwayEra f = f diff --git a/cardano-api/src/Cardano/Api/Eras.hs b/cardano-api/src/Cardano/Api/Eras.hs index c4c96857989..0e110a3c645 100644 --- a/cardano-api/src/Cardano/Api/Eras.hs +++ b/cardano-api/src/Cardano/Api/Eras.hs @@ -16,6 +16,7 @@ module Cardano.Api.Eras , MaryEra , AlonzoEra , BabbageEra + , ConwayEra , CardanoEra(..) , IsCardanoEra(..) , AnyCardanoEra(..) @@ -42,8 +43,8 @@ module Cardano.Api.Eras , cardanoEraStyle -- * Data family instances - , AsType(AsByronEra, AsShelleyEra, AsAllegraEra, AsMaryEra, AsAlonzoEra, AsBabbageEra, - AsByron, AsShelley, AsAllegra, AsMary, AsAlonzo, AsBabbage) + , AsType(AsByronEra, AsShelleyEra, AsAllegraEra, AsMaryEra, AsAlonzoEra, AsBabbageEra, AsConwayEra, + AsByron, AsShelley, AsAllegra, AsMary, AsAlonzo, AsBabbage, AsConway) ) where import Cardano.Api.HasTypeProxy @@ -54,7 +55,7 @@ import qualified Data.Text as Text import Data.Type.Equality (TestEquality (..), (:~:) (Refl)) import Ouroboros.Consensus.Shelley.Eras as Consensus (StandardAllegra, StandardAlonzo, - StandardBabbage, StandardMary, StandardShelley) + StandardBabbage, StandardConway, StandardMary, StandardShelley) -- | A type used as a tag to distinguish the Byron era. data ByronEra @@ -74,6 +75,9 @@ data AlonzoEra -- | A type used as a tag to distinguish the Babbage era. data BabbageEra +-- | A type used as a tag to distinguish the Conway era. +data ConwayEra + instance HasTypeProxy ByronEra where data AsType ByronEra = AsByronEra proxyToAsType _ = AsByronEra @@ -98,6 +102,10 @@ instance HasTypeProxy BabbageEra where data AsType BabbageEra = AsBabbageEra proxyToAsType _ = AsBabbageEra +instance HasTypeProxy ConwayEra where + data AsType ConwayEra = AsConwayEra + proxyToAsType _ = AsConwayEra + -- ---------------------------------------------------------------------------- -- Deprecated aliases -- @@ -131,6 +139,9 @@ pattern AsAlonzo = AsAlonzoEra pattern AsBabbage :: AsType BabbageEra pattern AsBabbage = AsBabbageEra +pattern AsConway :: AsType ConwayEra +pattern AsConway = AsConwayEra + {-# DEPRECATED AsByron "Use 'AsByronEra' instead" #-} {-# DEPRECATED AsShelley "Use 'AsShelleyEra' instead" #-} {-# DEPRECATED AsAllegra "Use 'AsAllegraEra' instead" #-} @@ -157,6 +168,7 @@ data CardanoEra era where MaryEra :: CardanoEra MaryEra AlonzoEra :: CardanoEra AlonzoEra BabbageEra :: CardanoEra BabbageEra + ConwayEra :: CardanoEra ConwayEra -- when you add era here, change `instance Bounded AnyCardanoEra` deriving instance Eq (CardanoEra era) @@ -170,6 +182,7 @@ instance ToJSON (CardanoEra era) where toJSON MaryEra = "Mary" toJSON AlonzoEra = "Alonzo" toJSON BabbageEra = "Babbage" + toJSON ConwayEra = "Conway" instance TestEquality CardanoEra where testEquality ByronEra ByronEra = Just Refl @@ -178,6 +191,7 @@ instance TestEquality CardanoEra where testEquality MaryEra MaryEra = Just Refl testEquality AlonzoEra AlonzoEra = Just Refl testEquality BabbageEra BabbageEra = Just Refl + testEquality ConwayEra ConwayEra = Just Refl testEquality _ _ = Nothing @@ -206,6 +220,8 @@ instance IsCardanoEra AlonzoEra where instance IsCardanoEra BabbageEra where cardanoEra = BabbageEra +instance IsCardanoEra ConwayEra where + cardanoEra = ConwayEra data AnyCardanoEra where AnyCardanoEra :: IsCardanoEra era -- Provide class constraint @@ -222,7 +238,7 @@ instance Eq AnyCardanoEra where instance Bounded AnyCardanoEra where minBound = AnyCardanoEra ByronEra - maxBound = AnyCardanoEra BabbageEra + maxBound = AnyCardanoEra ConwayEra instance Enum AnyCardanoEra where @@ -236,6 +252,7 @@ instance Enum AnyCardanoEra where AnyCardanoEra MaryEra -> 3 AnyCardanoEra AlonzoEra -> 4 AnyCardanoEra BabbageEra -> 5 + AnyCardanoEra ConwayEra -> 6 toEnum = \case 0 -> AnyCardanoEra ByronEra @@ -244,6 +261,7 @@ instance Enum AnyCardanoEra where 3 -> AnyCardanoEra MaryEra 4 -> AnyCardanoEra AlonzoEra 5 -> AnyCardanoEra BabbageEra + 6 -> AnyCardanoEra ConwayEra n -> error $ "AnyCardanoEra.toEnum: " <> show n @@ -261,6 +279,7 @@ instance FromJSON AnyCardanoEra where "Mary" -> pure $ AnyCardanoEra MaryEra "Alonzo" -> pure $ AnyCardanoEra AlonzoEra "Babbage" -> pure $ AnyCardanoEra BabbageEra + "Conway" -> pure $ AnyCardanoEra ConwayEra wrong -> fail $ "Failed to parse unknown era: " <> Text.unpack wrong @@ -274,6 +293,7 @@ anyCardanoEra AllegraEra = AnyCardanoEra AllegraEra anyCardanoEra MaryEra = AnyCardanoEra MaryEra anyCardanoEra AlonzoEra = AnyCardanoEra AlonzoEra anyCardanoEra BabbageEra = AnyCardanoEra BabbageEra +anyCardanoEra ConwayEra = AnyCardanoEra ConwayEra -- | This pairs up some era-dependent type with a 'CardanoEra' value that tells -- us what era it is, but hides the era type. This is useful when the era is @@ -304,6 +324,7 @@ data ShelleyBasedEra era where ShelleyBasedEraMary :: ShelleyBasedEra MaryEra ShelleyBasedEraAlonzo :: ShelleyBasedEra AlonzoEra ShelleyBasedEraBabbage :: ShelleyBasedEra BabbageEra + ShelleyBasedEraConway :: ShelleyBasedEra ConwayEra instance NFData (ShelleyBasedEra era) where rnf = \case @@ -312,6 +333,7 @@ instance NFData (ShelleyBasedEra era) where ShelleyBasedEraMary -> () ShelleyBasedEraAlonzo -> () ShelleyBasedEraBabbage -> () + ShelleyBasedEraConway -> () deriving instance Eq (ShelleyBasedEra era) deriving instance Ord (ShelleyBasedEra era) @@ -340,6 +362,9 @@ instance IsShelleyBasedEra AlonzoEra where instance IsShelleyBasedEra BabbageEra where shelleyBasedEra = ShelleyBasedEraBabbage +instance IsShelleyBasedEra ConwayEra where + shelleyBasedEra = ShelleyBasedEraConway + -- | This pairs up some era-dependent type with a 'ShelleyBasedEra' value that -- tells us what era it is, but hides the era type. This is useful when the era -- is not statically known, for example when deserialising from a file. @@ -358,6 +383,7 @@ shelleyBasedToCardanoEra ShelleyBasedEraAllegra = AllegraEra shelleyBasedToCardanoEra ShelleyBasedEraMary = MaryEra shelleyBasedToCardanoEra ShelleyBasedEraAlonzo = AlonzoEra shelleyBasedToCardanoEra ShelleyBasedEraBabbage = BabbageEra +shelleyBasedToCardanoEra ShelleyBasedEraConway = ConwayEra -- ---------------------------------------------------------------------------- -- Cardano eras factored as Byron vs Shelley-based @@ -390,7 +416,7 @@ cardanoEraStyle AllegraEra = ShelleyBasedEra ShelleyBasedEraAllegra cardanoEraStyle MaryEra = ShelleyBasedEra ShelleyBasedEraMary cardanoEraStyle AlonzoEra = ShelleyBasedEra ShelleyBasedEraAlonzo cardanoEraStyle BabbageEra = ShelleyBasedEra ShelleyBasedEraBabbage - +cardanoEraStyle ConwayEra = ShelleyBasedEra ShelleyBasedEraConway -- ---------------------------------------------------------------------------- -- Conversion to Shelley ledger library types @@ -410,4 +436,4 @@ type family ShelleyLedgerEra era where ShelleyLedgerEra MaryEra = Consensus.StandardMary ShelleyLedgerEra AlonzoEra = Consensus.StandardAlonzo ShelleyLedgerEra BabbageEra = Consensus.StandardBabbage - + ShelleyLedgerEra ConwayEra = Consensus.StandardConway diff --git a/cardano-api/src/Cardano/Api/Fees.hs b/cardano-api/src/Cardano/Api/Fees.hs index e48fa665c8e..907d0a63287 100644 --- a/cardano-api/src/Cardano/Api/Fees.hs +++ b/cardano-api/src/Cardano/Api/Fees.hs @@ -92,6 +92,7 @@ import qualified Cardano.Ledger.Alonzo.TxWitness as Alonzo import qualified Cardano.Ledger.Babbage as Babbage import Cardano.Ledger.Babbage.PParams (BabbagePParamsHKD (..)) +import qualified Cardano.Ledger.Conway as Conway import qualified Ouroboros.Consensus.HardFork.History as Consensus @@ -148,6 +149,7 @@ transactionFee txFeeFixed txFeePerByte tx = obtainHasField ShelleyBasedEraMary f = f obtainHasField ShelleyBasedEraAlonzo f = f obtainHasField ShelleyBasedEraBabbage f = f + obtainHasField ShelleyBasedEraConway f = f {-# DEPRECATED transactionFee "Use 'evaluateTransactionFee' instead" #-} @@ -276,6 +278,7 @@ evaluateTransactionFee pparams txbody keywitcount _byronwitcount = withLedgerConstraints ShelleyBasedEraMary f = f withLedgerConstraints ShelleyBasedEraAlonzo f = f withLedgerConstraints ShelleyBasedEraBabbage f = f + withLedgerConstraints ShelleyBasedEraConway f = f -- | Give an approximate count of the number of key witnesses (i.e. signatures) -- a transaction will need. @@ -525,6 +528,10 @@ evaluateTransactionExecutionUnits _eraInMode systemstart (LedgerEpochInfo ledger case collateralSupportedInEra $ shelleyBasedToCardanoEra era of Just supp -> obtainHasFieldConstraint supp $ evalBabbage era tx' Nothing -> return mempty + ShelleyBasedEraConway -> + case collateralSupportedInEra $ shelleyBasedToCardanoEra era of + Just supp -> obtainHasFieldConstraint supp $ evalConway era tx' + Nothing -> return mempty where -- Pre-Alonzo eras do not support languages with execution unit accounting. evalPreAlonzo :: Either TransactionValidityError @@ -577,6 +584,28 @@ evaluateTransactionExecutionUnits _eraInMode systemstart (LedgerEpochInfo ledger of Left err -> Left (TransactionValidityTranslationError err) Right exmap -> Right (fromLedgerScriptExUnitsMap exmap) + evalConway :: forall ledgerera. + ShelleyLedgerEra era ~ ledgerera + => ledgerera ~ Conway.ConwayEra Ledger.StandardCrypto + => HasField "_maxTxExUnits" (Ledger.PParams ledgerera) Alonzo.ExUnits + => HasField"_protocolVersion" (Ledger.PParams ledgerera) Ledger.ProtVer + => ShelleyBasedEra era + -> Ledger.Tx ledgerera + -> Either TransactionValidityError + (Map ScriptWitnessIndex + (Either ScriptExecutionError ExecutionUnits)) + evalConway era tx = do + costModelsArray <- toAlonzoCostModelsArray (protocolParamCostModels pparams) + case Alonzo.evaluateTransactionExecutionUnits + (toLedgerPParams era pparams) + tx + (toLedgerUTxO era utxo) + ledgerEpochInfo + systemstart + costModelsArray + of Left err -> Left (TransactionValidityTranslationError err) + Right exmap -> Right (fromLedgerScriptExUnitsMap exmap) + toAlonzoCostModelsArray :: Map AnyPlutusScriptVersion CostModel @@ -631,6 +660,7 @@ evaluateTransactionExecutionUnits _eraInMode systemstart (LedgerEpochInfo ledger -> (HasField "_maxTxExUnits" (Ledger.PParams ledgerera) Alonzo.ExUnits => a) -> a obtainHasFieldConstraint CollateralInAlonzoEra f = f obtainHasFieldConstraint CollateralInBabbageEra f = f + obtainHasFieldConstraint CollateralInConwayEra f = f -- ---------------------------------------------------------------------------- @@ -671,6 +701,7 @@ evaluateTransactionBalance pparams poolids utxo getShelleyEraTxBodyConstraint ShelleyBasedEraAllegra x = x getShelleyEraTxBodyConstraint ShelleyBasedEraAlonzo x = x getShelleyEraTxBodyConstraint ShelleyBasedEraBabbage x = x + getShelleyEraTxBodyConstraint ShelleyBasedEraConway x = x isNewPool :: Ledger.KeyHash Ledger.StakePool Ledger.StandardCrypto -> Bool isNewPool kh = StakePoolKeyHash kh `Set.notMember` poolids @@ -727,6 +758,7 @@ evaluateTransactionBalance pparams poolids utxo withLedgerConstraints ShelleyBasedEraMary _ f = f MultiAssetInMaryEra withLedgerConstraints ShelleyBasedEraAlonzo _ f = f MultiAssetInAlonzoEra withLedgerConstraints ShelleyBasedEraBabbage _ f = f MultiAssetInBabbageEra + withLedgerConstraints ShelleyBasedEraConway _ f = f MultiAssetInConwayEra type LedgerEraConstraints ledgerera = ( Ledger.Era.Crypto ledgerera ~ Ledger.StandardCrypto @@ -1343,6 +1375,12 @@ calculateMinimumUTxO era txout@(TxOut _ v _ _) pparams' = minUTxO = Shelley.evaluateMinLovelaceOutput babPParams lTxOut val = fromShelleyLovelace minUTxO in Right val + ShelleyBasedEraConway -> + let lTxOut = toShelleyTxOutAny era txout + babPParams = toConwayPParams pparams' + minUTxO = Shelley.evaluateMinLovelaceOutput babPParams lTxOut + val = fromShelleyLovelace minUTxO + in Right val where calcMinUTxOAllegraMary :: Either MinimumUTxOError Lovelace calcMinUTxOAllegraMary = do diff --git a/cardano-api/src/Cardano/Api/InMode.hs b/cardano-api/src/Cardano/Api/InMode.hs index 68183fd980c..8f68ddd0069 100644 --- a/cardano-api/src/Cardano/Api/InMode.hs +++ b/cardano-api/src/Cardano/Api/InMode.hs @@ -102,6 +102,10 @@ fromConsensusGenTx CardanoMode (Consensus.HardForkGenTx (Consensus.OneEraGenTx ( let Consensus.ShelleyTx _txid shelleyEraTx = tx' in TxInMode (ShelleyTx ShelleyBasedEraBabbage shelleyEraTx) BabbageEraInCardanoMode +fromConsensusGenTx CardanoMode (Consensus.HardForkGenTx (Consensus.OneEraGenTx (S (S (S (S (S (S (Z tx'))))))))) = + let Consensus.ShelleyTx _txid shelleyEraTx = tx' + in TxInMode (ShelleyTx ShelleyBasedEraConway shelleyEraTx) ConwayEraInCardanoMode + toConsensusGenTx :: ConsensusBlockForMode mode ~ block => TxInMode mode -> Consensus.GenTx block @@ -153,6 +157,10 @@ toConsensusGenTx (TxInMode (ShelleyTx _ tx) BabbageEraInCardanoMode) = where tx' = Consensus.mkShelleyTx tx +toConsensusGenTx (TxInMode (ShelleyTx _ tx) ConwayEraInCardanoMode) = + Consensus.HardForkGenTx (Consensus.OneEraGenTx (S (S (S (S (S (S (Z tx')))))))) + where + tx' = Consensus.mkShelleyTx tx toConsensusGenTx (TxInMode (ShelleyTx _ _) ByronEraInByronMode) = error "Cardano.Api.InMode.toConsensusGenTx: ShelleyTx In Byron era" @@ -224,6 +232,12 @@ toConsensusTxId (TxIdInMode txid BabbageEraInCardanoMode) = txid' :: Consensus.TxId (Consensus.GenTx Consensus.StandardBabbageBlock) txid' = Consensus.ShelleyTxId $ toShelleyTxId txid +toConsensusTxId (TxIdInMode txid ConwayEraInCardanoMode) = + Consensus.HardForkGenTxId (Consensus.OneEraGenTxId (S (S (S (S (S (S (Z (Consensus.WrapGenTxId txid'))))))))) + where + txid' :: Consensus.TxId (Consensus.GenTx Consensus.StandardConwayBlock) + txid' = Consensus.ShelleyTxId $ toShelleyTxId txid + -- ---------------------------------------------------------------------------- -- Transaction validation errors in the context of eras and consensus modes -- @@ -280,6 +294,12 @@ instance Show (TxValidationError era) where . showsPrec 11 err ) + showsPrec p (ShelleyTxValidationError ShelleyBasedEraConway err) = + showParen (p >= 11) + ( showString "ShelleyTxValidationError ShelleyBasedEraConway " + . showsPrec 11 err + ) + -- | A 'TxValidationError' in one of the eras supported by a given protocol -- mode. -- @@ -344,5 +364,10 @@ fromConsensusApplyTxErr CardanoMode (Consensus.ApplyTxErrBabbage err) = (ShelleyTxValidationError ShelleyBasedEraBabbage err) BabbageEraInCardanoMode +fromConsensusApplyTxErr CardanoMode (Consensus.ApplyTxErrConway err) = + TxValidationErrorInMode + (ShelleyTxValidationError ShelleyBasedEraConway err) + ConwayEraInCardanoMode + fromConsensusApplyTxErr CardanoMode (Consensus.ApplyTxErrWrongEra err) = TxValidationEraMismatch err diff --git a/cardano-api/src/Cardano/Api/LedgerState.hs b/cardano-api/src/Cardano/Api/LedgerState.hs index 5364a382a26..2c86391edb2 100644 --- a/cardano-api/src/Cardano/Api/LedgerState.hs +++ b/cardano-api/src/Cardano/Api/LedgerState.hs @@ -66,7 +66,8 @@ import Data.Aeson.Types (Parser) import Data.Bifunctor import Data.ByteArray (ByteArrayAccess) import qualified Data.ByteArray -import Data.ByteString as BS +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Lazy as LB import Data.ByteString.Short as BSS @@ -126,6 +127,7 @@ import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis (..)) import Cardano.Ledger.BaseTypes (Globals (..), Nonce, UnitInterval, (⭒)) import qualified Cardano.Ledger.BaseTypes as Shelley.Spec import qualified Cardano.Ledger.BHeaderView as Ledger +import Cardano.Ledger.Conway.Genesis (ConwayGenesis (..)) import qualified Cardano.Ledger.Core as Core import qualified Cardano.Ledger.Credential as Shelley.Spec import qualified Cardano.Ledger.Era @@ -158,7 +160,7 @@ import qualified Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common as import qualified Ouroboros.Consensus.Ledger.Abstract as Ledger import Ouroboros.Consensus.Ledger.Basics (LedgerResult (lrEvents), lrResult) import qualified Ouroboros.Consensus.Ledger.Extended as Ledger -import qualified Ouroboros.Consensus.Mempool.TxLimits as TxLimits +import qualified Ouroboros.Consensus.Mempool.Capacity as TxLimits import qualified Ouroboros.Consensus.Node.ProtocolInfo as Consensus import Ouroboros.Consensus.Protocol.Abstract (ChainDepState, ConsensusProtocol (..)) import qualified Ouroboros.Consensus.Protocol.Abstract as Consensus @@ -255,6 +257,7 @@ applyBlock env oldState validationMode block ShelleyBasedEraMary -> Consensus.BlockMary shelleyBlock ShelleyBasedEraAlonzo -> Consensus.BlockAlonzo shelleyBlock ShelleyBasedEraBabbage -> Consensus.BlockBabbage shelleyBlock + ShelleyBasedEraConway -> Consensus.BlockConway shelleyBlock pattern LedgerStateByron :: Ledger.LedgerState Byron.ByronBlock @@ -713,7 +716,7 @@ genesisConfigToEnv -- enp genCfg = case genCfg of - GenesisCardano _ bCfg sCfg _ + GenesisCardano _ bCfg sCfg _ _ | Cardano.Crypto.ProtocolMagic.unProtocolMagicId (Cardano.Chain.Genesis.configProtocolMagicId bCfg) /= Shelley.Spec.sgNetworkMagic (scConfig sCfg) -> Left . NECardanoConfig $ mconcat @@ -742,6 +745,7 @@ readNetworkConfig (NetworkConfigFile ncf) = do { ncByronGenesisFile = adjustGenesisFilePath (mkAdjustPath ncf) (ncByronGenesisFile ncfg) , ncShelleyGenesisFile = adjustGenesisFilePath (mkAdjustPath ncf) (ncShelleyGenesisFile ncfg) , ncAlonzoGenesisFile = adjustGenesisFilePath (mkAdjustPath ncf) (ncAlonzoGenesisFile ncfg) + , ncConwayGenesisFile = adjustGenesisFilePath (mkAdjustPath ncf) (ncConwayGenesisFile ncfg) } data NodeConfig = NodeConfig @@ -752,6 +756,8 @@ data NodeConfig = NodeConfig , ncShelleyGenesisHash :: !GenesisHashShelley , ncAlonzoGenesisFile :: !GenesisFile , ncAlonzoGenesisHash :: !GenesisHashAlonzo + , ncConwayGenesisFile :: !GenesisFile + , ncConwayGenesisHash :: !GenesisHashConway , ncRequiresNetworkMagic :: !Cardano.Crypto.RequiresNetworkMagic , ncByronSoftwareVersion :: !Cardano.Chain.Update.SoftwareVersion , ncByronProtocolVersion :: !Cardano.Chain.Update.ProtocolVersion @@ -765,6 +771,7 @@ data NodeConfig = NodeConfig Shelley.StandardMary) , ncMaryToAlonzo :: !Consensus.TriggerHardFork , ncAlonzoToBabbage :: !Consensus.TriggerHardFork + , ncBabbageToConway :: !Consensus.TriggerHardFork } instance FromJSON NodeConfig where @@ -781,6 +788,8 @@ instance FromJSON NodeConfig where <*> fmap GenesisHashShelley (o .: "ShelleyGenesisHash") <*> fmap GenesisFile (o .: "AlonzoGenesisFile") <*> fmap GenesisHashAlonzo (o .: "AlonzoGenesisHash") + <*> fmap GenesisFile (o .: "ConwayGenesisFile") + <*> fmap GenesisHashConway (o .: "ConwayGenesisHash") <*> o .: "RequiresNetworkMagic" <*> parseByronSoftwareVersion o <*> parseByronProtocolVersion o @@ -792,6 +801,7 @@ instance FromJSON NodeConfig where <$> parseMaryHardForkEpoch o) <*> parseAlonzoHardForkEpoch o <*> parseBabbageHardForkEpoch o + <*> parseConwayHardForkEpoch o parseByronProtocolVersion :: Object -> Parser Cardano.Chain.Update.ProtocolVersion parseByronProtocolVersion o = @@ -840,6 +850,13 @@ instance FromJSON NodeConfig where , pure $ Consensus.TriggerHardForkAtVersion 7 -- Mainnet default ] + parseConwayHardForkEpoch :: Object -> Parser Consensus.TriggerHardFork + parseConwayHardForkEpoch o = + asum + [ Consensus.TriggerHardForkAtEpoch <$> o .: "TestConwayHardForkAtEpoch" + , pure $ Consensus.TriggerHardForkAtVersion 8 -- Mainnet default + ] + parseNodeConfig :: ByteString -> Either Text NodeConfig parseNodeConfig bs = case Yaml.decodeEither' bs of @@ -874,7 +891,7 @@ newtype LedgerState = LedgerState encodeLedgerState :: LedgerState -> CBOR.Encoding encodeLedgerState (LedgerState (HFC.HardForkLedgerState st)) = HFC.encodeTelescope - (byron :* shelley :* allegra :* mary :* alonzo :* babbage :* Nil) + (byron :* shelley :* allegra :* mary :* alonzo :* babbage :* conway :* Nil) st where byron = fn (K . Byron.encodeByronLedgerState) @@ -883,11 +900,12 @@ encodeLedgerState (LedgerState (HFC.HardForkLedgerState st)) = mary = fn (K . Shelley.encodeShelleyLedgerState) alonzo = fn (K . Shelley.encodeShelleyLedgerState) babbage = fn (K . Shelley.encodeShelleyLedgerState) + conway = fn (K . Shelley.encodeShelleyLedgerState) decodeLedgerState :: forall s. CBOR.Decoder s LedgerState decodeLedgerState = LedgerState . HFC.HardForkLedgerState - <$> HFC.decodeTelescope (byron :* shelley :* allegra :* mary :* alonzo :* babbage :* Nil) + <$> HFC.decodeTelescope (byron :* shelley :* allegra :* mary :* alonzo :* babbage :* conway :* Nil) where byron = Comp Byron.decodeByronLedgerState shelley = Comp Shelley.decodeShelleyLedgerState @@ -895,6 +913,7 @@ decodeLedgerState = mary = Comp Shelley.decodeShelleyLedgerState alonzo = Comp Shelley.decodeShelleyLedgerState babbage = Comp Shelley.decodeShelleyLedgerState + conway = Comp Shelley.decodeShelleyLedgerState type LedgerStateEvents = (LedgerState, [LedgerEvent]) @@ -922,6 +941,7 @@ data GenesisConfig !Cardano.Chain.Genesis.Config !ShelleyConfig !AlonzoGenesis + !(ConwayGenesis Shelley.StandardCrypto) data ShelleyConfig = ShelleyConfig { scConfig :: !(Shelley.Spec.ShelleyGenesis Shelley.StandardShelley) @@ -944,6 +964,10 @@ newtype GenesisHashAlonzo = GenesisHashAlonzo { unGenesisHashAlonzo :: Cardano.Crypto.Hash.Class.Hash Cardano.Crypto.Hash.Blake2b.Blake2b_256 ByteString } deriving newtype (Eq, Show) +newtype GenesisHashConway = GenesisHashConway + { unGenesisHashConway :: Cardano.Crypto.Hash.Class.Hash Cardano.Crypto.Hash.Blake2b.Blake2b_256 ByteString + } deriving newtype (Eq, Show) + newtype LedgerStateDir = LedgerStateDir { unLedgerStateDir :: FilePath } deriving Show @@ -966,7 +990,7 @@ mkProtocolInfoCardano :: IO (HFC.HardForkBlock (Consensus.CardanoEras Consensus.StandardCrypto)) -mkProtocolInfoCardano (GenesisCardano dnc byronGenesis shelleyGenesis alonzoGenesis) +mkProtocolInfoCardano (GenesisCardano dnc byronGenesis shelleyGenesis alonzoGenesis conwayGenesis) = Consensus.protocolInfoCardano Consensus.ProtocolParamsByron { Consensus.byronGenesis = byronGenesis @@ -1001,11 +1025,16 @@ mkProtocolInfoCardano (GenesisCardano dnc byronGenesis shelleyGenesis alonzoGene { Consensus.babbageProtVer = shelleyProtVer dnc , Consensus.babbageMaxTxCapacityOverrides = TxLimits.mkOverrides TxLimits.noOverridesMeasure } + Consensus.ProtocolParamsConway + { Consensus.conwayProtVer = shelleyProtVer dnc + , Consensus.conwayMaxTxCapacityOverrides = TxLimits.mkOverrides TxLimits.noOverridesMeasure + } (ncByronToShelley dnc) (ncShelleyToAllegra dnc) (ncAllegraToMary dnc) (Consensus.ProtocolTransitionParamsShelleyBased alonzoGenesis (ncMaryToAlonzo dnc)) (Consensus.ProtocolTransitionParamsShelleyBased alonzoGenesis (ncAlonzoToBabbage dnc)) + (Consensus.ProtocolTransitionParamsShelleyBased conwayGenesis (ncBabbageToConway dnc)) shelleyPraosNonce :: ShelleyConfig -> Shelley.Spec.Nonce shelleyPraosNonce sCfg = Shelley.Spec.Nonce (Cardano.Crypto.Hash.Class.castHash . unGenesisHashShelley $ scGenesisHash sCfg) @@ -1025,12 +1054,14 @@ readCardanoGenesisConfig enc = <$> readByronGenesisConfig enc <*> readShelleyGenesisConfig enc <*> readAlonzoGenesisConfig enc + <*> readConwayGenesisConfig enc data GenesisConfigError = NEError !Text | NEByronConfig !FilePath !Cardano.Chain.Genesis.ConfigurationError | NEShelleyConfig !FilePath !Text | NEAlonzoConfig !FilePath !Text + | NEConwayConfig !FilePath !Text | NECardanoConfig !Text renderGenesisConfigError :: GenesisConfigError -> Text @@ -1049,6 +1080,10 @@ renderGenesisConfigError ne = mconcat [ "Failed reading Alonzo genesis file ", textShow fp, ": ", txt ] + NEConwayConfig fp txt -> + mconcat + [ "Failed reading Conway genesis file ", textShow fp, ": ", txt + ] NECardanoConfig err -> mconcat [ "With Cardano protocol, Byron/Shelley config mismatch:\n" @@ -1094,6 +1129,14 @@ readAlonzoGenesisConfig enc = do firstExceptT (NEAlonzoConfig file . renderAlonzoGenesisError) $ readAlonzoGenesis (GenesisFile file) (ncAlonzoGenesisHash enc) +readConwayGenesisConfig + :: NodeConfig + -> ExceptT GenesisConfigError IO (ConwayGenesis Shelley.StandardCrypto) +readConwayGenesisConfig enc = do + let file = unGenesisFile $ ncConwayGenesisFile enc + firstExceptT (NEConwayConfig file . renderConwayGenesisError) + $ readConwayGenesis (GenesisFile file) (ncConwayGenesisHash enc) + readShelleyGenesis :: GenesisFile -> GenesisHashShelley -> ExceptT ShelleyGenesisError IO ShelleyConfig @@ -1183,6 +1226,50 @@ renderAlonzoGenesisError sge = , " Error: ", err ] +readConwayGenesis + :: GenesisFile -> GenesisHashConway + -> ExceptT ConwayGenesisError IO (ConwayGenesis Shelley.StandardCrypto) +readConwayGenesis (GenesisFile file) expectedGenesisHash = do + content <- handleIOExceptT (ConwayGenesisReadError file . textShow) $ BS.readFile file + let genesisHash = GenesisHashConway (Cardano.Crypto.Hash.Class.hashWith id content) + checkExpectedGenesisHash genesisHash + firstExceptT (ConwayGenesisDecodeError file . Text.pack) + . hoistEither + $ Aeson.eitherDecodeStrict' content + where + checkExpectedGenesisHash :: GenesisHashConway -> ExceptT ConwayGenesisError IO () + checkExpectedGenesisHash actual = + when (actual /= expectedGenesisHash) $ + left (ConwayGenesisHashMismatch actual expectedGenesisHash) + +data ConwayGenesisError + = ConwayGenesisReadError !FilePath !Text + | ConwayGenesisHashMismatch !GenesisHashConway !GenesisHashConway -- actual, expected + | ConwayGenesisDecodeError !FilePath !Text + deriving Show + +renderConwayGenesisError :: ConwayGenesisError -> Text +renderConwayGenesisError sge = + case sge of + ConwayGenesisReadError fp err -> + mconcat + [ "There was an error reading the genesis file: ", Text.pack fp + , " Error: ", err + ] + + ConwayGenesisHashMismatch actual expected -> + mconcat + [ "Wrong Conway genesis file: the actual hash is ", renderHash (unGenesisHashConway actual) + , ", but the expected Conway genesis hash given in the node " + , "configuration file is ", renderHash (unGenesisHashConway expected), "." + ] + + ConwayGenesisDecodeError fp err -> + mconcat + [ "There was an error parsing the genesis file: ", Text.pack fp + , " Error: ", err + ] + renderHash :: Cardano.Crypto.Hash.Class.Hash Cardano.Crypto.Hash.Blake2b.Blake2b_256 ByteString -> Text renderHash h = Text.decodeUtf8 $ Base16.encode (Cardano.Crypto.Hash.Class.hashToBytes h) @@ -1429,7 +1516,7 @@ nextEpochEligibleLeadershipSlots sbe sGen serCurrEpochState ptclState poolid (Vr ShelleyBasedEraMary -> isLeadingSlotsTPraos slotRangeOfInterest poolid markSnapshotPoolDistr nextEpochsNonce vrfSkey f ShelleyBasedEraAlonzo -> isLeadingSlotsTPraos slotRangeOfInterest poolid markSnapshotPoolDistr nextEpochsNonce vrfSkey f ShelleyBasedEraBabbage -> isLeadingSlotsPraos slotRangeOfInterest poolid markSnapshotPoolDistr nextEpochsNonce vrfSkey f - + ShelleyBasedEraConway -> isLeadingSlotsPraos slotRangeOfInterest poolid markSnapshotPoolDistr nextEpochsNonce vrfSkey f where globals = constructGlobals sGen eInfo pParams @@ -1506,6 +1593,7 @@ obtainIsStandardCrypto ShelleyBasedEraAllegra f = f obtainIsStandardCrypto ShelleyBasedEraMary f = f obtainIsStandardCrypto ShelleyBasedEraAlonzo f = f obtainIsStandardCrypto ShelleyBasedEraBabbage f = f +obtainIsStandardCrypto ShelleyBasedEraConway f = f obtainDecodeEpochStateConstraints @@ -1525,6 +1613,7 @@ obtainDecodeEpochStateConstraints ShelleyBasedEraAllegra f = f obtainDecodeEpochStateConstraints ShelleyBasedEraMary f = f obtainDecodeEpochStateConstraints ShelleyBasedEraAlonzo f = f obtainDecodeEpochStateConstraints ShelleyBasedEraBabbage f = f +obtainDecodeEpochStateConstraints ShelleyBasedEraConway f = f -- | Return the slots at which a particular stake pool operator is -- expected to mint a block. @@ -1576,6 +1665,7 @@ currentEpochEligibleLeadershipSlots sbe sGen eInfo pParams ptclState poolid (Vrf ShelleyBasedEraMary -> isLeadingSlotsTPraos slotRangeOfInterest poolid setSnapshotPoolDistr epochNonce vrkSkey f ShelleyBasedEraAlonzo -> isLeadingSlotsTPraos slotRangeOfInterest poolid setSnapshotPoolDistr epochNonce vrkSkey f ShelleyBasedEraBabbage -> isLeadingSlotsPraos slotRangeOfInterest poolid setSnapshotPoolDistr epochNonce vrkSkey f + ShelleyBasedEraConway -> isLeadingSlotsPraos slotRangeOfInterest poolid setSnapshotPoolDistr epochNonce vrkSkey f where globals = constructGlobals sGen eInfo pParams diff --git a/cardano-api/src/Cardano/Api/Modes.hs b/cardano-api/src/Cardano/Api/Modes.hs index 0a1917c890e..f25cfcda31c 100644 --- a/cardano-api/src/Cardano/Api/Modes.hs +++ b/cardano-api/src/Cardano/Api/Modes.hs @@ -154,7 +154,8 @@ data EraInMode era mode where AllegraEraInCardanoMode :: EraInMode AllegraEra CardanoMode MaryEraInCardanoMode :: EraInMode MaryEra CardanoMode AlonzoEraInCardanoMode :: EraInMode AlonzoEra CardanoMode - BabbageEraInCardanoMode :: EraInMode BabbageEra CardanoMode + BabbageEraInCardanoMode :: EraInMode BabbageEra CardanoMode + ConwayEraInCardanoMode :: EraInMode ConwayEra CardanoMode deriving instance Show (EraInMode era mode) @@ -216,6 +217,13 @@ instance FromJSON (EraInMode BabbageEra CardanoMode) where "parsing 'EraInMode Babbage CardanoMode' failed, " invalid +instance FromJSON (EraInMode ConwayEra CardanoMode) where + parseJSON "ConwayEraInCardanoMode" = pure ConwayEraInCardanoMode + parseJSON invalid = + invalidJSONFailure "ConwayEraInCardanoMode" + "parsing 'EraInMode Conway CardanoMode' failed, " + invalid + invalidJSONFailure :: String -> String -> Value -> Parser a invalidJSONFailure expectedType errorMsg invalidValue = prependFailure errorMsg @@ -230,6 +238,7 @@ instance ToJSON (EraInMode era mode) where toJSON MaryEraInCardanoMode = "MaryEraInCardanoMode" toJSON AlonzoEraInCardanoMode = "AlonzoEraInCardanoMode" toJSON BabbageEraInCardanoMode = "BabbageEraInCardanoMode" + toJSON ConwayEraInCardanoMode = "ConwayEraInCardanoMode" eraInModeToEra :: EraInMode era mode -> CardanoEra era eraInModeToEra ByronEraInByronMode = ByronEra @@ -240,6 +249,7 @@ eraInModeToEra AllegraEraInCardanoMode = AllegraEra eraInModeToEra MaryEraInCardanoMode = MaryEra eraInModeToEra AlonzoEraInCardanoMode = AlonzoEra eraInModeToEra BabbageEraInCardanoMode = BabbageEra +eraInModeToEra ConwayEraInCardanoMode = ConwayEra data AnyEraInMode mode where @@ -259,6 +269,7 @@ anyEraInModeToAnyEra (AnyEraInMode erainmode) = MaryEraInCardanoMode -> AnyCardanoEra MaryEra AlonzoEraInCardanoMode -> AnyCardanoEra AlonzoEra BabbageEraInCardanoMode -> AnyCardanoEra BabbageEra + ConwayEraInCardanoMode -> AnyCardanoEra ConwayEra -- | The consensus-mode-specific parameters needed to connect to a local node @@ -307,6 +318,7 @@ type family ConsensusBlockForEra era where ConsensusBlockForEra MaryEra = Consensus.StandardMaryBlock ConsensusBlockForEra AlonzoEra = Consensus.StandardAlonzoBlock ConsensusBlockForEra BabbageEra = Consensus.StandardBabbageBlock + ConsensusBlockForEra ConwayEra = Consensus.StandardConwayBlock type family ConsensusCryptoForBlock block where ConsensusCryptoForBlock Consensus.ByronBlockHFC = StandardCrypto @@ -319,7 +331,7 @@ type family ConsensusProtocol era where ConsensusProtocol MaryEra = Consensus.TPraos StandardCrypto ConsensusProtocol AlonzoEra = Consensus.TPraos StandardCrypto ConsensusProtocol BabbageEra = Consensus.Praos StandardCrypto - + ConsensusProtocol ConwayEra = Consensus.Praos StandardCrypto type family ChainDepStateProtocol era where ChainDepStateProtocol ShelleyEra = Consensus.TPraosState StandardCrypto @@ -327,6 +339,7 @@ type family ChainDepStateProtocol era where ChainDepStateProtocol MaryEra = Consensus.TPraosState StandardCrypto ChainDepStateProtocol AlonzoEra = Consensus.TPraosState StandardCrypto ChainDepStateProtocol BabbageEra = Consensus.PraosState StandardCrypto + ChainDepStateProtocol ConwayEra = Consensus.PraosState StandardCrypto eraIndex0 :: Consensus.EraIndex (x0 : xs) eraIndex0 = Consensus.eraIndexZero @@ -346,6 +359,9 @@ eraIndex4 = eraIndexSucc eraIndex3 eraIndex5 :: Consensus.EraIndex (x5 : x4 : x3 : x2 : x1 : x0 : xs) eraIndex5 = eraIndexSucc eraIndex4 +eraIndex6 :: Consensus.EraIndex (x6 : x5 : x4 : x3 : x2 : x1 : x0 : xs) +eraIndex6 = eraIndexSucc eraIndex5 + toConsensusEraIndex :: ConsensusBlockForMode mode ~ Consensus.HardForkBlock xs => EraInMode era mode -> Consensus.EraIndex xs @@ -358,6 +374,7 @@ toConsensusEraIndex AllegraEraInCardanoMode = eraIndex2 toConsensusEraIndex MaryEraInCardanoMode = eraIndex3 toConsensusEraIndex AlonzoEraInCardanoMode = eraIndex4 toConsensusEraIndex BabbageEraInCardanoMode = eraIndex5 +toConsensusEraIndex ConwayEraInCardanoMode = eraIndex6 fromConsensusEraIndex :: ConsensusBlockForMode mode ~ Consensus.HardForkBlock xs @@ -403,3 +420,6 @@ fromConsensusEraIndex CardanoMode = fromShelleyEraIndex fromShelleyEraIndex (Consensus.EraIndex (S (S (S (S (S (Z (K ())))))))) = AnyEraInMode BabbageEraInCardanoMode + fromShelleyEraIndex (Consensus.EraIndex (S (S (S (S (S (S (Z (K ()))))))))) = + AnyEraInMode ConwayEraInCardanoMode + diff --git a/cardano-api/src/Cardano/Api/Orphans.hs b/cardano-api/src/Cardano/Api/Orphans.hs index 8eba1525bb7..3f41caff066 100644 --- a/cardano-api/src/Cardano/Api/Orphans.hs +++ b/cardano-api/src/Cardano/Api/Orphans.hs @@ -35,6 +35,7 @@ import qualified Cardano.Ledger.Babbage as Babbage import Cardano.Ledger.BaseTypes (StrictMaybe (..)) import qualified Cardano.Ledger.BaseTypes as Ledger import Cardano.Ledger.Compactible (Compactible (fromCompact)) +import qualified Cardano.Ledger.Conway as Conway import qualified Cardano.Ledger.Era as Ledger import qualified Cardano.Ledger.Shelley.PoolRank as Shelley import Cardano.Ledger.UnifiedMap (UnifiedMap) @@ -276,7 +277,7 @@ instance ToJSON (BabbagePParamsUpdate era) where ++ [ "collateralPercentage" .= x | x <- mbfield (Babbage._collateralPercentage pp) ] ++ [ "maxCollateralInputs" .= x | x <- mbfield (Babbage._maxCollateralInputs pp) ] -instance ToJSON (BabbagePParams (Babbage.BabbageEra Consensus.StandardCrypto)) where +instance ToJSON (BabbagePParams (era Consensus.StandardCrypto)) where toJSON pp = Aeson.object [ "minFeeA" .= Babbage._minfeeA pp @@ -344,11 +345,12 @@ instance ( Ledger.Era era SNothing -> toEncoding Aeson.Null SJust dH -> toEncoding $ ScriptDataHash dH - - instance ToJSON (AlonzoScript (Babbage.BabbageEra Consensus.StandardCrypto)) where toJSON = Aeson.String . Text.decodeUtf8 . B16.encode . CBOR.serialize' +instance ToJSON (AlonzoScript (Conway.ConwayEra Consensus.StandardCrypto)) where + toJSON = Aeson.String . Text.decodeUtf8 . B16.encode . CBOR.serialize' + instance Crypto.Crypto crypto => ToJSON (Shelley.DPState crypto) where toJSON = object . toDpStatePairs toEncoding = Aeson.pairs . mconcat . toDpStatePairs diff --git a/cardano-api/src/Cardano/Api/Protocol.hs b/cardano-api/src/Cardano/Api/Protocol.hs index c33d02e18b2..752a3072f3b 100644 --- a/cardano-api/src/Cardano/Api/Protocol.hs +++ b/cardano-api/src/Cardano/Api/Protocol.hs @@ -62,11 +62,13 @@ instance (CardanoHardForkConstraints StandardCrypto, IOLike m) => Protocol m (Ca (ProtocolParamsMary StandardCrypto) (ProtocolParamsAlonzo StandardCrypto) (ProtocolParamsBabbage StandardCrypto) + (ProtocolParamsConway StandardCrypto) (ProtocolTransitionParamsShelleyBased StandardShelley) (ProtocolTransitionParamsShelleyBased StandardAllegra) (ProtocolTransitionParamsShelleyBased StandardMary) (ProtocolTransitionParamsShelleyBased StandardAlonzo) (ProtocolTransitionParamsShelleyBased StandardBabbage) + (ProtocolTransitionParamsShelleyBased StandardConway) protocolInfo (ProtocolInfoArgsCardano paramsByron @@ -76,11 +78,13 @@ instance (CardanoHardForkConstraints StandardCrypto, IOLike m) => Protocol m (Ca paramsMary paramsAlonzo paramsBabbage + paramsConway paramsByronShelley paramsShelleyAllegra paramsAllegraMary paramsMaryAlonzo - paramsAlonzoBabbage) = + paramsAlonzoBabbage + paramsBabbageConway) = protocolInfoCardano paramsByron paramsShelleyBased @@ -89,11 +93,13 @@ instance (CardanoHardForkConstraints StandardCrypto, IOLike m) => Protocol m (Ca paramsMary paramsAlonzo paramsBabbage + paramsConway paramsByronShelley paramsShelleyAllegra paramsAllegraMary paramsMaryAlonzo paramsAlonzoBabbage + paramsBabbageConway instance ProtocolClient ByronBlockHFC where data ProtocolClientInfoArgs ByronBlockHFC = diff --git a/cardano-api/src/Cardano/Api/ProtocolParameters.hs b/cardano-api/src/Cardano/Api/ProtocolParameters.hs index 48797338aba..d68e9cfeff1 100644 --- a/cardano-api/src/Cardano/Api/ProtocolParameters.hs +++ b/cardano-api/src/Cardano/Api/ProtocolParameters.hs @@ -60,6 +60,7 @@ module Cardano.Api.ProtocolParameters ( toAlonzoCostModels, toAlonzoPParams, toBabbagePParams, + toConwayPParams, -- * Data family instances AsType(..) @@ -909,6 +910,7 @@ toLedgerPParamsUpdate ShelleyBasedEraAllegra = toShelleyPParamsUpdate toLedgerPParamsUpdate ShelleyBasedEraMary = toShelleyPParamsUpdate toLedgerPParamsUpdate ShelleyBasedEraAlonzo = toAlonzoPParamsUpdate toLedgerPParamsUpdate ShelleyBasedEraBabbage = toBabbagePParamsUpdate +toLedgerPParamsUpdate ShelleyBasedEraConway = toConwayPParamsUpdate --TODO: we should do validation somewhere, not just silently drop changes that @@ -1105,6 +1107,11 @@ toBabbagePParamsUpdate noInlineMaybeToStrictMaybe protocolUpdateUTxOCostPerByte } +-- Conway uses the same PParams as Babbage. +toConwayPParamsUpdate :: ProtocolParametersUpdate + -> BabbagePParamsUpdate ledgerera +toConwayPParamsUpdate = toBabbagePParamsUpdate + -- ---------------------------------------------------------------------------- -- Conversion functions: updates from ledger types -- @@ -1139,6 +1146,7 @@ fromLedgerPParamsUpdate ShelleyBasedEraAllegra = fromShelleyPParamsUpdate fromLedgerPParamsUpdate ShelleyBasedEraMary = fromShelleyPParamsUpdate fromLedgerPParamsUpdate ShelleyBasedEraAlonzo = fromAlonzoPParamsUpdate fromLedgerPParamsUpdate ShelleyBasedEraBabbage = fromBabbagePParamsUpdate +fromLedgerPParamsUpdate ShelleyBasedEraConway = fromConwayPParamsUpdate fromShelleyPParamsUpdate :: ShelleyPParamsUpdate ledgerera @@ -1343,6 +1351,9 @@ fromBabbagePParamsUpdate strictMaybeToMaybe _coinsPerUTxOByte } +fromConwayPParamsUpdate :: BabbagePParamsUpdate ledgerera + -> ProtocolParametersUpdate +fromConwayPParamsUpdate = fromBabbagePParamsUpdate -- ---------------------------------------------------------------------------- -- Conversion functions: protocol parameters to ledger types @@ -1360,6 +1371,7 @@ toLedgerPParams ShelleyBasedEraAllegra = toShelleyPParams toLedgerPParams ShelleyBasedEraMary = toShelleyPParams toLedgerPParams ShelleyBasedEraAlonzo = toAlonzoPParams toLedgerPParams ShelleyBasedEraBabbage = toBabbagePParams +toLedgerPParams ShelleyBasedEraConway = toConwayPParams toShelleyPParams :: ProtocolParameters -> ShelleyPParams ledgerera toShelleyPParams ProtocolParameters { @@ -1602,6 +1614,9 @@ toBabbagePParams ProtocolParameters { protocolParamCollateralPercent = Nothing } toBabbagePParams ProtocolParameters { protocolParamMaxCollateralInputs = Nothing } = error "toBabbagePParams: must specify protocolParamMaxCollateralInputs" +toConwayPParams :: ProtocolParameters -> BabbagePParams ledgerera +toConwayPParams = toBabbagePParams + -- ---------------------------------------------------------------------------- -- Conversion functions: protocol parameters from ledger types -- @@ -1615,6 +1630,7 @@ fromLedgerPParams ShelleyBasedEraAllegra = fromShelleyPParams fromLedgerPParams ShelleyBasedEraMary = fromShelleyPParams fromLedgerPParams ShelleyBasedEraAlonzo = fromAlonzoPParams fromLedgerPParams ShelleyBasedEraBabbage = fromBabbagePParams +fromLedgerPParams ShelleyBasedEraConway = fromConwayPParams fromShelleyPParams :: ShelleyPParams ledgerera @@ -1784,6 +1800,9 @@ fromBabbagePParams , protocolParamUTxOCostPerByte = Just (fromShelleyLovelace _coinsPerUTxOByte) } +fromConwayPParams :: BabbagePParams ledgerera -> ProtocolParameters +fromConwayPParams = fromBabbagePParams + data ProtocolParametersError = PParamsErrorMissingMinUTxoValue AnyCardanoEra | PParamsErrorMissingAlonzoProtocolParameter @@ -1814,6 +1833,7 @@ checkProtocolParameters sbe ProtocolParameters{..} = ShelleyBasedEraMary -> checkMinUTxOVal ShelleyBasedEraAlonzo -> checkAlonzoParams ShelleyBasedEraBabbage -> checkBabbageParams + ShelleyBasedEraConway -> checkBabbageParams where era :: CardanoEra era era = shelleyBasedToCardanoEra sbe diff --git a/cardano-api/src/Cardano/Api/Query.hs b/cardano-api/src/Cardano/Api/Query.hs index e18603e70f1..b53a5372f98 100644 --- a/cardano-api/src/Cardano/Api/Query.hs +++ b/cardano-api/src/Cardano/Api/Query.hs @@ -609,6 +609,7 @@ toConsensusQuery (QueryInEra erainmode (QueryInShelleyBasedEra era q)) = MaryEraInCardanoMode -> toConsensusQueryShelleyBased erainmode q AlonzoEraInCardanoMode -> toConsensusQueryShelleyBased erainmode q BabbageEraInCardanoMode -> toConsensusQueryShelleyBased erainmode q + ConwayEraInCardanoMode -> toConsensusQueryShelleyBased erainmode q toConsensusQueryShelleyBased @@ -707,6 +708,7 @@ consensusQueryInEraInMode erainmode = MaryEraInCardanoMode -> Consensus.QueryIfCurrentMary AlonzoEraInCardanoMode -> Consensus.QueryIfCurrentAlonzo BabbageEraInCardanoMode -> Consensus.QueryIfCurrentBabbage + ConwayEraInCardanoMode -> Consensus.QueryIfCurrentConway -- ---------------------------------------------------------------------------- -- Conversions of query results from the consensus types. @@ -830,6 +832,16 @@ fromConsensusQueryResult (QueryInEra BabbageEraInCardanoMode r' _ -> fromConsensusQueryResultMismatch +fromConsensusQueryResult (QueryInEra ConwayEraInCardanoMode + (QueryInShelleyBasedEra _era q)) q' r' = + case q' of + Consensus.BlockQuery (Consensus.QueryIfCurrentConway q'') + -> bimap fromConsensusEraMismatch + (fromConsensusQueryResultShelleyBased + ShelleyBasedEraConway q q'') + r' + _ -> fromConsensusQueryResultMismatch + fromConsensusQueryResultShelleyBased :: forall era ledgerera protocol result result'. ShelleyLedgerEra era ~ ledgerera diff --git a/cardano-api/src/Cardano/Api/Script.hs b/cardano-api/src/Cardano/Api/Script.hs index 272dc715aa2..5beeec4c095 100644 --- a/cardano-api/src/Cardano/Api/Script.hs +++ b/cardano-api/src/Cardano/Api/Script.hs @@ -517,11 +517,14 @@ data ScriptLanguageInEra lang era where SimpleScriptInMary :: ScriptLanguageInEra SimpleScript' MaryEra SimpleScriptInAlonzo :: ScriptLanguageInEra SimpleScript' AlonzoEra SimpleScriptInBabbage :: ScriptLanguageInEra SimpleScript' BabbageEra + SimpleScriptInConway :: ScriptLanguageInEra SimpleScript' ConwayEra PlutusScriptV1InAlonzo :: ScriptLanguageInEra PlutusScriptV1 AlonzoEra PlutusScriptV1InBabbage :: ScriptLanguageInEra PlutusScriptV1 BabbageEra + PlutusScriptV1InConway :: ScriptLanguageInEra PlutusScriptV1 ConwayEra PlutusScriptV2InBabbage :: ScriptLanguageInEra PlutusScriptV2 BabbageEra + PlutusScriptV2InConway :: ScriptLanguageInEra PlutusScriptV2 ConwayEra @@ -569,6 +572,9 @@ scriptLanguageSupportedInEra era lang = (BabbageEra, PlutusScriptLanguage PlutusScriptV2) -> Just PlutusScriptV2InBabbage + (ConwayEra, PlutusScriptLanguage PlutusScriptV2) -> + Just PlutusScriptV2InConway + _ -> Nothing languageOfScriptLanguageInEra :: ScriptLanguageInEra lang era @@ -580,10 +586,14 @@ languageOfScriptLanguageInEra langInEra = SimpleScriptInMary -> SimpleScriptLanguage SimpleScriptInAlonzo -> SimpleScriptLanguage SimpleScriptInBabbage -> SimpleScriptLanguage + SimpleScriptInConway -> SimpleScriptLanguage PlutusScriptV1InAlonzo -> PlutusScriptLanguage PlutusScriptV1 PlutusScriptV1InBabbage -> PlutusScriptLanguage PlutusScriptV1 + PlutusScriptV1InConway -> PlutusScriptLanguage PlutusScriptV1 + PlutusScriptV2InBabbage -> PlutusScriptLanguage PlutusScriptV2 + PlutusScriptV2InConway -> PlutusScriptLanguage PlutusScriptV2 eraOfScriptLanguageInEra :: ScriptLanguageInEra lang era -> ShelleyBasedEra era @@ -599,8 +609,12 @@ eraOfScriptLanguageInEra langInEra = PlutusScriptV1InAlonzo -> ShelleyBasedEraAlonzo SimpleScriptInBabbage -> ShelleyBasedEraBabbage + SimpleScriptInConway -> ShelleyBasedEraConway + PlutusScriptV1InBabbage -> ShelleyBasedEraBabbage + PlutusScriptV1InConway -> ShelleyBasedEraConway PlutusScriptV2InBabbage -> ShelleyBasedEraBabbage + PlutusScriptV2InConway -> ShelleyBasedEraConway -- | Given a target era and a script in some language, check if the language is -- supported in that era, and if so return a 'ScriptInEra'. @@ -744,6 +758,9 @@ scriptWitnessScript (SimpleScriptWitness SimpleScriptInAlonzo (SScript script)) scriptWitnessScript (SimpleScriptWitness SimpleScriptInBabbage (SScript script)) = Just $ ScriptInEra SimpleScriptInBabbage (SimpleScript script) +scriptWitnessScript (SimpleScriptWitness SimpleScriptInConway (SScript script)) = + Just $ ScriptInEra SimpleScriptInConway (SimpleScript script) + scriptWitnessScript (PlutusScriptWitness langInEra version (PScript script) _ _ _) = Just $ ScriptInEra langInEra (PlutusScript version script) @@ -1008,17 +1025,20 @@ toShelleyScript (ScriptInEra langInEra (SimpleScript script)) = SimpleScriptInMary -> toAllegraTimelock script SimpleScriptInAlonzo -> Alonzo.TimelockScript (toAllegraTimelock script) SimpleScriptInBabbage -> Alonzo.TimelockScript (toAllegraTimelock script) + SimpleScriptInConway -> Alonzo.TimelockScript (toAllegraTimelock script) toShelleyScript (ScriptInEra langInEra (PlutusScript PlutusScriptV1 (PlutusScriptSerialised script))) = case langInEra of PlutusScriptV1InAlonzo -> Alonzo.PlutusScript Alonzo.PlutusV1 script PlutusScriptV1InBabbage -> Alonzo.PlutusScript Alonzo.PlutusV1 script + PlutusScriptV1InConway -> Alonzo.PlutusScript Alonzo.PlutusV1 script toShelleyScript (ScriptInEra langInEra (PlutusScript PlutusScriptV2 (PlutusScriptSerialised script))) = case langInEra of PlutusScriptV2InBabbage -> Alonzo.PlutusScript Alonzo.PlutusV2 script + PlutusScriptV2InConway -> Alonzo.PlutusScript Alonzo.PlutusV2 script fromShelleyBasedScript :: ShelleyBasedEra era -> Ledger.Script (ShelleyLedgerEra era) @@ -1057,6 +1077,18 @@ fromShelleyBasedScript era script = ScriptInEra PlutusScriptV2InBabbage . PlutusScript PlutusScriptV2 $ PlutusScriptSerialised s + ShelleyBasedEraConway -> + case script of + Alonzo.TimelockScript s -> + ScriptInEra SimpleScriptInConway + . SimpleScript $ fromAllegraTimelock s + Alonzo.PlutusScript Alonzo.PlutusV1 s -> + ScriptInEra PlutusScriptV1InConway + . PlutusScript PlutusScriptV1 $ PlutusScriptSerialised s + Alonzo.PlutusScript Alonzo.PlutusV2 s -> + ScriptInEra PlutusScriptV2InConway + . PlutusScript PlutusScriptV2 $ PlutusScriptSerialised s + data MultiSigError = MultiSigErrorTimelockNotsupported deriving Show @@ -1280,6 +1312,7 @@ instance EraCast ReferenceScript where data ReferenceTxInsScriptsInlineDatumsSupportedInEra era where ReferenceTxInsScriptsInlineDatumsInBabbageEra :: ReferenceTxInsScriptsInlineDatumsSupportedInEra BabbageEra + ReferenceTxInsScriptsInlineDatumsInConwayEra :: ReferenceTxInsScriptsInlineDatumsSupportedInEra ConwayEra deriving instance Eq (ReferenceTxInsScriptsInlineDatumsSupportedInEra era) deriving instance Show (ReferenceTxInsScriptsInlineDatumsSupportedInEra era) @@ -1292,6 +1325,7 @@ refInsScriptsAndInlineDatsSupportedInEra AllegraEra = Nothing refInsScriptsAndInlineDatsSupportedInEra MaryEra = Nothing refInsScriptsAndInlineDatsSupportedInEra AlonzoEra = Nothing refInsScriptsAndInlineDatsSupportedInEra BabbageEra = Just ReferenceTxInsScriptsInlineDatumsInBabbageEra +refInsScriptsAndInlineDatsSupportedInEra ConwayEra = Just ReferenceTxInsScriptsInlineDatumsInConwayEra refScriptToShelleyScript :: CardanoEra era diff --git a/cardano-api/src/Cardano/Api/SerialiseLedgerCddl.hs b/cardano-api/src/Cardano/Api/SerialiseLedgerCddl.hs index a91f7e2ddc1..09f4f32c2cb 100644 --- a/cardano-api/src/Cardano/Api/SerialiseLedgerCddl.hs +++ b/cardano-api/src/Cardano/Api/SerialiseLedgerCddl.hs @@ -140,6 +140,7 @@ serialiseTxLedgerCddl tx = MaryEra -> "Tx MaryEra" AlonzoEra -> "Tx AlonzoEra" BabbageEra -> "Tx BabbageEra" + ConwayEra -> "Tx ConwayEra" deserialiseTxLedgerCddl :: IsCardanoEra era @@ -187,6 +188,7 @@ serialiseWitnessLedgerCddl sbe kw = witEra ShelleyBasedEraMary = "TxWitness MaryEra" witEra ShelleyBasedEraAlonzo = "TxWitness AlonzoEra" witEra ShelleyBasedEraBabbage = "TxWitness BabbageEra" + witEra ShelleyBasedEraConway = "TxWitness ConwayEra" deserialiseWitnessLedgerCddl :: ShelleyBasedEra era diff --git a/cardano-api/src/Cardano/Api/Tx.hs b/cardano-api/src/Cardano/Api/Tx.hs index 62479b587eb..49831955702 100644 --- a/cardano-api/src/Cardano/Api/Tx.hs +++ b/cardano-api/src/Cardano/Api/Tx.hs @@ -153,6 +153,7 @@ instance Eq (Tx era) where ShelleyBasedEraMary -> txA == txB ShelleyBasedEraAlonzo -> txA == txB ShelleyBasedEraBabbage -> txA == txB + ShelleyBasedEraConway -> txA == txB (==) ByronTx{} (ShelleyTx era _) = case era of {} (==) (ShelleyTx era _) ByronTx{} = case era of {} @@ -189,6 +190,11 @@ instance Show (Tx era) where showString "ShelleyTx ShelleyBasedEraBabbage " . showsPrec 11 tx + showsPrec p (ShelleyTx ShelleyBasedEraConway tx) = + showParen (p >= 11) $ + showString "ShelleyTx ShelleyBasedEraConway " + . showsPrec 11 tx + instance HasTypeProxy era => HasTypeProxy (Tx era) where data AsType (Tx era) = AsTx (AsType era) proxyToAsType _ = AsTx (proxyToAsType (Proxy :: Proxy era)) @@ -225,6 +231,7 @@ instance IsCardanoEra era => SerialiseAsCBOR (Tx era) where ShelleyBasedEraMary -> serialiseShelleyBasedTx tx ShelleyBasedEraAlonzo -> serialiseShelleyBasedTx tx ShelleyBasedEraBabbage -> serialiseShelleyBasedTx tx + ShelleyBasedEraConway -> serialiseShelleyBasedTx tx deserialiseFromCBOR _ bs = case cardanoEra :: CardanoEra era of @@ -244,6 +251,8 @@ instance IsCardanoEra era => SerialiseAsCBOR (Tx era) where (ShelleyTx ShelleyBasedEraAlonzo) bs BabbageEra -> deserialiseShelleyBasedTx (ShelleyTx ShelleyBasedEraBabbage) bs + ConwayEra -> deserialiseShelleyBasedTx + (ShelleyTx ShelleyBasedEraConway) bs -- | The serialisation format for the different Shelley-based eras are not the -- same, but they can be handled generally with one overloaded implementation. @@ -268,7 +277,7 @@ instance IsCardanoEra era => HasTextEnvelope (Tx era) where MaryEra -> "Tx MaryEra" AlonzoEra -> "Tx AlonzoEra" BabbageEra -> "Tx BabbageEra" - + ConwayEra -> "Tx ConwayEra" data KeyWitness era where @@ -300,6 +309,7 @@ instance Eq (KeyWitness era) where ShelleyBasedEraMary -> wA == wB ShelleyBasedEraAlonzo -> wA == wB ShelleyBasedEraBabbage -> wA == wB + ShelleyBasedEraConway -> wA == wB (==) (ShelleyKeyWitness era wA) (ShelleyKeyWitness _ wB) = @@ -309,6 +319,7 @@ instance Eq (KeyWitness era) where ShelleyBasedEraMary -> wA == wB ShelleyBasedEraAlonzo -> wA == wB ShelleyBasedEraBabbage -> wA == wB + ShelleyBasedEraConway -> wA == wB (==) _ _ = False @@ -346,6 +357,11 @@ instance Show (KeyWitness era) where showString "ShelleyBootstrapWitness ShelleyBasedEraBabbage " . showsPrec 11 tx + showsPrec p (ShelleyBootstrapWitness ShelleyBasedEraConway tx) = + showParen (p >= 11) $ + showString "ShelleyBootstrapWitness ShelleyBasedEraConway " + . showsPrec 11 tx + showsPrec p (ShelleyKeyWitness ShelleyBasedEraShelley tx) = showParen (p >= 11) $ showString "ShelleyKeyWitness ShelleyBasedEraShelley " @@ -371,6 +387,11 @@ instance Show (KeyWitness era) where showString "ShelleyKeyWitness ShelleyBasedEraBabbage " . showsPrec 11 tx + showsPrec p (ShelleyKeyWitness ShelleyBasedEraConway tx) = + showParen (p >= 11) $ + showString "ShelleyKeyWitness ShelleyBasedEraConway " + . showsPrec 11 tx + instance HasTypeProxy era => HasTypeProxy (KeyWitness era) where data AsType (KeyWitness era) = AsKeyWitness (AsType era) proxyToAsType _ = AsKeyWitness (proxyToAsType (Proxy :: Proxy era)) @@ -408,6 +429,7 @@ instance IsCardanoEra era => SerialiseAsCBOR (KeyWitness era) where MaryEra -> decodeShelleyBasedWitness ShelleyBasedEraMary bs AlonzoEra -> decodeShelleyBasedWitness ShelleyBasedEraAlonzo bs BabbageEra -> decodeShelleyBasedWitness ShelleyBasedEraBabbage bs + ConwayEra -> decodeShelleyBasedWitness ShelleyBasedEraConway bs encodeShelleyBasedKeyWitness :: ToCBOR w => w -> CBOR.Encoding @@ -445,6 +467,7 @@ instance IsCardanoEra era => HasTextEnvelope (KeyWitness era) where MaryEra -> "TxWitness MaryEra" AlonzoEra -> "TxWitness AlonzoEra" BabbageEra -> "TxWitness BabbageEra" + ConwayEra -> "TxWitness ConwayEra" pattern Tx :: TxBody era -> [KeyWitness era] -> Tx era pattern Tx txbody ws <- (getTxBodyAndWitnesses -> (txbody, ws)) @@ -468,6 +491,8 @@ getTxBody (ShelleyTx era tx) = getAlonzoTxBody ScriptDataInAlonzoEra TxScriptValiditySupportedInAlonzoEra tx ShelleyBasedEraBabbage -> getAlonzoTxBody ScriptDataInBabbageEra TxScriptValiditySupportedInBabbageEra tx + ShelleyBasedEraConway -> + getAlonzoTxBody ScriptDataInConwayEra TxScriptValiditySupportedInConwayEra tx where getShelleyTxBody :: forall ledgerera. ShelleyLedgerEra era ~ ledgerera @@ -529,6 +554,7 @@ getTxWitnesses (ShelleyTx era tx) = ShelleyBasedEraMary -> getShelleyTxWitnesses tx ShelleyBasedEraAlonzo -> getAlonzoTxWitnesses tx ShelleyBasedEraBabbage -> getAlonzoTxWitnesses tx + ShelleyBasedEraConway -> getAlonzoTxWitnesses tx where getShelleyTxWitnesses :: forall ledgerera. Ledger.EraTx ledgerera @@ -587,6 +613,7 @@ makeSignedTransaction witnesses (ShelleyTxBody era txbody ShelleyBasedEraMary -> makeShelleySignedTransaction txbody ShelleyBasedEraAlonzo -> makeAlonzoSignedTransaction txbody ShelleyBasedEraBabbage -> makeAlonzoSignedTransaction txbody + ShelleyBasedEraConway -> makeAlonzoSignedTransaction txbody where makeShelleySignedTransaction :: forall ledgerera. @@ -705,6 +732,8 @@ makeShelleyBootstrapWitness nwOrAddr (ShelleyTxBody era txbody _ _ _ _) sk = makeShelleyBasedBootstrapWitness era nwOrAddr txbody sk ShelleyBasedEraBabbage -> makeShelleyBasedBootstrapWitness era nwOrAddr txbody sk + ShelleyBasedEraConway -> + makeShelleyBasedBootstrapWitness era nwOrAddr txbody sk makeShelleyBasedBootstrapWitness :: forall era. @@ -816,6 +845,7 @@ makeShelleyKeyWitness (ShelleyTxBody era txbody _ _ _ _) = ShelleyBasedEraMary -> makeShelleyBasedKeyWitness txbody ShelleyBasedEraAlonzo -> makeShelleyBasedKeyWitness txbody ShelleyBasedEraBabbage -> makeShelleyBasedKeyWitness txbody + ShelleyBasedEraConway -> makeShelleyBasedKeyWitness txbody where makeShelleyBasedKeyWitness :: Ledger.HashAnnotated (Ledger.TxBody (ShelleyLedgerEra era)) Ledger.EraIndependentTxBody StandardCrypto => Ledger.TxBody (ShelleyLedgerEra era) diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index 5eeac881c53..fe72e3045d3 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -247,8 +247,9 @@ import qualified Cardano.Ledger.Alonzo.TxWitness as Alonzo import qualified Cardano.Ledger.Babbage.PParams as Babbage import qualified Cardano.Ledger.Babbage.TxBody as Babbage +import qualified Cardano.Ledger.Conway.TxBody as Conway import Ouroboros.Consensus.Shelley.Eras (StandardAllegra, StandardAlonzo, StandardBabbage, - StandardMary, StandardShelley) + StandardConway, StandardMary, StandardShelley) import Cardano.Api.Address import Cardano.Api.Certificate @@ -319,6 +320,7 @@ deriving instance Show (TxScriptValiditySupportedInEra era) data TxScriptValiditySupportedInEra era where TxScriptValiditySupportedInAlonzoEra :: TxScriptValiditySupportedInEra AlonzoEra TxScriptValiditySupportedInBabbageEra :: TxScriptValiditySupportedInEra BabbageEra + TxScriptValiditySupportedInConwayEra :: TxScriptValiditySupportedInEra ConwayEra deriving instance Eq (TxScriptValidity era) deriving instance Show (TxScriptValidity era) @@ -330,6 +332,7 @@ txScriptValiditySupportedInCardanoEra AllegraEra = Nothing txScriptValiditySupportedInCardanoEra MaryEra = Nothing txScriptValiditySupportedInCardanoEra AlonzoEra = Just TxScriptValiditySupportedInAlonzoEra txScriptValiditySupportedInCardanoEra BabbageEra = Just TxScriptValiditySupportedInBabbageEra +txScriptValiditySupportedInCardanoEra ConwayEra = Just TxScriptValiditySupportedInConwayEra txScriptValiditySupportedInShelleyBasedEra :: ShelleyBasedEra era -> Maybe (TxScriptValiditySupportedInEra era) txScriptValiditySupportedInShelleyBasedEra ShelleyBasedEraShelley = Nothing @@ -337,6 +340,7 @@ txScriptValiditySupportedInShelleyBasedEra ShelleyBasedEraAllegra = Nothing txScriptValiditySupportedInShelleyBasedEra ShelleyBasedEraMary = Nothing txScriptValiditySupportedInShelleyBasedEra ShelleyBasedEraAlonzo = Just TxScriptValiditySupportedInAlonzoEra txScriptValiditySupportedInShelleyBasedEra ShelleyBasedEraBabbage = Just TxScriptValiditySupportedInBabbageEra +txScriptValiditySupportedInShelleyBasedEra ShelleyBasedEraConway = Just TxScriptValiditySupportedInConwayEra txScriptValidityToScriptValidity :: TxScriptValidity era -> ScriptValidity txScriptValidityToScriptValidity TxScriptValidityNone = ScriptValid @@ -426,6 +430,15 @@ txOutToJsonValue era (TxOut addr val dat refScript) = , "inlineDatum" .= inlineDatumJsonVal dat , "referenceScript" .= refScriptJsonVal refScript ] + ConwayEra -> + object + [ "address" .= addr + , "value" .= val + , datHashJsonVal dat + , "datum" .= datJsonVal dat + , "inlineDatum" .= inlineDatumJsonVal dat + , "referenceScript" .= refScriptJsonVal refScript + ] where datHashJsonVal :: TxOutDatum ctx era -> Aeson.Pair datHashJsonVal d = @@ -502,14 +515,37 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxTx era) where mReferenceScript <- o .:? "referenceScript" - reconcile alonzoTxOutInBabbage mInlineDatum mReferenceScript + reconcileBabbage alonzoTxOutInBabbage mInlineDatum mReferenceScript + + ShelleyBasedEraConway -> do + alonzoTxOutInConway <- alonzoTxOutParser ScriptDataInConwayEra o + + -- We check for the existence of inline datums + inlineDatumHash <- o .:? "inlineDatumhash" + inlineDatum <- o .:? "inlineDatum" + mInlineDatum <- + case (inlineDatum, inlineDatumHash) of + (Just dVal, Just h) -> + case scriptDataFromJson ScriptDataJsonDetailedSchema dVal of + Left err -> + fail $ "Error parsing TxOut JSON: " <> displayError err + Right sData -> + if hashScriptDataBytes sData /= h + then fail "Inline datum not equivalent to inline datum hash" + else return $ TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInConwayEra sData + (Nothing, Nothing) -> return TxOutDatumNone + (_,_) -> fail "Should not be possible to create a tx output with either an inline datum hash or an inline datum" + + mReferenceScript <- o .:? "referenceScript" + + reconcileConway alonzoTxOutInConway mInlineDatum mReferenceScript where - reconcile + reconcileBabbage :: TxOut CtxTx BabbageEra -- ^ Alonzo era datum in Babbage era - -> TxOutDatum CtxTx BabbageEra -- ^ Babbagae inline datum + -> TxOutDatum CtxTx BabbageEra -- ^ Babbage inline datum -> Maybe ScriptInAnyLang -> Aeson.Parser (TxOut CtxTx BabbageEra) - reconcile top@(TxOut addr v dat r) babbageDatum mBabRefScript = do + reconcileBabbage top@(TxOut addr v dat r) babbageDatum mBabRefScript = do -- We check for conflicting datums finalDat <- case (dat, babbageDatum) of (TxOutDatumNone, bDatum) -> return bDatum @@ -525,6 +561,27 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxTx era) where return $ ReferenceScript ReferenceTxInsScriptsInlineDatumsInBabbageEra anyScript return $ TxOut addr v finalDat finalRefScript + reconcileConway + :: TxOut CtxTx ConwayEra -- ^ Alonzo era datum in Conway era + -> TxOutDatum CtxTx ConwayEra -- ^ Babbage inline datum + -> Maybe ScriptInAnyLang + -> Aeson.Parser (TxOut CtxTx ConwayEra) + reconcileConway top@(TxOut addr v dat r) babbageDatum mBabRefScript = do + -- We check for conflicting datums + finalDat <- case (dat, babbageDatum) of + (TxOutDatumNone, bDatum) -> return bDatum + (anyDat, TxOutDatumNone) -> return anyDat + (alonzoDat, babbageDat) -> + fail $ "Parsed an Alonzo era datum and a Conway era datum " <> + "TxOut: " <> show top <> + "Alonzo datum: " <> show alonzoDat <> + "Conway dat: " <> show babbageDat + finalRefScript <- case mBabRefScript of + Nothing -> return r + Just anyScript -> + return $ ReferenceScript ReferenceTxInsScriptsInlineDatumsInConwayEra anyScript + return $ TxOut addr v finalDat finalRefScript + alonzoTxOutParser :: ScriptDataSupportedInEra era -> Aeson.Object -> Aeson.Parser (TxOut CtxTx era) alonzoTxOutParser supp o = do @@ -592,14 +649,38 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxUTxO era) where -- We check for a reference script mReferenceScript <- o .:? "referenceScript" - reconcile alonzoTxOutInBabbage mInlineDatum mReferenceScript + reconcileBabbage alonzoTxOutInBabbage mInlineDatum mReferenceScript + + ShelleyBasedEraConway -> do + alonzoTxOutInConway <- alonzoTxOutParser ScriptDataInConwayEra o + + -- We check for the existence of inline datums + inlineDatumHash <- o .:? "inlineDatumhash" + inlineDatum <- o .:? "inlineDatum" + mInlineDatum <- + case (inlineDatum, inlineDatumHash) of + (Just dVal, Just h) -> + case scriptDataFromJson ScriptDataJsonDetailedSchema dVal of + Left err -> + fail $ "Error parsing TxOut JSON: " <> displayError err + Right sData -> + if hashScriptDataBytes sData /= h + then fail "Inline datum not equivalent to inline datum hash" + else return $ TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInConwayEra sData + (Nothing, Nothing) -> return TxOutDatumNone + (_,_) -> fail "Should not be possible to create a tx output with either an inline datum hash or an inline datum" + + -- We check for a reference script + mReferenceScript <- o .:? "referenceScript" + + reconcileConway alonzoTxOutInConway mInlineDatum mReferenceScript where - reconcile + reconcileBabbage :: TxOut CtxUTxO BabbageEra -- ^ Alonzo era datum in Babbage era - -> TxOutDatum CtxUTxO BabbageEra -- ^ Babbagae inline datum + -> TxOutDatum CtxUTxO BabbageEra -- ^ Babbage inline datum -> Maybe ScriptInAnyLang -> Aeson.Parser (TxOut CtxUTxO BabbageEra) - reconcile (TxOut addr v dat r) babbageDatum mBabRefScript = do + reconcileBabbage (TxOut addr v dat r) babbageDatum mBabRefScript = do -- We check for conflicting datums finalDat <- case (dat, babbageDatum) of (TxOutDatumNone, bDatum) -> return bDatum @@ -612,6 +693,24 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxUTxO era) where return $ TxOut addr v finalDat finalRefScript + reconcileConway + :: TxOut CtxUTxO ConwayEra -- ^ Alonzo era datum in Conway era + -> TxOutDatum CtxUTxO ConwayEra -- ^ Babbage inline datum + -> Maybe ScriptInAnyLang + -> Aeson.Parser (TxOut CtxUTxO ConwayEra) + reconcileConway (TxOut addr v dat r) babbageDatum mBabRefScript = do + -- We check for conflicting datums + finalDat <- case (dat, babbageDatum) of + (TxOutDatumNone, bDatum) -> return bDatum + (anyDat, TxOutDatumNone) -> return anyDat + (_,_) -> fail "Parsed an Alonzo era datum and a Conway era datum" + finalRefScript <- case mBabRefScript of + Nothing -> return r + Just anyScript -> + return $ ReferenceScript ReferenceTxInsScriptsInlineDatumsInConwayEra anyScript + + return $ TxOut addr v finalDat finalRefScript + alonzoTxOutParser :: ScriptDataSupportedInEra era -> Aeson.Object -> Aeson.Parser (TxOut CtxUTxO era) alonzoTxOutParser supp o = do mDatumHash <- o .:? "datumhash" @@ -673,6 +772,10 @@ toShelleyTxOut era (TxOut addr (TxOutValue MultiAssetInBabbageEra value) txoutda (toBabbageTxOutDatum txoutdata) (refScriptToShelleyScript cEra refScript) +toShelleyTxOut era (TxOut addr (TxOutValue MultiAssetInConwayEra value) txoutdata refScript) = + let cEra = shelleyBasedToCardanoEra era + in BabbageTxOut (toShelleyAddr addr) (toMaryValue value) + (toBabbageTxOutDatum txoutdata) (refScriptToShelleyScript cEra refScript) fromShelleyTxOut :: ShelleyLedgerEra era ~ ledgerera => ShelleyBasedEra era @@ -728,6 +831,20 @@ fromShelleyTxOut era ledgerTxOut = where BabbageTxOut addr value datum mRefScript = ledgerTxOut + ShelleyBasedEraConway -> + TxOut (fromShelleyAddr era addr) + (TxOutValue MultiAssetInConwayEra + (fromMaryValue value)) + (fromBabbageTxOutDatum + ScriptDataInConwayEra + ReferenceTxInsScriptsInlineDatumsInConwayEra + datum) + (case mRefScript of + SNothing -> ReferenceScriptNone + SJust refScript -> + fromShelleyScriptToReferenceScript ShelleyBasedEraConway refScript) + where + BabbageTxOut addr value datum mRefScript = ledgerTxOut -- TODO: If ledger creates an open type family for datums @@ -782,6 +899,7 @@ data CollateralSupportedInEra era where CollateralInAlonzoEra :: CollateralSupportedInEra AlonzoEra CollateralInBabbageEra :: CollateralSupportedInEra BabbageEra + CollateralInConwayEra :: CollateralSupportedInEra ConwayEra deriving instance Eq (CollateralSupportedInEra era) deriving instance Show (CollateralSupportedInEra era) @@ -794,6 +912,7 @@ collateralSupportedInEra AllegraEra = Nothing collateralSupportedInEra MaryEra = Nothing collateralSupportedInEra AlonzoEra = Just CollateralInAlonzoEra collateralSupportedInEra BabbageEra = Just CollateralInBabbageEra +collateralSupportedInEra ConwayEra = Just CollateralInConwayEra -- | A representation of whether the era supports multi-asset transactions. @@ -813,6 +932,9 @@ data MultiAssetSupportedInEra era where -- | Multi-asset transactions are supported in the 'Babbage' era. MultiAssetInBabbageEra :: MultiAssetSupportedInEra BabbageEra + -- | Multi-asset transactions are supported in the 'Conway' era. + MultiAssetInConwayEra :: MultiAssetSupportedInEra ConwayEra + deriving instance Eq (MultiAssetSupportedInEra era) deriving instance Show (MultiAssetSupportedInEra era) @@ -845,6 +967,7 @@ multiAssetSupportedInEra AllegraEra = Left AdaOnlyInAllegraEra multiAssetSupportedInEra MaryEra = Right MultiAssetInMaryEra multiAssetSupportedInEra AlonzoEra = Right MultiAssetInAlonzoEra multiAssetSupportedInEra BabbageEra = Right MultiAssetInBabbageEra +multiAssetSupportedInEra ConwayEra = Right MultiAssetInConwayEra -- | A representation of whether the era requires explicitly specified fees in @@ -861,6 +984,7 @@ data TxFeesExplicitInEra era where TxFeesExplicitInMaryEra :: TxFeesExplicitInEra MaryEra TxFeesExplicitInAlonzoEra :: TxFeesExplicitInEra AlonzoEra TxFeesExplicitInBabbageEra :: TxFeesExplicitInEra BabbageEra + TxFeesExplicitInConwayEra :: TxFeesExplicitInEra ConwayEra deriving instance Eq (TxFeesExplicitInEra era) deriving instance Show (TxFeesExplicitInEra era) @@ -885,6 +1009,7 @@ txFeesExplicitInEra AllegraEra = Right TxFeesExplicitInAllegraEra txFeesExplicitInEra MaryEra = Right TxFeesExplicitInMaryEra txFeesExplicitInEra AlonzoEra = Right TxFeesExplicitInAlonzoEra txFeesExplicitInEra BabbageEra = Right TxFeesExplicitInBabbageEra +txFeesExplicitInEra ConwayEra = Right TxFeesExplicitInConwayEra -- | A representation of whether the era supports transactions with an upper @@ -901,6 +1026,7 @@ data ValidityUpperBoundSupportedInEra era where ValidityUpperBoundInMaryEra :: ValidityUpperBoundSupportedInEra MaryEra ValidityUpperBoundInAlonzoEra :: ValidityUpperBoundSupportedInEra AlonzoEra ValidityUpperBoundInBabbageEra :: ValidityUpperBoundSupportedInEra BabbageEra + ValidityUpperBoundInConwayEra :: ValidityUpperBoundSupportedInEra ConwayEra deriving instance Eq (ValidityUpperBoundSupportedInEra era) deriving instance Show (ValidityUpperBoundSupportedInEra era) @@ -913,6 +1039,7 @@ validityUpperBoundSupportedInEra AllegraEra = Just ValidityUpperBoundInAllegraEr validityUpperBoundSupportedInEra MaryEra = Just ValidityUpperBoundInMaryEra validityUpperBoundSupportedInEra AlonzoEra = Just ValidityUpperBoundInAlonzoEra validityUpperBoundSupportedInEra BabbageEra = Just ValidityUpperBoundInBabbageEra +validityUpperBoundSupportedInEra ConwayEra = Just ValidityUpperBoundInConwayEra -- | A representation of whether the era supports transactions having /no/ @@ -932,6 +1059,7 @@ data ValidityNoUpperBoundSupportedInEra era where ValidityNoUpperBoundInMaryEra :: ValidityNoUpperBoundSupportedInEra MaryEra ValidityNoUpperBoundInAlonzoEra :: ValidityNoUpperBoundSupportedInEra AlonzoEra ValidityNoUpperBoundInBabbageEra :: ValidityNoUpperBoundSupportedInEra BabbageEra + ValidityNoUpperBoundInConwayEra :: ValidityNoUpperBoundSupportedInEra ConwayEra deriving instance Eq (ValidityNoUpperBoundSupportedInEra era) deriving instance Show (ValidityNoUpperBoundSupportedInEra era) @@ -944,6 +1072,7 @@ validityNoUpperBoundSupportedInEra AllegraEra = Just ValidityNoUpperBoundInAlleg validityNoUpperBoundSupportedInEra MaryEra = Just ValidityNoUpperBoundInMaryEra validityNoUpperBoundSupportedInEra AlonzoEra = Just ValidityNoUpperBoundInAlonzoEra validityNoUpperBoundSupportedInEra BabbageEra = Just ValidityNoUpperBoundInBabbageEra +validityNoUpperBoundSupportedInEra ConwayEra = Just ValidityNoUpperBoundInConwayEra -- | A representation of whether the era supports transactions with a lower @@ -959,6 +1088,7 @@ data ValidityLowerBoundSupportedInEra era where ValidityLowerBoundInMaryEra :: ValidityLowerBoundSupportedInEra MaryEra ValidityLowerBoundInAlonzoEra :: ValidityLowerBoundSupportedInEra AlonzoEra ValidityLowerBoundInBabbageEra :: ValidityLowerBoundSupportedInEra BabbageEra + ValidityLowerBoundInConwayEra :: ValidityLowerBoundSupportedInEra ConwayEra deriving instance Eq (ValidityLowerBoundSupportedInEra era) deriving instance Show (ValidityLowerBoundSupportedInEra era) @@ -971,6 +1101,7 @@ validityLowerBoundSupportedInEra AllegraEra = Just ValidityLowerBoundInAllegraEr validityLowerBoundSupportedInEra MaryEra = Just ValidityLowerBoundInMaryEra validityLowerBoundSupportedInEra AlonzoEra = Just ValidityLowerBoundInAlonzoEra validityLowerBoundSupportedInEra BabbageEra = Just ValidityLowerBoundInBabbageEra +validityLowerBoundSupportedInEra ConwayEra = Just ValidityLowerBoundInConwayEra -- | A representation of whether the era supports transaction metadata. -- @@ -983,6 +1114,7 @@ data TxMetadataSupportedInEra era where TxMetadataInMaryEra :: TxMetadataSupportedInEra MaryEra TxMetadataInAlonzoEra :: TxMetadataSupportedInEra AlonzoEra TxMetadataInBabbageEra :: TxMetadataSupportedInEra BabbageEra + TxMetadataInConwayEra :: TxMetadataSupportedInEra ConwayEra deriving instance Eq (TxMetadataSupportedInEra era) deriving instance Show (TxMetadataSupportedInEra era) @@ -995,6 +1127,7 @@ txMetadataSupportedInEra AllegraEra = Just TxMetadataInAllegraEra txMetadataSupportedInEra MaryEra = Just TxMetadataInMaryEra txMetadataSupportedInEra AlonzoEra = Just TxMetadataInAlonzoEra txMetadataSupportedInEra BabbageEra = Just TxMetadataInBabbageEra +txMetadataSupportedInEra ConwayEra = Just TxMetadataInConwayEra -- | A representation of whether the era supports auxiliary scripts in @@ -1008,6 +1141,7 @@ data AuxScriptsSupportedInEra era where AuxScriptsInMaryEra :: AuxScriptsSupportedInEra MaryEra AuxScriptsInAlonzoEra :: AuxScriptsSupportedInEra AlonzoEra AuxScriptsInBabbageEra :: AuxScriptsSupportedInEra BabbageEra + AuxScriptsInConwayEra :: AuxScriptsSupportedInEra ConwayEra deriving instance Eq (AuxScriptsSupportedInEra era) deriving instance Show (AuxScriptsSupportedInEra era) @@ -1020,6 +1154,7 @@ auxScriptsSupportedInEra AllegraEra = Just AuxScriptsInAllegraEra auxScriptsSupportedInEra MaryEra = Just AuxScriptsInMaryEra auxScriptsSupportedInEra AlonzoEra = Just AuxScriptsInAlonzoEra auxScriptsSupportedInEra BabbageEra = Just AuxScriptsInBabbageEra +auxScriptsSupportedInEra ConwayEra = Just AuxScriptsInConwayEra -- | A representation of whether the era supports transactions that specify @@ -1033,6 +1168,7 @@ data TxExtraKeyWitnessesSupportedInEra era where ExtraKeyWitnessesInAlonzoEra :: TxExtraKeyWitnessesSupportedInEra AlonzoEra ExtraKeyWitnessesInBabbageEra :: TxExtraKeyWitnessesSupportedInEra BabbageEra + ExtraKeyWitnessesInConwayEra :: TxExtraKeyWitnessesSupportedInEra ConwayEra deriving instance Eq (TxExtraKeyWitnessesSupportedInEra era) deriving instance Show (TxExtraKeyWitnessesSupportedInEra era) @@ -1045,6 +1181,7 @@ extraKeyWitnessesSupportedInEra AllegraEra = Nothing extraKeyWitnessesSupportedInEra MaryEra = Nothing extraKeyWitnessesSupportedInEra AlonzoEra = Just ExtraKeyWitnessesInAlonzoEra extraKeyWitnessesSupportedInEra BabbageEra = Just ExtraKeyWitnessesInBabbageEra +extraKeyWitnessesSupportedInEra ConwayEra = Just ExtraKeyWitnessesInConwayEra -- | A representation of whether the era supports script data in transactions. @@ -1053,6 +1190,7 @@ data ScriptDataSupportedInEra era where -- | Script data is supported in transactions in the 'Alonzo' era. ScriptDataInAlonzoEra :: ScriptDataSupportedInEra AlonzoEra ScriptDataInBabbageEra :: ScriptDataSupportedInEra BabbageEra + ScriptDataInConwayEra :: ScriptDataSupportedInEra ConwayEra deriving instance Eq (ScriptDataSupportedInEra era) deriving instance Show (ScriptDataSupportedInEra era) @@ -1065,6 +1203,7 @@ scriptDataSupportedInEra AllegraEra = Nothing scriptDataSupportedInEra MaryEra = Nothing scriptDataSupportedInEra AlonzoEra = Just ScriptDataInAlonzoEra scriptDataSupportedInEra BabbageEra = Just ScriptDataInBabbageEra +scriptDataSupportedInEra ConwayEra = Just ScriptDataInConwayEra -- | A representation of whether the era supports withdrawals from reward @@ -1080,6 +1219,7 @@ data WithdrawalsSupportedInEra era where WithdrawalsInMaryEra :: WithdrawalsSupportedInEra MaryEra WithdrawalsInAlonzoEra :: WithdrawalsSupportedInEra AlonzoEra WithdrawalsInBabbageEra :: WithdrawalsSupportedInEra BabbageEra + WithdrawalsInConwayEra :: WithdrawalsSupportedInEra ConwayEra deriving instance Eq (WithdrawalsSupportedInEra era) deriving instance Show (WithdrawalsSupportedInEra era) @@ -1092,6 +1232,7 @@ withdrawalsSupportedInEra AllegraEra = Just WithdrawalsInAllegraEra withdrawalsSupportedInEra MaryEra = Just WithdrawalsInMaryEra withdrawalsSupportedInEra AlonzoEra = Just WithdrawalsInAlonzoEra withdrawalsSupportedInEra BabbageEra = Just WithdrawalsInBabbageEra +withdrawalsSupportedInEra ConwayEra = Just WithdrawalsInConwayEra -- | A representation of whether the era supports 'Certificate's embedded in @@ -1106,6 +1247,7 @@ data CertificatesSupportedInEra era where CertificatesInMaryEra :: CertificatesSupportedInEra MaryEra CertificatesInAlonzoEra :: CertificatesSupportedInEra AlonzoEra CertificatesInBabbageEra :: CertificatesSupportedInEra BabbageEra + CertificatesInConwayEra :: CertificatesSupportedInEra ConwayEra deriving instance Eq (CertificatesSupportedInEra era) deriving instance Show (CertificatesSupportedInEra era) @@ -1118,6 +1260,7 @@ certificatesSupportedInEra AllegraEra = Just CertificatesInAllegraEra certificatesSupportedInEra MaryEra = Just CertificatesInMaryEra certificatesSupportedInEra AlonzoEra = Just CertificatesInAlonzoEra certificatesSupportedInEra BabbageEra = Just CertificatesInBabbageEra +certificatesSupportedInEra ConwayEra = Just CertificatesInConwayEra -- | A representation of whether the era supports 'UpdateProposal's embedded in @@ -1134,6 +1277,7 @@ data UpdateProposalSupportedInEra era where UpdateProposalInMaryEra :: UpdateProposalSupportedInEra MaryEra UpdateProposalInAlonzoEra :: UpdateProposalSupportedInEra AlonzoEra UpdateProposalInBabbageEra :: UpdateProposalSupportedInEra BabbageEra + UpdateProposalInConwayEra :: UpdateProposalSupportedInEra ConwayEra deriving instance Eq (UpdateProposalSupportedInEra era) deriving instance Show (UpdateProposalSupportedInEra era) @@ -1146,7 +1290,7 @@ updateProposalSupportedInEra AllegraEra = Just UpdateProposalInAllegraEra updateProposalSupportedInEra MaryEra = Just UpdateProposalInMaryEra updateProposalSupportedInEra AlonzoEra = Just UpdateProposalInAlonzoEra updateProposalSupportedInEra BabbageEra = Just UpdateProposalInBabbageEra - +updateProposalSupportedInEra ConwayEra = Just UpdateProposalInConwayEra -- ---------------------------------------------------------------------------- -- Building vs viewing transactions @@ -1310,6 +1454,7 @@ deriving instance Show (TxTotalCollateral era) data TxTotalAndReturnCollateralSupportedInEra era where TxTotalAndReturnCollateralInBabbageEra :: TxTotalAndReturnCollateralSupportedInEra BabbageEra + TxTotalAndReturnCollateralInConwayEra :: TxTotalAndReturnCollateralSupportedInEra ConwayEra deriving instance Eq (TxTotalAndReturnCollateralSupportedInEra era) deriving instance Show (TxTotalAndReturnCollateralSupportedInEra era) @@ -1322,6 +1467,7 @@ totalAndReturnCollateralSupportedInEra AllegraEra = Nothing totalAndReturnCollateralSupportedInEra MaryEra = Nothing totalAndReturnCollateralSupportedInEra AlonzoEra = Nothing totalAndReturnCollateralSupportedInEra BabbageEra = Just TxTotalAndReturnCollateralInBabbageEra +totalAndReturnCollateralSupportedInEra ConwayEra = Just TxTotalAndReturnCollateralInConwayEra -- ---------------------------------------------------------------------------- -- Transaction output datum (era-dependent) @@ -1667,6 +1813,12 @@ instance Eq (TxBody era) where && txmetadataA == txmetadataB && scriptValidityA == scriptValidityB + ShelleyBasedEraConway -> txbodyA == txbodyB + && txscriptsA == txscriptsB + && redeemersA == redeemersB + && txmetadataA == txmetadataB + && scriptValidityA == scriptValidityB + (==) ByronTxBody{} (ShelleyTxBody era _ _ _ _ _) = case era of {} (==) (ShelleyTxBody era _ _ _ _ _) ByronTxBody{} = case era of {} @@ -1754,6 +1906,20 @@ instance Show (TxBody era) where . showsPrec 11 scriptValidity ) + showsPrec p (ShelleyTxBody ShelleyBasedEraConway + txbody txscripts redeemers txmetadata scriptValidity) = + showParen (p >= 11) + ( showString "ShelleyTxBody ShelleyBasedEraConway " + . showsPrec 11 txbody + . showChar ' ' + . showsPrec 11 txscripts + . showChar ' ' + . showsPrec 11 redeemers + . showChar ' ' + . showsPrec 11 txmetadata + . showChar ' ' + . showsPrec 11 scriptValidity + ) instance HasTypeProxy era => HasTypeProxy (TxBody era) where @@ -1788,9 +1954,11 @@ instance IsCardanoEra era => SerialiseAsCBOR (TxBody era) where era txbody txscripts redeemers txmetadata scriptValidity ShelleyBasedEraAlonzo -> serialiseShelleyBasedTxBody era txbody txscripts redeemers txmetadata scriptValidity - ShelleyBasedEraBabbage -> serialiseShelleyBasedTxBody era txbody txscripts redeemers txmetadata scriptValidity + ShelleyBasedEraConway -> serialiseShelleyBasedTxBody + era txbody txscripts redeemers txmetadata scriptValidity + deserialiseFromCBOR _ bs = case cardanoEra :: CardanoEra era of ByronEra -> @@ -1806,6 +1974,7 @@ instance IsCardanoEra era => SerialiseAsCBOR (TxBody era) where MaryEra -> deserialiseShelleyBasedTxBody ShelleyBasedEraMary bs AlonzoEra -> deserialiseShelleyBasedTxBody ShelleyBasedEraAlonzo bs BabbageEra -> deserialiseShelleyBasedTxBody ShelleyBasedEraBabbage bs + ConwayEra -> deserialiseShelleyBasedTxBody ShelleyBasedEraConway bs -- | The serialisation format for the different Shelley-based eras are not the -- same, but they can be handled generally with one overloaded implementation. @@ -1845,6 +2014,13 @@ serialiseShelleyBasedTxBody era txbody txscripts <> CBOR.toCBOR txscripts <> CBOR.toCBOR (txScriptValidityToScriptValidity scriptValidity) <> CBOR.encodeNullMaybe CBOR.toCBOR txmetadata + ShelleyBasedEraConway -> + CBOR.serializeEncoding' + $ CBOR.encodeListLen 4 + <> CBOR.toCBOR txbody + <> CBOR.toCBOR txscripts + <> CBOR.toCBOR (txScriptValidityToScriptValidity scriptValidity) + <> CBOR.encodeNullMaybe CBOR.toCBOR txmetadata where preAlonzo = CBOR.serializeEncoding' $ CBOR.encodeListLen 3 @@ -1978,6 +2154,7 @@ instance IsCardanoEra era => HasTextEnvelope (TxBody era) where MaryEra -> "TxBodyMary" AlonzoEra -> "TxBodyAlonzo" BabbageEra -> "TxBodyBabbage" + ConwayEra -> "TxBodyConway" -- | Calculate the transaction identifier for a 'TxBody'. -- @@ -2005,6 +2182,7 @@ getTxId (ShelleyTxBody era tx _ _ _ _) = obtainConstraints ShelleyBasedEraMary f = f obtainConstraints ShelleyBasedEraAlonzo f = f obtainConstraints ShelleyBasedEraBabbage f = f + obtainConstraints ShelleyBasedEraConway f = f getTxIdShelley :: Ledger.Crypto (ShelleyLedgerEra era) ~ StandardCrypto @@ -2226,6 +2404,46 @@ createTransactionBody era txBodyContent = (Just ledgerAuxData) apiScriptValidity + ShelleyBasedEraConway -> + let sData = convScriptData (shelleyBasedToCardanoEra era) apiTxOuts apiScriptWitnesses + + scriptIntegrityHash = + case sData of + TxBodyNoScriptData -> SNothing + TxBodyScriptData sDataSupported datums redeemers -> + getLedgerEraConstraint era + $ getHasFieldConstraints sDataSupported + $ convPParamsToScriptIntegrityHash + era + apiProtocolParameters + redeemers + datums + languages + + ledgerTxBody = BabbageTxBody + txins + collTxIns + refTxIns + babbageTxOuts + returnCollateral + totalCollateral + certs + witDrwls + fee + validityInterval + (convTxUpdateProposal era $ txUpdateProposal txBodyContent) + (convExtraKeyWitnesses apiExtraKeyWitnesses) + (convMintValue apiMintValue) + scriptIntegrityHash + (convAuxiliaryDataToHash auxData) + SNothing -- TODO: NetworkId for hardware wallets. We don't always want this + in ShelleyTxBody era + ledgerTxBody + scripts + sData + (Just ledgerAuxData) + apiScriptValidity + validateTxBodyContent :: ShelleyBasedEra era -> TxBodyContent BuildTx era @@ -2270,6 +2488,13 @@ validateTxBodyContent era txBodContent@TxBodyContent { validateMintValue txMintValue validateTxInsCollateral txInsCollateral languages validateProtocolParameters txProtocolParams languages + ShelleyBasedEraConway -> do + validateTxIns txIns + validateTxOuts era txOuts + validateMetadata txMetadata + validateMintValue txMintValue + validateTxInsCollateral txInsCollateral languages + validateProtocolParameters txProtocolParams languages validateMetadata :: TxMetadataInEra era -> Either TxBodyError () validateMetadata txMetadata = @@ -2422,6 +2647,7 @@ fromLedgerTxIns era body = inputs_ ShelleyBasedEraMary = Mary.inputs' inputs_ ShelleyBasedEraAlonzo = Alonzo.inputs' inputs_ ShelleyBasedEraBabbage = Babbage.inputs + inputs_ ShelleyBasedEraConway = Babbage.inputs fromLedgerTxInsCollateral @@ -2442,6 +2668,7 @@ fromLedgerTxInsCollateral era body = ShelleyBasedEraMary -> [] ShelleyBasedEraAlonzo -> toList $ Alonzo.collateral' body ShelleyBasedEraBabbage -> toList $ Babbage.collateral body + ShelleyBasedEraConway -> toList $ Babbage.collateral body fromLedgerTxInsReference :: ShelleyBasedEra era -> Ledger.TxBody (ShelleyLedgerEra era) -> TxInsReference ViewTx era @@ -2458,6 +2685,7 @@ fromLedgerTxInsReference era txBody = -> ((CC.Crypto (ShelleyLedgerEra era) ~ StandardCrypto, BabbageEraTxBody (ShelleyLedgerEra era)) => a) -> a obtainReferenceInputsHasFieldConstraint ReferenceTxInsScriptsInlineDatumsInBabbageEra f = f + obtainReferenceInputsHasFieldConstraint ReferenceTxInsScriptsInlineDatumsInConwayEra f = f fromLedgerTxOuts :: forall era. @@ -2495,6 +2723,16 @@ fromLedgerTxOuts era body scriptdata = | let txdatums = selectTxDatums scriptdata , txouts <- toList (Babbage.outputs body) ] + ShelleyBasedEraConway -> + [ fromConwayTxOut + MultiAssetInConwayEra + ScriptDataInConwayEra + ReferenceTxInsScriptsInlineDatumsInConwayEra + txdatums + (CBOR.sizedValue txouts) + | let txdatums = selectTxDatums scriptdata + , txouts <- toList (Conway.outputs body) + ] where selectTxDatums TxBodyNoScriptData = Map.empty selectTxDatums (TxBodyScriptData _ (Alonzo.TxDats' datums) _) = datums @@ -2569,6 +2807,48 @@ fromBabbageTxOut multiAssetInEra scriptDataInEra inlineDatumsInEra txdatums txou (BabbageTxOut addr val datum mRefScript) = txout +fromConwayTxOut + :: forall ledgerera era. Ledger.Era ledgerera + => IsShelleyBasedEra era + => ShelleyLedgerEra era ~ ledgerera + => Ledger.Crypto ledgerera ~ StandardCrypto + => Ledger.Value ledgerera ~ MaryValue StandardCrypto + => MultiAssetSupportedInEra era + -> ScriptDataSupportedInEra era + -> ReferenceTxInsScriptsInlineDatumsSupportedInEra era + -> Map (Alonzo.DataHash StandardCrypto) + (Alonzo.Data ledgerera) + -> BabbageTxOut ledgerera + -> TxOut CtxTx era +fromConwayTxOut multiAssetInEra scriptDataInEra inlineDatumsInEra txdatums txout = + TxOut + (fromShelleyAddr shelleyBasedEra addr) + (TxOutValue multiAssetInEra (fromMaryValue val)) + conwayTxOutDatum + (case mRefScript of + SNothing -> ReferenceScriptNone + SJust rScript -> fromShelleyScriptToReferenceScript shelleyBasedEra rScript + ) + where + -- NOTE: This is different to 'fromConwayTxOutDatum' as it may resolve + -- 'DatumHash' values using the datums included in the transaction. + conwayTxOutDatum :: TxOutDatum CtxTx era + conwayTxOutDatum = + case datum of + Babbage.NoDatum -> TxOutDatumNone + Babbage.DatumHash dh -> resolveDatumInTx dh + Babbage.Datum d -> + TxOutDatumInline inlineDatumsInEra $ + binaryDataToScriptData inlineDatumsInEra d + + resolveDatumInTx :: Alonzo.DataHash StandardCrypto -> TxOutDatum CtxTx era + resolveDatumInTx dh + | Just d <- Map.lookup dh txdatums + = TxOutDatumInTx' scriptDataInEra (ScriptDataHash dh) (fromAlonzoData d) + | otherwise = TxOutDatumHash scriptDataInEra (ScriptDataHash dh) + + (BabbageTxOut addr val datum mRefScript) = txout + fromLedgerTxTotalCollateral :: ShelleyBasedEra era -> Ledger.TxBody (ShelleyLedgerEra era) @@ -2586,6 +2866,7 @@ fromLedgerTxTotalCollateral era txbody = -> (BabbageEraTxBody (ShelleyLedgerEra era) => a) -> a obtainTotalCollateralHasFieldConstraint TxTotalAndReturnCollateralInBabbageEra f = f + obtainTotalCollateralHasFieldConstraint TxTotalAndReturnCollateralInConwayEra f = f fromLedgerTxReturnCollateral :: ShelleyBasedEra era @@ -2608,6 +2889,7 @@ fromLedgerTxReturnCollateral era txbody = ) => a) -> a obtainCollateralReturnHasFieldConstraint TxTotalAndReturnCollateralInBabbageEra f = f + obtainCollateralReturnHasFieldConstraint TxTotalAndReturnCollateralInConwayEra f = f fromLedgerTxFee @@ -2629,6 +2911,9 @@ fromLedgerTxFee era body = ShelleyBasedEraBabbage -> TxFeeExplicit TxFeesExplicitInBabbageEra $ fromShelleyLovelace $ Babbage.txfee body + ShelleyBasedEraConway -> + TxFeeExplicit TxFeesExplicitInConwayEra $ + fromShelleyLovelace $ Babbage.txfee body fromLedgerTxValidityRange :: ShelleyBasedEra era @@ -2686,6 +2971,17 @@ fromLedgerTxValidityRange era body = where Mary.ValidityInterval{invalidBefore, invalidHereafter} = Babbage.txvldt body + ShelleyBasedEraConway -> + ( case invalidBefore of + SNothing -> TxValidityNoLowerBound + SJust s -> TxValidityLowerBound ValidityLowerBoundInConwayEra s + , case invalidHereafter of + SNothing -> TxValidityNoUpperBound ValidityNoUpperBoundInConwayEra + SJust s -> TxValidityUpperBound ValidityUpperBoundInConwayEra s + ) + where + Mary.ValidityInterval{invalidBefore, invalidHereafter} = Babbage.txvldt body + fromLedgerAuxiliaryData :: ShelleyBasedEra era -> Ledger.AuxiliaryData (ShelleyLedgerEra era) @@ -2708,6 +3004,10 @@ fromLedgerAuxiliaryData ShelleyBasedEraBabbage (AlonzoAuxiliaryData ms ss) = ( fromShelleyMetadata ms , fromShelleyBasedScript ShelleyBasedEraBabbage <$> toList ss ) +fromLedgerAuxiliaryData ShelleyBasedEraConway (AlonzoAuxiliaryData ms ss) = + ( fromShelleyMetadata ms + , fromShelleyBasedScript ShelleyBasedEraConway <$> toList ss + ) fromLedgerTxAuxiliaryData :: ShelleyBasedEra era @@ -2759,6 +3059,15 @@ fromLedgerTxAuxiliaryData era (Just auxData) = [] -> TxAuxScriptsNone _ -> TxAuxScripts AuxScriptsInBabbageEra ss ) + ShelleyBasedEraConway -> + ( if null ms then + TxMetadataNone + else + TxMetadataInEra TxMetadataInConwayEra $ TxMetadata ms + , case ss of + [] -> TxAuxScriptsNone + _ -> TxAuxScripts AuxScriptsInConwayEra ss + ) where (ms, ss) = fromLedgerAuxiliaryData era auxData @@ -2787,6 +3096,14 @@ fromLedgerTxExtraKeyWitnesses sbe body = | keyhash <- Set.toList keyhashes ] where keyhashes = Babbage.reqSignerHashes body + ShelleyBasedEraConway + | Set.null keyhashes -> TxExtraKeyWitnessesNone + | otherwise -> TxExtraKeyWitnesses + ExtraKeyWitnessesInConwayEra + [ PaymentKeyHash (Shelley.coerceKeyRole keyhash) + | keyhash <- Set.toList keyhashes ] + where + keyhashes = Babbage.reqSignerHashes body fromLedgerTxWithdrawals :: ShelleyBasedEra era @@ -2831,6 +3148,13 @@ fromLedgerTxWithdrawals era body = where withdrawals = Babbage.wdrls' body + ShelleyBasedEraConway + | null (Shelley.unWdrl withdrawals) -> TxWithdrawalsNone + | otherwise -> + TxWithdrawals WithdrawalsInConwayEra $ fromShelleyWithdrawal withdrawals + where + withdrawals = Babbage.wdrls' body + fromLedgerTxCertificates :: ShelleyBasedEra era -> Ledger.TxBody (ShelleyLedgerEra era) @@ -2887,6 +3211,16 @@ fromLedgerTxCertificates era body = where certificates = Babbage.certs' body + ShelleyBasedEraConway + | null certificates -> TxCertificatesNone + | otherwise -> + TxCertificates + CertificatesInConwayEra + (map fromShelleyCertificate $ toList certificates) + ViewTx + where + certificates = Babbage.certs' body + fromLedgerTxUpdateProposal :: ShelleyBasedEra era -> Ledger.TxBody (ShelleyLedgerEra era) @@ -2928,6 +3262,13 @@ fromLedgerTxUpdateProposal era body = TxUpdateProposal UpdateProposalInBabbageEra (fromLedgerUpdate era p) + ShelleyBasedEraConway -> + case Babbage.update' body of + SNothing -> TxUpdateProposalNone + SJust p -> + TxUpdateProposal UpdateProposalInConwayEra + (fromLedgerUpdate era p) + fromLedgerTxMintValue :: ShelleyBasedEra era -> Ledger.TxBody (ShelleyLedgerEra era) @@ -2957,6 +3298,13 @@ fromLedgerTxMintValue era body = where mint = Babbage.mint' body + ShelleyBasedEraConway + | isZero mint -> TxMintNone + | otherwise -> TxMintValue MultiAssetInConwayEra + (fromMaryValue mint) ViewTx + where + mint = Babbage.mint' body + makeByronTransactionBody :: TxBodyContent BuildTx ByronEra -> Either TxBodyError (TxBody ByronEra) @@ -3223,6 +3571,7 @@ getCBORConstraint ShelleyBasedEraAllegra f = f getCBORConstraint ShelleyBasedEraMary f = f getCBORConstraint ShelleyBasedEraAlonzo f = f getCBORConstraint ShelleyBasedEraBabbage f = f +getCBORConstraint ShelleyBasedEraConway f = f getHasFieldConstraints :: ScriptDataSupportedInEra era @@ -3230,6 +3579,7 @@ getHasFieldConstraints -> a getHasFieldConstraints ScriptDataInAlonzoEra f = f getHasFieldConstraints ScriptDataInBabbageEra f = f +getHasFieldConstraints ScriptDataInConwayEra f = f getLedgerEraConstraint :: ShelleyBasedEra era @@ -3240,6 +3590,7 @@ getLedgerEraConstraint ShelleyBasedEraAllegra f = f getLedgerEraConstraint ShelleyBasedEraMary f = f getLedgerEraConstraint ShelleyBasedEraAlonzo f = f getLedgerEraConstraint ShelleyBasedEraBabbage f = f +getLedgerEraConstraint ShelleyBasedEraConway f = f makeShelleyTransactionBody :: ShelleyBasedEra era @@ -3453,9 +3804,8 @@ makeShelleyTransactionBody era@ShelleyBasedEraAlonzo datums = Alonzo.TxDats $ Map.fromList - [ (Alonzo.hashData d', d') - | d <- scriptdata - , let d' = toAlonzoData d + [ (Alonzo.hashData d, d) + | d <- toAlonzoData <$> scriptdata ] scriptdata :: [HashableScriptData] @@ -3609,6 +3959,119 @@ makeShelleyTransactionBody era@ShelleyBasedEraBabbage TxAuxScriptsNone -> [] TxAuxScripts _ ss' -> ss' +makeShelleyTransactionBody era@ShelleyBasedEraConway + txbodycontent@TxBodyContent { + txIns, + txInsCollateral, + txInsReference, + txReturnCollateral, + txTotalCollateral, + txOuts, + txFee, + txValidityRange = (lowerBound, upperBound), + txMetadata, + txAuxScripts, + txExtraKeyWits, + txProtocolParams, + txWithdrawals, + txCertificates, + txUpdateProposal, + txMintValue, + txScriptValidity + } = do + + validateTxBodyContent era txbodycontent + + return $ + ShelleyTxBody era + (BabbageTxBody + { Conway.inputs = convTxIns txIns + , Conway.collateral = + case txInsCollateral of + TxInsCollateralNone -> Set.empty + TxInsCollateral _ txins -> Set.fromList (map toShelleyTxIn txins) + , Conway.referenceInputs = convReferenceInputs txInsReference + , Conway.outputs = convBabbageTxOuts era txOuts + , Conway.collateralReturn = convReturnCollateral era txReturnCollateral + , Conway.totalCollateral = convTotalCollateral txTotalCollateral + , Conway.txcerts = convCertificates txCertificates + , Conway.txwdrls = convWithdrawals txWithdrawals + , Conway.txfee = convTransactionFee era txFee + , Conway.txvldt = convValidityInterval (lowerBound, upperBound) + , Conway.txUpdates = convTxUpdateProposal era txUpdateProposal + , Conway.reqSignerHashes = convExtraKeyWitnesses txExtraKeyWits + , Conway.mint = convMintValue txMintValue + , Conway.scriptIntegrityHash = convPParamsToScriptIntegrityHash + era txProtocolParams redeemers datums languages + , Conway.adHash = convAuxiliaryDataToHash txAuxData + , Conway.txnetworkid = SNothing + }) + scripts + (TxBodyScriptData ScriptDataInConwayEra + datums redeemers) + txAuxData + txScriptValidity + where + witnesses :: [(ScriptWitnessIndex, AnyScriptWitness ConwayEra)] + witnesses = collectTxBodyScriptWitnesses txbodycontent + + scripts :: [Ledger.Script StandardConway] + scripts = catMaybes + [ toShelleyScript <$> scriptWitnessScript scriptwitness + | (_, AnyScriptWitness scriptwitness) <- witnesses + ] + + -- Note these do not include inline datums! + datums :: Alonzo.TxDats StandardConway + datums = + Alonzo.TxDats $ + Map.fromList + [ (Alonzo.hashData d, d) + | d <- toAlonzoData <$> scriptdata + ] + + scriptdata :: [HashableScriptData] + scriptdata = + [ d | TxOut _ _ (TxOutDatumInTx _ d) _ <- txOuts ] + ++ [ d | (_, AnyScriptWitness + (PlutusScriptWitness + _ _ _ (ScriptDatumForTxIn d) _ _)) <- witnesses + ] + + redeemers :: Alonzo.Redeemers StandardConway + redeemers = + Alonzo.Redeemers $ + Map.fromList + [ (toAlonzoRdmrPtr idx, (toAlonzoData d, toAlonzoExUnits e)) + | (idx, AnyScriptWitness + (PlutusScriptWitness _ _ _ _ d e)) <- witnesses + ] + + languages :: Set Alonzo.Language + languages = + Set.fromList $ catMaybes + [ getScriptLanguage sw + | (_, AnyScriptWitness sw) <- witnesses + ] + + getScriptLanguage :: ScriptWitness witctx era -> Maybe Alonzo.Language + getScriptLanguage (PlutusScriptWitness _ v _ _ _ _) = + Just $ toAlonzoLanguage (AnyPlutusScriptVersion v) + getScriptLanguage SimpleScriptWitness{} = Nothing + + txAuxData :: Maybe (Ledger.AuxiliaryData StandardConway) + txAuxData + | Map.null ms + , null ss = Nothing + | otherwise = Just (toAuxiliaryData era txMetadata txAuxScripts) + where + ms = case txMetadata of + TxMetadataNone -> Map.empty + TxMetadataInEra _ (TxMetadata ms') -> ms' + ss = case txAuxScripts of + TxAuxScriptsNone -> [] + TxAuxScripts _ ss' -> ss' + -- | A variant of 'toShelleyTxOutAny that is used only internally to this module -- that works with a 'TxOut' in any context (including CtxTx) by ignoring @@ -3640,6 +4103,10 @@ toShelleyTxOutAny era (TxOut addr (TxOutValue MultiAssetInBabbageEra value) txou in BabbageTxOut (toShelleyAddr addr) (toMaryValue value) (toBabbageTxOutDatum' txoutdata) (refScriptToShelleyScript cEra refScript) +toShelleyTxOutAny era (TxOut addr (TxOutValue MultiAssetInConwayEra value) txoutdata refScript) = + let cEra = shelleyBasedToCardanoEra era + in BabbageTxOut (toShelleyAddr addr) (toMaryValue value) + (toBabbageTxOutDatum' txoutdata) (refScriptToShelleyScript cEra refScript) toAlonzoTxOutDataHash' :: TxOutDatum ctx AlonzoEra -> StrictMaybe (Alonzo.DataHash StandardCrypto) @@ -3857,6 +4324,10 @@ toAuxiliaryData sbe txMetadata txAuxScripts = Alonzo.AlonzoAuxiliaryData (toShelleyMetadata m) (Seq.fromList (map toShelleyScript ss)) + ShelleyBasedEraConway -> + Alonzo.AlonzoAuxiliaryData + (toShelleyMetadata m) + (Seq.fromList (map toShelleyScript ss)) -- ---------------------------------------------------------------------------- -- Other utilities helpful with making transaction bodies @@ -3906,5 +4377,6 @@ binaryDataToScriptData -> Alonzo.BinaryData ledgerera -> HashableScriptData binaryDataToScriptData ReferenceTxInsScriptsInlineDatumsInBabbageEra d = fromAlonzoData $ Alonzo.binaryDataToData d - +binaryDataToScriptData ReferenceTxInsScriptsInlineDatumsInConwayEra d = + fromAlonzoData $ Alonzo.binaryDataToData d diff --git a/cardano-api/src/Cardano/Api/Utils.hs b/cardano-api/src/Cardano/Api/Utils.hs index b73c13483fb..2c2146d8e43 100644 --- a/cardano-api/src/Cardano/Api/Utils.hs +++ b/cardano-api/src/Cardano/Api/Utils.hs @@ -140,6 +140,7 @@ renderEra (AnyCardanoEra AllegraEra) = "Allegra" renderEra (AnyCardanoEra MaryEra) = "Mary" renderEra (AnyCardanoEra AlonzoEra) = "Alonzo" renderEra (AnyCardanoEra BabbageEra) = "Babbage" +renderEra (AnyCardanoEra ConwayEra) = "Conway" bounded :: forall a. (Bounded a, Integral a, Show a) => String -> ReadM a bounded t = eitherReader $ \s -> do diff --git a/cardano-api/test/Test/Cardano/Api/Json.hs b/cardano-api/test/Test/Cardano/Api/Json.hs index 37354a4c47d..aae5ff2e494 100644 --- a/cardano-api/test/Test/Cardano/Api/Json.hs +++ b/cardano-api/test/Test/Cardano/Api/Json.hs @@ -60,6 +60,7 @@ prop_json_roundtrip_eraInMode = H.property $ do H.assert $ parseEither rountripEraInModeParser MaryEraInCardanoMode == Right MaryEraInCardanoMode H.assert $ parseEither rountripEraInModeParser AlonzoEraInCardanoMode == Right AlonzoEraInCardanoMode H.assert $ parseEither rountripEraInModeParser BabbageEraInCardanoMode == Right BabbageEraInCardanoMode + H.assert $ parseEither rountripEraInModeParser ConwayEraInCardanoMode == Right ConwayEraInCardanoMode where -- Defined this way instead of using 'tripping' in order to warn the @@ -75,6 +76,7 @@ prop_json_roundtrip_eraInMode = H.property $ do MaryEraInCardanoMode -> parseJSON $ toJSON MaryEraInCardanoMode AlonzoEraInCardanoMode -> parseJSON $ toJSON AlonzoEraInCardanoMode BabbageEraInCardanoMode -> parseJSON $ toJSON BabbageEraInCardanoMode + ConwayEraInCardanoMode -> parseJSON $ toJSON ConwayEraInCardanoMode prop_json_roundtrip_scriptdata_detailed_json :: Property prop_json_roundtrip_scriptdata_detailed_json = H.property $ do diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index c7a6696818e..881ba747b89 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -113,6 +113,7 @@ library , cardano-data ^>= 0.1 , cardano-ledger-alonzo ^>= 0.1 , cardano-ledger-byron ^>= 0.1 + , cardano-ledger-conway , cardano-ledger-core ^>= 0.1 , cardano-ledger-shelley-ma ^>= 0.1 , cardano-prelude @@ -136,7 +137,8 @@ library , ouroboros-consensus-cardano , ouroboros-consensus-protocol , ouroboros-consensus-shelley - , ouroboros-network + , ouroboros-network-api + , ouroboros-network-protocols , parsec , prettyprinter , random diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs b/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs index b1f0d4168a6..094b4e1f919 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs @@ -437,7 +437,7 @@ renderTextViewCmd (TextViewInfo _ _) = "text-view decode-cbor" data GenesisCmd = GenesisCreate GenesisDir Word Word (Maybe SystemStart) (Maybe Lovelace) NetworkId - | GenesisCreateCardano GenesisDir Word Word (Maybe SystemStart) (Maybe Lovelace) BlockCount Word Rational NetworkId FilePath FilePath FilePath (Maybe FilePath) + | GenesisCreateCardano GenesisDir Word Word (Maybe SystemStart) (Maybe Lovelace) BlockCount Word Rational NetworkId FilePath FilePath FilePath FilePath (Maybe FilePath) | GenesisCreateStaked GenesisDir Word diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Orphans.hs b/cardano-cli/src/Cardano/CLI/Shelley/Orphans.hs index bc6463238b5..a621dc032db 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Orphans.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Orphans.hs @@ -17,6 +17,7 @@ module Cardano.CLI.Shelley.Orphans () where import Cardano.Api.Orphans () import qualified Cardano.Ledger.AuxiliaryData as Ledger import qualified Cardano.Ledger.Credential as Ledger +import Cardano.Ledger.Conway.Genesis (ConwayGenesis (..)) import qualified Cardano.Ledger.Crypto as CC (Crypto) import qualified Cardano.Ledger.Mary.Value as Ledger.Mary import qualified Cardano.Ledger.PoolDistr as Ledger @@ -116,3 +117,8 @@ instance ToJSON (Cardano.WithOrigin Cardano.SlotNo) where toJSON = \case Cardano.Origin -> Aeson.String "origin" Cardano.At (Cardano.SlotNo n) -> toJSON n + +-- This instance should be exported from ledger but is currently not, +instance CC.Crypto c => ToJSON (ConwayGenesis c) where + toJSON (ConwayGenesis genDelegs) = + Aeson.object ["genDelegs" .= toJSON genDelegs] diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs index abcc7eda2a6..b27f4ab7b0e 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs @@ -1247,7 +1247,10 @@ pGenesisCmd = "JSON file with genesis defaults for each shelley." <*> parseFilePath "alonzo-template" - "JSON file with genesis defaults for each alonzo." + "JSON file with genesis defaults for alonzo." + <*> parseFilePath + "conway-template" + "JSON file with genesis defaults for conway." <*> pNodeConfigTemplate pGenesisCreate :: Parser GenesisCmd diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Genesis.hs index dd9309e3129..ab54da7f573 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Genesis.hs @@ -100,6 +100,8 @@ import Ouroboros.Consensus.Shelley.Node (ShelleyGenesisStaking (..)) import qualified Cardano.Ledger.Alonzo.Genesis as Alonzo import qualified Cardano.Ledger.BaseTypes as Ledger import Cardano.Ledger.Coin (Coin (..)) +import Cardano.Ledger.Conway.Genesis () +import qualified Cardano.Ledger.Conway.Genesis as Conway import qualified Cardano.Ledger.Keys as Ledger import qualified Cardano.Ledger.Shelley.API as Ledger import qualified Cardano.Ledger.Shelley.PParams as Shelley @@ -219,7 +221,7 @@ runGenesisCmd (GenesisVerKey vk sk) = runGenesisVerKey vk sk runGenesisCmd (GenesisTxIn vk nw mOutFile) = runGenesisTxIn vk nw mOutFile runGenesisCmd (GenesisAddr vk nw mOutFile) = runGenesisAddr vk nw mOutFile runGenesisCmd (GenesisCreate gd gn un ms am nw) = runGenesisCreate gd gn un ms am nw -runGenesisCmd (GenesisCreateCardano gd gn un ms am k slotLength sc nw bg sg ag mNodeCfg) = runGenesisCreateCardano gd gn un ms am k slotLength sc nw bg sg ag mNodeCfg +runGenesisCmd (GenesisCreateCardano gd gn un ms am k slotLength sc nw bg sg ag cg mNodeCfg) = runGenesisCreateCardano gd gn un ms am k slotLength sc nw bg sg ag cg mNodeCfg runGenesisCmd (GenesisCreateStaked gd gn gp gl un ms am ds nw bf bp su relayJsonFp) = runGenesisCreateStaked gd gn gp gl un ms am ds nw bf bp su relayJsonFp runGenesisCmd (GenesisHashFile gf) = runGenesisHashFile gf @@ -416,6 +418,7 @@ runGenesisCreate (GenesisDir rootdir) template <- readShelleyGenesisWithDefault (rootdir "genesis.spec.json") adjustTemplate alonzoGenesis <- readAlonzoGenesis (rootdir "genesis.alonzo.spec.json") + conwayGenesis <- readConwayGenesis (rootdir "genesis.conway.spec.json") forM_ [ 1 .. genNumGenesisKeys ] $ \index -> do createGenesisKeys gendir index @@ -435,6 +438,7 @@ runGenesisCreate (GenesisDir rootdir) void $ writeFileGenesis (rootdir "genesis.json") $ WritePretty shelleyGenesis void $ writeFileGenesis (rootdir "genesis.alonzo.json") $ WritePretty alonzoGenesis + void $ writeFileGenesis (rootdir "genesis.conway.json") $ WritePretty conwayGenesis --TODO: rationalise the naming convention on these genesis json files. where adjustTemplate t = t { sgNetworkMagic = unNetworkMagic (toNetworkMagic network) } @@ -442,7 +446,6 @@ runGenesisCreate (GenesisDir rootdir) deldir = rootdir "delegate-keys" utxodir = rootdir "utxo-keys" - toSKeyJSON :: Key a => SigningKey a -> ByteString toSKeyJSON = LBS.toStrict . textEnvelopeToJSON Nothing @@ -519,12 +522,13 @@ runGenesisCreateCardano :: GenesisDir -> FilePath -- ^ Byron Genesis -> FilePath -- ^ Shelley Genesis -> FilePath -- ^ Alonzo Genesis + -> FilePath -- ^ Conway Genesis -> Maybe FilePath -> ExceptT ShelleyGenesisCmdError IO () runGenesisCreateCardano (GenesisDir rootdir) genNumGenesisKeys genNumUTxOKeys mStart mAmount mSecurity slotLength mSlotCoeff - network byronGenesisT shelleyGenesisT alonzoGenesisT mNodeCfg = do + network byronGenesisT shelleyGenesisT alonzoGenesisT conwayGenesisT mNodeCfg = do start <- maybe (SystemStart <$> getCurrentTimePlus30) pure mStart (byronGenesis', byronSecrets) <- convertToShelleyError $ Byron.mkGenesis $ byronParams start let @@ -566,6 +570,7 @@ runGenesisCreateCardano (GenesisDir rootdir) } shelleyGenesisTemplate <- liftIO $ overrideShelleyGenesis . fromRight (error "shelley genesis template not found") <$> readAndDecodeShelleyGenesis shelleyGenesisT alonzoGenesis <- readAlonzoGenesis alonzoGenesisT + conwayGenesis <- readConwayGenesis conwayGenesisT (delegateMap, vrfKeys, kesKeys, opCerts) <- liftIO $ generateShelleyNodeSecrets shelleyDelegateKeys shelleyGenesisvkeys let shelleyGenesis :: ShelleyGenesis StandardShelley @@ -601,6 +606,7 @@ runGenesisCreateCardano (GenesisDir rootdir) byronGenesisHash <- writeFileGenesis (rootdir "byron-genesis.json") $ WriteCanonical byronGenesis shelleyGenesisHash <- writeFileGenesis (rootdir "shelley-genesis.json") $ WritePretty shelleyGenesis alonzoGenesisHash <- writeFileGenesis (rootdir "alonzo-genesis.json") $ WritePretty alonzoGenesis + conwayGenesisHash <- writeFileGenesis (rootdir "conway-genesis.json") $ WritePretty conwayGenesis liftIO $ do case mNodeCfg of @@ -614,6 +620,7 @@ runGenesisCreateCardano (GenesisDir rootdir) $ setHash "ByronGenesisHash" byronGenesisHash $ setHash "ShelleyGenesisHash" shelleyGenesisHash $ setHash "AlonzoGenesisHash" alonzoGenesisHash + $ setHash "ConwayGenesisHash" conwayGenesisHash obj updateConfig x = x newConfig :: Yaml.Value @@ -695,6 +702,7 @@ runGenesisCreateStaked (GenesisDir rootdir) template <- readShelleyGenesisWithDefault (rootdir "genesis.spec.json") adjustTemplate alonzoGenesis <- readAlonzoGenesis (rootdir "genesis.alonzo.spec.json") + conwayGenesis <- readConwayGenesis (rootdir "genesis.conway.spec.json") forM_ [ 1 .. genNumGenesisKeys ] $ \index -> do createGenesisKeys gendir index @@ -756,6 +764,7 @@ runGenesisCreateStaked (GenesisDir rootdir) liftIO $ LBS.writeFile (rootdir "genesis.json") $ Aeson.encode shelleyGenesis void $ writeFileGenesis (rootdir "genesis.alonzo.json") $ WritePretty alonzoGenesis + void $ writeFileGenesis (rootdir "genesis.conway.json") $ WritePretty conwayGenesis --TODO: rationalise the naming convention on these genesis json files. liftIO $ Text.hPutStrLn IO.stderr $ mconcat $ @@ -1335,6 +1344,13 @@ readAlonzoGenesis fpath = do firstExceptT (ShelleyGenesisCmdAesonDecodeError fpath . Text.pack) . hoistEither $ Aeson.eitherDecode' lbs +readConwayGenesis + :: FilePath + -> ExceptT ShelleyGenesisCmdError IO (Conway.ConwayGenesis StandardCrypto) +readConwayGenesis fpath = do + lbs <- handleIOExceptT (ShelleyGenesisCmdGenesisFileError . FileIOError fpath) $ LBS.readFile fpath + firstExceptT (ShelleyGenesisCmdAesonDecodeError fpath . Text.pack) + . hoistEither $ Aeson.eitherDecode' lbs -- Protocol Parameters diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs index 3a239ba254c..0ccb7823f92 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs @@ -914,6 +914,7 @@ writeFilteredUTxOs shelleyBasedEra' mOutFile utxo = ShelleyBasedEraMary -> writeUTxo fpath utxo ShelleyBasedEraAlonzo -> writeUTxo fpath utxo ShelleyBasedEraBabbage -> writeUTxo fpath utxo + ShelleyBasedEraConway -> writeUTxo fpath utxo where writeUTxo fpath utxo' = handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError fpath) @@ -934,6 +935,8 @@ printFilteredUTxOs shelleyBasedEra' (UTxO utxo) = do mapM_ (printUtxo shelleyBasedEra') $ Map.toList utxo ShelleyBasedEraBabbage -> mapM_ (printUtxo shelleyBasedEra') $ Map.toList utxo + ShelleyBasedEraConway -> + mapM_ (printUtxo shelleyBasedEra') $ Map.toList utxo where title :: Text @@ -987,6 +990,14 @@ printUtxo shelleyBasedEra' txInOutTuple = , textShowN 6 index , " " <> printableValue value <> " + " <> Text.pack (show mDatum) ] + ShelleyBasedEraConway -> + let (TxIn (TxId txhash) (TxIx index), TxOut _ value mDatum _) = txInOutTuple + in Text.putStrLn $ + mconcat + [ Text.decodeLatin1 (hashToBytesAsHex txhash) + , textShowN 6 index + , " " <> printableValue value <> " + " <> Text.pack (show mDatum) + ] where textShowN :: Show a => Int -> a -> Text textShowN len x = @@ -1361,6 +1372,7 @@ obtainLedgerEraClassConstraints ShelleyBasedEraAllegra f = f obtainLedgerEraClassConstraints ShelleyBasedEraMary f = f obtainLedgerEraClassConstraints ShelleyBasedEraAlonzo f = f obtainLedgerEraClassConstraints ShelleyBasedEraBabbage f = f +obtainLedgerEraClassConstraints ShelleyBasedEraConway f = f eligibleLeaderSlotsConstaints @@ -1387,6 +1399,7 @@ eligibleLeaderSlotsConstaints ShelleyBasedEraAllegra f = f eligibleLeaderSlotsConstaints ShelleyBasedEraMary f = f eligibleLeaderSlotsConstaints ShelleyBasedEraAlonzo f = f eligibleLeaderSlotsConstaints ShelleyBasedEraBabbage f = f +eligibleLeaderSlotsConstaints ShelleyBasedEraConway f = f eligibleWriteProtocolStateConstaints :: ShelleyBasedEra era @@ -1400,6 +1413,7 @@ eligibleWriteProtocolStateConstaints ShelleyBasedEraAllegra f = f eligibleWriteProtocolStateConstaints ShelleyBasedEraMary f = f eligibleWriteProtocolStateConstaints ShelleyBasedEraAlonzo f = f eligibleWriteProtocolStateConstaints ShelleyBasedEraBabbage f = f +eligibleWriteProtocolStateConstaints ShelleyBasedEraConway f = f -- Required instances -- instance FromCBOR (TPraosState StandardCrypto) where diff --git a/cardano-cli/test/Test/Golden/Shelley/Genesis/Create.hs b/cardano-cli/test/Test/Golden/Shelley/Genesis/Create.hs index cc94da74499..069bc45133a 100644 --- a/cardano-cli/test/Test/Golden/Shelley/Genesis/Create.hs +++ b/cardano-cli/test/Test/Golden/Shelley/Genesis/Create.hs @@ -72,12 +72,15 @@ golden_shelleyGenesisCreate = propertyOnce $ do H.moduleWorkspace "tmp" $ \tempDir -> do sourceGenesisSpecFile <- noteInputFile "test/data/golden/shelley/genesis/genesis.spec.json" sourceAlonzoGenesisSpecFile <- noteInputFile "test/data/golden/alonzo/genesis.alonzo.spec.json" + sourceConwayGenesisSpecFile <- noteInputFile "test/data/golden/conway/genesis.conway.spec.json" genesisSpecFile <- noteTempFile tempDir "genesis.spec.json" alonzoSpecFile <- noteTempFile tempDir "genesis.alonzo.spec.json" + conwaySpecFile <- noteTempFile tempDir "genesis.conway.spec.json" liftIO $ IO.copyFile sourceGenesisSpecFile genesisSpecFile liftIO $ IO.copyFile sourceAlonzoGenesisSpecFile alonzoSpecFile + liftIO $ IO.copyFile sourceConwayGenesisSpecFile conwaySpecFile let genesisFile = tempDir <> "/genesis.json" @@ -160,11 +163,13 @@ golden_shelleyGenesisCreate = propertyOnce $ do (utxoCount, fmtUtxoCount) <- fmap (OP.withSnd show) $ forAll $ G.int (R.linear 4 19) sourceAlonzoGenesisSpecFile <- noteInputFile "test/data/golden/alonzo/genesis.alonzo.spec.json" - alonzoSpecFile <- noteTempFile tempDir "genesis.alonzo.spec.json" - liftIO $ IO.copyFile sourceAlonzoGenesisSpecFile alonzoSpecFile + sourceConwayGenesisSpecFile <- noteInputFile "test/data/golden/conway/genesis.conway.spec.json" + conwaySpecFile <- noteTempFile tempDir "genesis.conway.spec.json" + liftIO $ IO.copyFile sourceConwayGenesisSpecFile conwaySpecFile + -- Create the genesis json file and required keys void $ execCardanoCLI [ "genesis","create" diff --git a/cardano-cli/test/data/golden/conway/genesis.conway.spec.json b/cardano-cli/test/data/golden/conway/genesis.conway.spec.json new file mode 100644 index 00000000000..4525ef4a58c --- /dev/null +++ b/cardano-cli/test/data/golden/conway/genesis.conway.spec.json @@ -0,0 +1,3 @@ +{ + "genDelegs": {} +} diff --git a/cardano-cli/test/data/golden/shelley/genesis.conway.spec.json b/cardano-cli/test/data/golden/shelley/genesis.conway.spec.json new file mode 100644 index 00000000000..4525ef4a58c --- /dev/null +++ b/cardano-cli/test/data/golden/shelley/genesis.conway.spec.json @@ -0,0 +1,3 @@ +{ + "genDelegs": {} +} diff --git a/cardano-client-demo/cardano-client-demo.cabal b/cardano-client-demo/cardano-client-demo.cabal index f131c1f15a9..48c95df9986 100644 --- a/cardano-client-demo/cardano-client-demo.cabal +++ b/cardano-client-demo/cardano-client-demo.cabal @@ -77,6 +77,7 @@ executable ledger-state cardano-slotting, iohk-monitoring, ouroboros-network, + ouroboros-network-protocols, ouroboros-consensus, ouroboros-consensus-cardano, ouroboros-consensus-byron, diff --git a/cardano-node-chairman/cardano-node-chairman.cabal b/cardano-node-chairman/cardano-node-chairman.cabal index b0ffd7a6b90..a1125ba0060 100644 --- a/cardano-node-chairman/cardano-node-chairman.cabal +++ b/cardano-node-chairman/cardano-node-chairman.cabal @@ -50,7 +50,8 @@ executable cardano-node-chairman , io-classes ^>= 0.3 , optparse-applicative-fork , ouroboros-consensus - , ouroboros-network + , ouroboros-network-api + , ouroboros-network-protocols , strict-stm , text , time diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index eb58006f596..d298d9ff596 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -75,6 +75,7 @@ library Cardano.Node.Protocol.Alonzo Cardano.Node.Protocol.Byron Cardano.Node.Protocol.Cardano + Cardano.Node.Protocol.Conway Cardano.Node.Protocol.Shelley Cardano.Node.Protocol.Types Cardano.Node.Queries @@ -136,10 +137,15 @@ library , base16-bytestring , bytestring , cardano-api - , cardano-data ^>= 0.1 + , cardano-data >= 0.1 , cardano-git-rev , cardano-crypto-class , cardano-crypto-wrapper + , cardano-ledger-core + , cardano-ledger-byron + , cardano-ledger-conway + , cardano-ledger-shelley + , cardano-ledger-shelley-ma , cardano-ledger-alonzo , cardano-ledger-babbage , cardano-ledger-byron @@ -147,9 +153,9 @@ library , cardano-ledger-shelley , cardano-ledger-shelley-ma , cardano-prelude - , cardano-protocol-tpraos ^>= 0.1 - , cardano-slotting ^>= 0.1 - , cborg ^>= 0.2.4 + , cardano-protocol-tpraos >= 0.1 + , cardano-slotting >= 0.1 + , cborg >= 0.2.4 , contra-tracer , containers , contra-tracer @@ -161,7 +167,8 @@ library , filepath , generic-data , hostname - , io-classes ^>= 0.3 + , iproute + , io-classes >= 0.3 , iohk-monitoring , iproute , lobemo-backend-aggregation @@ -170,16 +177,19 @@ library , lobemo-backend-trace-forwarder , mtl , network - , network-mux ^>= 0.2 + , network-mux >= 0.2 , nothunks , optparse-applicative-fork - , ouroboros-consensus ^>= 0.1.0.2 + , ouroboros-consensus >= 0.2 , ouroboros-consensus-byron , ouroboros-consensus-cardano + , ouroboros-consensus-diffusion , ouroboros-consensus-protocol , ouroboros-consensus-shelley - , ouroboros-network ^>= 0.2 - , ouroboros-network-framework ^>= 0.2 + , ouroboros-network >= 0.3 + , ouroboros-network-api + , ouroboros-network-framework >= 0.3 + , ouroboros-network-protocols , psqueues , safe-exceptions , scientific @@ -193,7 +203,7 @@ library , trace-resources , transformers , transformers-except - , typed-protocols ^>= 0.1 + , typed-protocols >= 0.1 , yaml executable cardano-node @@ -229,14 +239,16 @@ test-suite cardano-node-test , bytestring , cardano-api , cardano-node - , cardano-slotting ^>= 0.1 + , cardano-slotting >= 0.1 , directory , hedgehog , hedgehog-corpus , iproute , mtl , ouroboros-consensus + , ouroboros-consensus-diffusion , ouroboros-network + , ouroboros-network-api , mtl , text , time diff --git a/cardano-node/src/Cardano/Node/Configuration/Logging.hs b/cardano-node/src/Cardano/Node/Configuration/Logging.hs index 0e3dc9a69dc..f770864aa4c 100644 --- a/cardano-node/src/Cardano/Node/Configuration/Logging.hs +++ b/cardano-node/src/Cardano/Node/Configuration/Logging.hs @@ -339,14 +339,15 @@ nodeBasicInfo nc (SomeConsensusProtocol whichP pForInfo) nodeStartTime' = do let DegenLedgerConfig cfgShelley = Consensus.configLedger cfg in getGenesisValues "Shelley" cfgShelley Api.CardanoBlockType -> - let CardanoLedgerConfig cfgByron cfgShelley cfgAllegra - cfgMary cfgAlonzo cfgBabbage = Consensus.configLedger cfg + let CardanoLedgerConfig cfgByron cfgShelley cfgAllegra cfgMary cfgAlonzo + cfgBabbage cfgConway = Consensus.configLedger cfg in getGenesisValuesByron cfg cfgByron ++ getGenesisValues "Shelley" cfgShelley ++ getGenesisValues "Allegra" cfgAllegra ++ getGenesisValues "Mary" cfgMary ++ getGenesisValues "Alonzo" cfgAlonzo - ++ getGenesisValues "Babbage" cfgBabbage + ++ getGenesisValues "Babbage" cfgBabbage + ++ getGenesisValues "Conway" cfgConway items = nub $ [ ("protocol", pack . show $ ncProtocol nc) , ("version", pack . showVersion $ version) diff --git a/cardano-node/src/Cardano/Node/Configuration/POM.hs b/cardano-node/src/Cardano/Node/Configuration/POM.hs index e7d91217d5e..1c4c04653db 100644 --- a/cardano-node/src/Cardano/Node/Configuration/POM.hs +++ b/cardano-node/src/Cardano/Node/Configuration/POM.hs @@ -44,7 +44,7 @@ import Cardano.Node.Handlers.Shutdown import Cardano.Node.Protocol.Types (Protocol (..)) import Cardano.Node.Types import Cardano.Tracing.Config -import Ouroboros.Consensus.Mempool.API (MempoolCapacityBytes (..), +import Ouroboros.Consensus.Mempool (MempoolCapacityBytes (..), MempoolCapacityBytesOverride (..)) import qualified Ouroboros.Consensus.Node as Consensus (NetworkP2PMode (..)) import Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (SnapshotInterval (..)) @@ -244,6 +244,7 @@ instance FromJSON PartialNodeConfiguration where Last . Just <$> (NodeProtocolConfigurationCardano <$> parseByronProtocol v <*> parseShelleyProtocol v <*> parseAlonzoProtocol v + <*> parseConwayProtocol v <*> parseHardForkProtocol v) pncMaybeMempoolCapacityOverride <- Last <$> parseMempoolCapacityBytesOverride v @@ -368,12 +369,19 @@ instance FromJSON PartialNodeConfiguration where parseAlonzoProtocol v = do npcAlonzoGenesisFile <- v .: "AlonzoGenesisFile" npcAlonzoGenesisFileHash <- v .:? "AlonzoGenesisHash" - pure NodeAlonzoProtocolConfiguration { npcAlonzoGenesisFile , npcAlonzoGenesisFileHash } + parseConwayProtocol v = do + npcConwayGenesisFile <- v .: "ConwayGenesisFile" + npcConwayGenesisFileHash <- v .:? "ConwayGenesisHash" + pure NodeConwayProtocolConfiguration { + npcConwayGenesisFile + , npcConwayGenesisFileHash + } + parseHardForkProtocol v = do npcTestEnableDevelopmentHardForkEras <- v .:? "TestEnableDevelopmentHardForkEras" @@ -394,6 +402,9 @@ instance FromJSON PartialNodeConfiguration where npcTestBabbageHardForkAtEpoch <- v .:? "TestBabbageHardForkAtEpoch" npcTestBabbageHardForkAtVersion <- v .:? "TestBabbageHardForkAtVersion" + npcTestConwayHardForkAtEpoch <- v .:? "TestConwayHardForkAtEpoch" + npcTestConwayHardForkAtVersion <- v .:? "TestConwayHardForkAtVersion" + pure NodeHardForkProtocolConfiguration { npcTestEnableDevelopmentHardForkEras, @@ -410,7 +421,10 @@ instance FromJSON PartialNodeConfiguration where npcTestAlonzoHardForkAtVersion, npcTestBabbageHardForkAtEpoch, - npcTestBabbageHardForkAtVersion + npcTestBabbageHardForkAtVersion, + + npcTestConwayHardForkAtEpoch, + npcTestConwayHardForkAtVersion } -- | Default configuration is mainnet diff --git a/cardano-node/src/Cardano/Node/Orphans.hs b/cardano-node/src/Cardano/Node/Orphans.hs index 360969f12f5..638c61e9c3b 100644 --- a/cardano-node/src/Cardano/Node/Orphans.hs +++ b/cardano-node/src/Cardano/Node/Orphans.hs @@ -16,6 +16,10 @@ import qualified Cardano.Chain.Update as Update import qualified Cardano.Ledger.CompactAddress as Ledger import Cardano.Ledger.Crypto (StandardCrypto) import Ouroboros.Network.NodeToNode (AcceptedConnectionsLimit (..)) +import Ouroboros.Network.SizeInBytes (SizeInBytes (..)) + +import Text.Printf (PrintfArg (..)) + instance FromJSON TracingVerbosity where parseJSON (String str) = case str of @@ -29,6 +33,9 @@ instance FromJSON TracingVerbosity where deriving instance Show TracingVerbosity +instance PrintfArg SizeInBytes where + formatArg (SizeInBytes s) = formatArg s + instance ToJSON (Ledger.CompactAddr StandardCrypto) where toJSON = toJSON . Ledger.decompactAddr diff --git a/cardano-node/src/Cardano/Node/Parsers.hs b/cardano-node/src/Cardano/Node/Parsers.hs index 49ab0856919..701d23e870d 100644 --- a/cardano-node/src/Cardano/Node/Parsers.hs +++ b/cardano-node/src/Cardano/Node/Parsers.hs @@ -24,7 +24,7 @@ import qualified Options.Applicative.Help as OptI import System.Posix.Types (Fd (..)) import Text.Read (readMaybe) -import Ouroboros.Consensus.Mempool.API (MempoolCapacityBytes (..), +import Ouroboros.Consensus.Mempool (MempoolCapacityBytes (..), MempoolCapacityBytesOverride (..)) import Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (SnapshotInterval (..)) diff --git a/cardano-node/src/Cardano/Node/Protocol.hs b/cardano-node/src/Cardano/Node/Protocol.hs index 8e1491aa36c..adb66fc4f00 100644 --- a/cardano-node/src/Cardano/Node/Protocol.hs +++ b/cardano-node/src/Cardano/Node/Protocol.hs @@ -40,12 +40,14 @@ mkConsensusProtocol ncProtocolConfig mProtocolFiles = NodeProtocolConfigurationCardano byronConfig shelleyConfig alonzoConfig + conwayConfig hardForkConfig -> firstExceptT CardanoProtocolInstantiationError $ mkSomeConsensusProtocolCardano byronConfig shelleyConfig alonzoConfig + conwayConfig hardForkConfig mProtocolFiles diff --git a/cardano-node/src/Cardano/Node/Protocol/Byron.hs b/cardano-node/src/Cardano/Node/Protocol/Byron.hs index 4a8ee8f480a..c3eb746fa46 100644 --- a/cardano-node/src/Cardano/Node/Protocol/Byron.hs +++ b/cardano-node/src/Cardano/Node/Protocol/Byron.hs @@ -34,7 +34,7 @@ import Cardano.Crypto.ProtocolMagic (RequiresNetworkMagic) import Cardano.Node.Types import Ouroboros.Consensus.Cardano import qualified Ouroboros.Consensus.Cardano as Consensus -import qualified Ouroboros.Consensus.Mempool.TxLimits as TxLimits +import qualified Ouroboros.Consensus.Mempool.Capacity as TxLimits import Cardano.Node.Protocol.Types import Cardano.Tracing.OrphanInstances.Byron () diff --git a/cardano-node/src/Cardano/Node/Protocol/Cardano.hs b/cardano-node/src/Cardano/Node/Protocol/Cardano.hs index be314871cc1..5f672e5cf5f 100644 --- a/cardano-node/src/Cardano/Node/Protocol/Cardano.hs +++ b/cardano-node/src/Cardano/Node/Protocol/Cardano.hs @@ -27,7 +27,7 @@ import Ouroboros.Consensus.HardFork.Combinator.Condense () import qualified Ouroboros.Consensus.Shelley.Node.Praos as Praos import Ouroboros.Consensus.Cardano.Condense () -import qualified Ouroboros.Consensus.Mempool.TxLimits as TxLimits +import qualified Ouroboros.Consensus.Mempool.Capacity as TxLimits import Cardano.Api import Cardano.Api.Orphans () @@ -38,6 +38,7 @@ import Cardano.Tracing.OrphanInstances.Shelley () import qualified Cardano.Node.Protocol.Alonzo as Alonzo import qualified Cardano.Node.Protocol.Byron as Byron +import qualified Cardano.Node.Protocol.Conway as Conway import qualified Cardano.Node.Protocol.Shelley as Shelley import Cardano.Node.Protocol.Types @@ -61,6 +62,7 @@ mkSomeConsensusProtocolCardano :: NodeByronProtocolConfiguration -> NodeShelleyProtocolConfiguration -> NodeAlonzoProtocolConfiguration + -> NodeConwayProtocolConfiguration -> NodeHardForkProtocolConfiguration -> Maybe ProtocolFilepaths -> ExceptT CardanoProtocolInstantiationError IO SomeConsensusProtocol @@ -83,6 +85,10 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration { npcAlonzoGenesisFile, npcAlonzoGenesisFileHash } + NodeConwayProtocolConfiguration { + npcConwayGenesisFile, + npcConwayGenesisFileHash + } NodeHardForkProtocolConfiguration { -- npcTestEnableDevelopmentHardForkEras, -- During testing of the Alonzo era, we conditionally declared that we @@ -99,7 +105,9 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration { npcTestAlonzoHardForkAtEpoch, npcTestAlonzoHardForkAtVersion, npcTestBabbageHardForkAtEpoch, - npcTestBabbageHardForkAtVersion + npcTestBabbageHardForkAtVersion, + npcTestConwayHardForkAtEpoch, + npcTestConwayHardForkAtVersion } files = do byronGenesis <- @@ -122,6 +130,11 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration { Alonzo.readGenesis npcAlonzoGenesisFile npcAlonzoGenesisFileHash + (conwayGenesis, _conwayGenesisHash) <- + firstExceptT CardanoProtocolInstantiationConwayGenesisReadError $ + Conway.readGenesis npcConwayGenesisFile + npcConwayGenesisFileHash + shelleyLeaderCredentials <- firstExceptT CardanoProtocolInstantiationPraosLeaderCredentialsError $ Shelley.readLeaderCredentials files @@ -215,6 +228,15 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration { Praos.babbageMaxTxCapacityOverrides = TxLimits.mkOverrides TxLimits.noOverridesMeasure } + Praos.ProtocolParamsConway { + -- This is /not/ the Babbage protocol version. It is the protocol + -- version that this node will declare that it understands, when it + -- is in the Babbage era. Since Babbage is currently the last known + -- protocol version then this is also the Babbage protocol version. + Praos.conwayProtVer = ProtVer 9 0, + Praos.conwayMaxTxCapacityOverrides = + TxLimits.mkOverrides TxLimits.noOverridesMeasure + } -- ProtocolParamsTransition specifies the parameters needed to transition between two eras -- The comments below also apply for the Shelley -> Allegra and Allegra -> Mary hard forks. -- Byron to Shelley hard fork parameters @@ -283,6 +305,16 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration { Just epochNo -> Consensus.TriggerHardForkAtEpoch epochNo } + -- Alonzo to Conway hard fork parameters + Consensus.ProtocolTransitionParamsShelleyBased { + transitionTranslationContext = conwayGenesis, + transitionTrigger = + case npcTestConwayHardForkAtEpoch of + Nothing -> Consensus.TriggerHardForkAtVersion + (maybe 8 fromIntegral npcTestConwayHardForkAtVersion) + Just epochNo -> Consensus.TriggerHardForkAtEpoch epochNo + + } ------------------------------------------------------------------------------ -- Errors @@ -298,6 +330,9 @@ data CardanoProtocolInstantiationError = | CardanoProtocolInstantiationAlonzoGenesisReadError Shelley.GenesisReadError + | CardanoProtocolInstantiationConwayGenesisReadError + Shelley.GenesisReadError + | CardanoProtocolInstantiationPraosLeaderCredentialsError Shelley.PraosLeaderCredentialsError @@ -312,6 +347,8 @@ instance Error CardanoProtocolInstantiationError where "Shelley related: " <> displayError err displayError (CardanoProtocolInstantiationAlonzoGenesisReadError err) = "Alonzo related: " <> displayError err + displayError (CardanoProtocolInstantiationConwayGenesisReadError err) = + "Conway related : " <> displayError err displayError (CardanoProtocolInstantiationPraosLeaderCredentialsError err) = displayError err displayError (CardanoProtocolInstantiationErrorAlonzo err) = diff --git a/cardano-node/src/Cardano/Node/Protocol/Conway.hs b/cardano-node/src/Cardano/Node/Protocol/Conway.hs new file mode 100644 index 00000000000..ec0d4bd79e6 --- /dev/null +++ b/cardano-node/src/Cardano/Node/Protocol/Conway.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Cardano.Node.Protocol.Conway + ( ConwayProtocolInstantiationError(..) + -- * Reusable parts + , readGenesis + , validateGenesis + ) where + +import Cardano.Api + +import Ouroboros.Consensus.Shelley.Eras (StandardCrypto) + +import qualified Cardano.Ledger.Conway.Genesis as Conway + +import Cardano.Node.Orphans () +import Cardano.Node.Types + +import Cardano.Tracing.OrphanInstances.HardFork () +import Cardano.Tracing.OrphanInstances.Shelley () + +import Cardano.Node.Protocol.Shelley (GenesisReadError, readGenesisAny) + +import Control.Monad.Except (ExceptT) + +-- +-- Conway genesis +-- + +readGenesis :: GenesisFile + -> Maybe GenesisHash + -> ExceptT GenesisReadError IO + (Conway.ConwayGenesis StandardCrypto, GenesisHash) +readGenesis = readGenesisAny + +validateGenesis :: Conway.ConwayGenesis StandardCrypto + -> ExceptT ConwayProtocolInstantiationError IO () +validateGenesis _ = return () --TODO conway: do the validation + +data ConwayProtocolInstantiationError + = InvalidCostModelError !FilePath + | CostModelExtractionError !FilePath + | ConwayCostModelFileError !(FileError ()) + | ConwayCostModelDecodeError !FilePath !String + deriving Show + +instance Error ConwayProtocolInstantiationError where + displayError (InvalidCostModelError fp) = + "Invalid cost model: " <> show fp + displayError (CostModelExtractionError fp) = + "Error extracting the cost model at: " <> show fp + displayError (ConwayCostModelFileError err) = + displayError err + displayError (ConwayCostModelDecodeError fp err) = + "Error decoding cost model at: " <> show fp <> " Error: " <> err + diff --git a/cardano-node/src/Cardano/Node/Protocol/Shelley.hs b/cardano-node/src/Cardano/Node/Protocol/Shelley.hs index 8f616c20a5e..110c4768910 100644 --- a/cardano-node/src/Cardano/Node/Protocol/Shelley.hs +++ b/cardano-node/src/Cardano/Node/Protocol/Shelley.hs @@ -38,7 +38,7 @@ import Cardano.Ledger.Crypto (StandardCrypto) import Cardano.Ledger.Keys (coerceKeyRole) import qualified Ouroboros.Consensus.Cardano as Consensus -import qualified Ouroboros.Consensus.Mempool.TxLimits as TxLimits +import qualified Ouroboros.Consensus.Mempool.Capacity as TxLimits import Ouroboros.Consensus.Protocol.Praos.Common (PraosCanBeLeader (..)) import Ouroboros.Consensus.Shelley.Eras (StandardShelley) import Ouroboros.Consensus.Shelley.Node (Nonce (..), ProtocolParamsShelley (..), diff --git a/cardano-node/src/Cardano/Node/Startup.hs b/cardano-node/src/Cardano/Node/Startup.hs index 897aeda6d61..d33108cbf24 100644 --- a/cardano-node/src/Cardano/Node/Startup.hs +++ b/cardano-node/src/Cardano/Node/Startup.hs @@ -207,13 +207,14 @@ prepareNodeInfo nc (SomeConsensusProtocol whichP pForInfo) tc nodeStartTime = do let DegenLedgerConfig cfgShelley = configLedger cfg in getSystemStartShelley cfgShelley Api.CardanoBlockType -> - let CardanoLedgerConfig _ cfgShelley cfgAllegra cfgMary cfgAlonzo cfgBabbage = configLedger cfg + let CardanoLedgerConfig _ cfgShelley cfgAllegra cfgMary cfgAlonzo cfgBabbage cfgConway = configLedger cfg in minimum [ getSystemStartByron , getSystemStartShelley cfgShelley , getSystemStartShelley cfgAllegra , getSystemStartShelley cfgMary , getSystemStartShelley cfgAlonzo , getSystemStartShelley cfgBabbage + , getSystemStartShelley cfgConway ] getSystemStartByron = WCT.getSystemStart . getSystemStart . configBlock $ cfg diff --git a/cardano-node/src/Cardano/Node/Tracing/Documentation.hs b/cardano-node/src/Cardano/Node/Tracing/Documentation.hs index deeb194301c..ddba1ace4dc 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Documentation.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Documentation.hs @@ -61,7 +61,7 @@ import Ouroboros.Consensus.Ledger.Query (Query, ShowQuery) import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTxId, LedgerSupportsMempool) import Ouroboros.Consensus.Ledger.SupportsProtocol -import Ouroboros.Consensus.Mempool.API (TraceEventMempool (..)) +import Ouroboros.Consensus.Mempool (TraceEventMempool (..)) import Ouroboros.Consensus.MiniProtocol.BlockFetch.Server (TraceBlockFetchServerEvent (..)) import Ouroboros.Consensus.MiniProtocol.ChainSync.Client (TraceChainSyncClientEvent) diff --git a/cardano-node/src/Cardano/Node/Tracing/StateRep.hs b/cardano-node/src/Cardano/Node/Tracing/StateRep.hs index 44a53c527fe..3bb7e4f61ad 100644 --- a/cardano-node/src/Cardano/Node/Tracing/StateRep.hs +++ b/cardano-node/src/Cardano/Node/Tracing/StateRep.hs @@ -34,7 +34,7 @@ import qualified Ouroboros.Consensus.Block.RealPoint as RP import qualified Ouroboros.Consensus.Node.NetworkProtocolVersion as NPV import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB import Ouroboros.Consensus.Storage.ImmutableDB.Chunks.Internal -import qualified Ouroboros.Consensus.Storage.LedgerDB.OnDisk as LgrDb +import qualified Ouroboros.Consensus.Storage.LedgerDB as LgrDb import Ouroboros.Network.Block (pointSlot) import Cardano.Node.Handlers.Shutdown (ShutdownTrace) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs index bd487868e72..d2dcfb44293 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs @@ -53,7 +53,7 @@ import Ouroboros.Consensus.Node.NetworkProtocolVersion import qualified Ouroboros.Consensus.Node.Run as Consensus import qualified Ouroboros.Consensus.Node.Tracers as Consensus import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB -import qualified Ouroboros.Consensus.Storage.LedgerDB.OnDisk as LedgerDB +import qualified Ouroboros.Consensus.Storage.LedgerDB as LedgerDB import Network.Mux.Trace (TraceLabelPeer (..)) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/BlockReplayProgress.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/BlockReplayProgress.hs index e964d224419..c978cc1bf92 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/BlockReplayProgress.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/BlockReplayProgress.hs @@ -18,7 +18,7 @@ import Ouroboros.Network.Block (pointSlot, unSlotNo) import Ouroboros.Network.Point (withOrigin) import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB -import qualified Ouroboros.Consensus.Storage.LedgerDB.OnDisk as LedgerDB +import qualified Ouroboros.Consensus.Storage.LedgerDB as LedgerDB data ReplayBlockStats = ReplayBlockStats { rpsDisplay :: Bool diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs index 6e970752a6b..7711b7c3510 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs @@ -6,7 +6,8 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Node.Tracing.Tracers.ChainDB ( withAddedToCurrentChainEmptyLimited @@ -41,9 +42,8 @@ import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB import qualified Ouroboros.Consensus.Storage.ImmutableDB as ImmDB import Ouroboros.Consensus.Storage.ImmutableDB.Chunks.Internal (chunkNoToInt) import qualified Ouroboros.Consensus.Storage.ImmutableDB.Impl.Types as ImmDB -import qualified Ouroboros.Consensus.Storage.LedgerDB.OnDisk as LedgerDB -import Ouroboros.Consensus.Storage.LedgerDB.Types (UpdateLedgerDbTraceEvent (..)) -import qualified Ouroboros.Consensus.Storage.LedgerDB.Types as LedgerDB +import Ouroboros.Consensus.Storage.LedgerDB (UpdateLedgerDbTraceEvent (..)) +import qualified Ouroboros.Consensus.Storage.LedgerDB as LedgerDB import qualified Ouroboros.Consensus.Storage.VolatileDB as VolDB import Ouroboros.Consensus.Util.Condense (condense) import Ouroboros.Consensus.Util.Enclose @@ -88,10 +88,11 @@ instance ( LogFormatting (Header blk) forHuman (ChainDB.TraceInitChainSelEvent v) = forHuman v forHuman (ChainDB.TraceOpenEvent v) = forHuman v forHuman (ChainDB.TraceIteratorEvent v) = forHuman v - forHuman (ChainDB.TraceLedgerEvent v) = forHuman v + forHuman (ChainDB.TraceSnapshotEvent v) = forHuman v forHuman (ChainDB.TraceLedgerReplayEvent v) = forHuman v forHuman (ChainDB.TraceImmutableDBEvent v) = forHuman v forHuman (ChainDB.TraceVolatileDBEvent v) = forHuman v + forHuman (ChainDB.TraceLedgerEvent v) = forHuman v forMachine details (ChainDB.TraceAddBlockEvent v) = forMachine details v @@ -107,7 +108,7 @@ instance ( LogFormatting (Header blk) forMachine details v forMachine details (ChainDB.TraceIteratorEvent v) = forMachine details v - forMachine details (ChainDB.TraceLedgerEvent v) = + forMachine details (ChainDB.TraceSnapshotEvent v) = forMachine details v forMachine details (ChainDB.TraceLedgerReplayEvent v) = forMachine details v @@ -115,6 +116,8 @@ instance ( LogFormatting (Header blk) forMachine details v forMachine details (ChainDB.TraceVolatileDBEvent v) = forMachine details v + forMachine details (ChainDB.TraceLedgerEvent v) = + forMachine details v asMetrics (ChainDB.TraceAddBlockEvent v) = asMetrics v asMetrics (ChainDB.TraceFollowerEvent v) = asMetrics v @@ -123,10 +126,11 @@ instance ( LogFormatting (Header blk) asMetrics (ChainDB.TraceInitChainSelEvent v) = asMetrics v asMetrics (ChainDB.TraceOpenEvent v) = asMetrics v asMetrics (ChainDB.TraceIteratorEvent v) = asMetrics v - asMetrics (ChainDB.TraceLedgerEvent v) = asMetrics v + asMetrics (ChainDB.TraceSnapshotEvent v) = asMetrics v asMetrics (ChainDB.TraceLedgerReplayEvent v) = asMetrics v asMetrics (ChainDB.TraceImmutableDBEvent v) = asMetrics v asMetrics (ChainDB.TraceVolatileDBEvent v) = asMetrics v + asMetrics (ChainDB.TraceLedgerEvent v) = asMetrics v instance MetaTrace (ChainDB.TraceEvent blk) where @@ -144,7 +148,7 @@ instance MetaTrace (ChainDB.TraceEvent blk) where nsPrependInner "OpenEvent" (namespaceFor ev) namespaceFor (ChainDB.TraceIteratorEvent ev) = nsPrependInner "IteratorEvent" (namespaceFor ev) - namespaceFor (ChainDB.TraceLedgerEvent ev) = + namespaceFor (ChainDB.TraceSnapshotEvent ev) = nsPrependInner "LedgerEvent" (namespaceFor ev) namespaceFor (ChainDB.TraceLedgerReplayEvent ev) = nsPrependInner "LedgerReplay" (namespaceFor ev) @@ -152,6 +156,8 @@ instance MetaTrace (ChainDB.TraceEvent blk) where nsPrependInner "ImmDbEvent" (namespaceFor ev) namespaceFor (ChainDB.TraceVolatileDBEvent ev) = nsPrependInner "VolatileDbEvent" (namespaceFor ev) + namespaceFor (ChainDB.TraceLedgerEvent ev) = + nsPrependInner "TraceLedgerEvent" (namespaceFor ev) severityFor (Namespace out ("AddBlockEvent" : tl)) (Just (ChainDB.TraceAddBlockEvent ev')) = severityFor (Namespace out tl) (Just ev') @@ -181,10 +187,10 @@ instance MetaTrace (ChainDB.TraceEvent blk) where severityFor (Namespace out tl) (Just ev') severityFor (Namespace out ("IteratorEvent" : tl)) Nothing = severityFor (Namespace out tl :: Namespace (ChainDB.TraceIteratorEvent blk)) Nothing - severityFor (Namespace out ("LedgerEvent" : tl)) (Just (ChainDB.TraceLedgerEvent ev')) = + severityFor (Namespace out ("LedgerEvent" : tl)) (Just (ChainDB.TraceSnapshotEvent ev')) = severityFor (Namespace out tl) (Just ev') severityFor (Namespace out ("LedgerEvent" : tl)) Nothing = - severityFor (Namespace out tl :: Namespace (LedgerDB.TraceEvent blk)) Nothing + severityFor (Namespace out tl :: Namespace (LedgerDB.TraceSnapshotEvent blk)) Nothing severityFor (Namespace out ("LedgerReplay" : tl)) (Just (ChainDB.TraceLedgerReplayEvent ev')) = severityFor (Namespace out tl) (Just ev') severityFor (Namespace out ("LedgerReplay" : tl)) Nothing = @@ -227,10 +233,10 @@ instance MetaTrace (ChainDB.TraceEvent blk) where privacyFor (Namespace out tl) (Just ev') privacyFor (Namespace out ("IteratorEvent" : tl)) Nothing = privacyFor (Namespace out tl :: Namespace (ChainDB.TraceIteratorEvent blk)) Nothing - privacyFor (Namespace out ("LedgerEvent" : tl)) (Just (ChainDB.TraceLedgerEvent ev')) = + privacyFor (Namespace out ("LedgerEvent" : tl)) (Just (ChainDB.TraceSnapshotEvent ev')) = privacyFor (Namespace out tl) (Just ev') privacyFor (Namespace out ("LedgerEvent" : tl)) Nothing = - privacyFor (Namespace out tl :: Namespace (LedgerDB.TraceEvent blk)) Nothing + privacyFor (Namespace out tl :: Namespace (LedgerDB.TraceSnapshotEvent blk)) Nothing privacyFor (Namespace out ("LedgerReplay" : tl)) (Just (ChainDB.TraceLedgerReplayEvent ev')) = privacyFor (Namespace out tl) (Just ev') privacyFor (Namespace out ("LedgerReplay" : tl)) Nothing = @@ -273,7 +279,7 @@ instance MetaTrace (ChainDB.TraceEvent blk) where detailsFor (Namespace out tl) (Just ev') detailsFor (Namespace out ("IteratorEvent" : tl)) Nothing = detailsFor (Namespace out tl :: Namespace (ChainDB.TraceIteratorEvent blk)) Nothing - detailsFor (Namespace out ("LedgerEvent" : tl)) (Just (ChainDB.TraceLedgerEvent ev')) = + detailsFor (Namespace out ("LedgerEvent" : tl)) (Just (ChainDB.TraceSnapshotEvent ev')) = detailsFor (Namespace out tl) (Just ev') detailsFor (Namespace out ("LedgerEvent" : tl)) Nothing = detailsFor (Namespace out tl :: Namespace (LedgerDB.TraceReplayEvent blk)) Nothing @@ -306,7 +312,7 @@ instance MetaTrace (ChainDB.TraceEvent blk) where metricsDocFor (Namespace out ("IteratorEvent" : tl)) = metricsDocFor (Namespace out tl :: Namespace (ChainDB.TraceIteratorEvent blk)) metricsDocFor (Namespace out ("LedgerEvent" : tl)) = - metricsDocFor (Namespace out tl :: Namespace (LedgerDB.TraceEvent blk)) + metricsDocFor (Namespace out tl :: Namespace (LedgerDB.TraceSnapshotEvent blk)) metricsDocFor (Namespace out ("LedgerReplay" : tl)) = metricsDocFor (Namespace out tl :: Namespace (LedgerDB.TraceReplayEvent blk)) metricsDocFor (Namespace out ("ImmDbEvent" : tl)) = @@ -330,7 +336,7 @@ instance MetaTrace (ChainDB.TraceEvent blk) where documentFor (Namespace out ("IteratorEvent" : tl)) = documentFor (Namespace out tl :: Namespace (ChainDB.TraceIteratorEvent blk)) documentFor (Namespace out ("LedgerEvent" : tl)) = - documentFor (Namespace out tl :: Namespace (LedgerDB.TraceEvent blk)) + documentFor (Namespace out tl :: Namespace (LedgerDB.TraceSnapshotEvent blk)) documentFor (Namespace out ("LedgerReplay" : tl)) = documentFor (Namespace out tl :: Namespace (LedgerDB.TraceReplayEvent blk)) documentFor (Namespace out ("ImmDbEvent" : tl)) = @@ -355,7 +361,7 @@ instance MetaTrace (ChainDB.TraceEvent blk) where ++ map (nsPrependInner "IteratorEvent") (allNamespaces :: [Namespace (ChainDB.TraceIteratorEvent blk)]) ++ map (nsPrependInner "LedgerEvent") - (allNamespaces :: [Namespace (LedgerDB.TraceEvent blk)]) + (allNamespaces :: [Namespace (LedgerDB.TraceSnapshotEvent blk)]) ++ map (nsPrependInner "LedgerReplay") (allNamespaces :: [Namespace (LedgerDB.TraceReplayEvent blk)]) ++ map (nsPrependInner "ImmDbEvent") @@ -1433,12 +1439,12 @@ instance MetaTrace (ChainDB.UnknownRange blk) where ] -- -------------------------------------------------------------------------------- --- -- LedgerDB.TraceEvent +-- -- LedgerDB.TraceSnapshotEvent -- -------------------------------------------------------------------------------- instance ( StandardHash blk , ConvertRawHash blk) - => LogFormatting (LedgerDB.TraceEvent blk) where + => LogFormatting (LedgerDB.TraceSnapshotEvent blk) where forHuman (LedgerDB.TookSnapshot snap pt) = "Took ledger snapshot " <> showT snap <> " at " <> renderRealPointAsPhrase pt @@ -1459,7 +1465,7 @@ instance ( StandardHash blk , "snapshot" .= forMachine dtals snap , "failure" .= show failure ] -instance MetaTrace (LedgerDB.TraceEvent blk) where +instance MetaTrace (LedgerDB.TraceSnapshotEvent blk) where namespaceFor LedgerDB.TookSnapshot {} = Namespace [] ["TookSnapshot"] namespaceFor LedgerDB.DeletedSnapshot {} = Namespace [] ["DeletedSnapshot"] namespaceFor LedgerDB.InvalidSnapshot {} = Namespace [] ["InvalidSnapshot"] diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs index b85262b4282..f1760eaaefb 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs @@ -55,6 +55,7 @@ import Ouroboros.Network.BlockFetch.Decision import Ouroboros.Network.ConnectionId (ConnectionId (..)) import Ouroboros.Network.DeltaQ (GSV (..), PeerGSV (..)) import Ouroboros.Network.KeepAlive (TraceKeepAliveClient (..)) +import Ouroboros.Network.SizeInBytes (SizeInBytes (..)) import Ouroboros.Network.TxSubmission.Inbound hiding (txId) import Ouroboros.Network.TxSubmission.Outbound @@ -66,7 +67,7 @@ import Ouroboros.Consensus.Ledger.Inspect (LedgerEvent (..), LedgerUpd import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTxId, HasTxId, LedgerSupportsMempool, txForgetValidated, txId) import Ouroboros.Consensus.Ledger.SupportsProtocol -import Ouroboros.Consensus.Mempool.API (MempoolSize (..), TraceEventMempool (..)) +import Ouroboros.Consensus.Mempool (MempoolSize (..), TraceEventMempool (..)) import Ouroboros.Consensus.MiniProtocol.BlockFetch.Server (TraceBlockFetchServerEvent (..)) import Ouroboros.Consensus.MiniProtocol.ChainSync.Client @@ -387,7 +388,7 @@ calculateBlockFetchClientMetrics cm@ClientMetrics {..} _lc , cmCdf3sVar = cdf3sVar' , cmCdf5sVar = cdf5sVar' , cmDelay = realToFrac forgeDelay - , cmBlockSize = blockSize + , cmBlockSize = getSizeInBytes blockSize , cmTraceIt = True , cmSlotMap = slotMap''} else let @@ -402,7 +403,7 @@ calculateBlockFetchClientMetrics cm@ClientMetrics {..} _lc , cmCdf3sVar = cdf3sVar' , cmCdf5sVar = cdf5sVar' , cmDelay = realToFrac forgeDelay - , cmBlockSize = blockSize + , cmBlockSize = getSizeInBytes blockSize , cmTraceIt = True , cmSlotMap = slotMap'} else pure cm { @@ -525,7 +526,7 @@ instance (HasHeader header, ConvertRawHash header) => forMachine _dtal (BlockFetch.CompletedBlockFetch pt _ _ _ delay blockSize) = mconcat [ "kind" .= String "CompletedBlockFetch" , "delay" .= (realToFrac delay :: Double) - , "size" .= blockSize + , "size" .= getSizeInBytes blockSize , "block" .= String (case pt of GenesisPoint -> "Genesis" @@ -1166,7 +1167,7 @@ instance ( tx ~ GenTx blk (Proxy @blk) DDetailed (blockHash blk) - , "blockSize" .= toJSON (estimateBlockSize (getHeader blk)) + , "blockSize" .= toJSON (getSizeInBytes $ estimateBlockSize (getHeader blk)) , "txIds" .= toJSON (map (show . txId . txForgetValidated) txs) ] forMachine dtal (TraceAdoptedBlock slotNo blk _txs) = @@ -1177,7 +1178,7 @@ instance ( tx ~ GenTx blk (Proxy @blk) dtal (blockHash blk) - , "blockSize" .= toJSON (estimateBlockSize (getHeader blk)) + , "blockSize" .= toJSON (getSizeInBytes $ estimateBlockSize (getHeader blk)) ] forHuman (TraceStartLeadershipCheck slotNo) = diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs index 610c0d697de..66c9d528345 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/NodeToNode.hs @@ -13,7 +13,7 @@ module Cardano.Node.Tracing.Tracers.NodeToNode ) where import Cardano.Logging -import Data.Aeson (Value (String), toJSON, (.=)) +import Data.Aeson (Value (String), ToJSON (..), (.=)) import Data.Proxy (Proxy (..)) import Data.Text (pack) import Network.TypedProtocol.Codec (AnyMessageAndAgency (..)) @@ -29,6 +29,7 @@ import Ouroboros.Consensus.Node.Run (SerialiseNodeToNodeConstraints, e import Ouroboros.Network.Block (Point, Serialised, blockHash) import Ouroboros.Network.Protocol.BlockFetch.Type (BlockFetch (..), Message (..)) import qualified Ouroboros.Network.Protocol.TxSubmission2.Type as STX +import Ouroboros.Network.SizeInBytes (SizeInBytes (..)) -------------------------------------------------------------------------------- -- BlockFetch Tracer @@ -81,6 +82,9 @@ instance ( ConvertTxId blk , "agency" .= String (pack $ show stok) ] +instance ToJSON SizeInBytes where + toJSON (SizeInBytes s) = toJSON s + instance MetaTrace (AnyMessageAndAgency (BlockFetch blk1 (Point blk2))) where namespaceFor (AnyMessageAndAgency _stok MsgRequestRange{}) = Namespace [] ["RequestRange"] diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs index 8b77b6d3948..6fde78b029b 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/P2P.hs @@ -87,6 +87,11 @@ instance (ToJSONKey ntnAddr, ToJSONKey RelayAccessPoint, Show ntnAddr, Show exce , "domainAddress" .= toJSON d , "reason" .= show exception ] + forMachine _dtal (TraceLocalRootReconfigured d exception) = + mconcat [ "kind" .= String "LocalRootReconfigured" + , "domainAddress" .= toJSON d + , "reason" .= show exception + ] forHuman = pack . show instance MetaTrace (TraceLocalRootPeers ntnAddr exception) where @@ -96,6 +101,7 @@ instance MetaTrace (TraceLocalRootPeers ntnAddr exception) where namespaceFor TraceLocalRootGroups {} = Namespace [] ["LocalRootGroups"] namespaceFor TraceLocalRootFailure {} = Namespace [] ["LocalRootFailure"] namespaceFor TraceLocalRootError {} = Namespace [] ["LocalRootError"] + namespaceFor TraceLocalRootReconfigured {} = Namespace [] ["LocalRootReconfigured"] severityFor (Namespace [] ["LocalRootDomains"]) _ = Just Info severityFor (Namespace [] ["LocalRootWaiting"]) _ = Just Info diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs index 0da0dad0238..8152f872314 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Peer.hs @@ -12,6 +12,8 @@ module Cardano.Node.Tracing.Tracers.Peer where -- , ppPeer -- ) where +import Cardano.Node.Orphans () + import qualified Control.Concurrent.Class.MonadSTM.Strict as STM import "contra-tracer" Control.Tracer diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs index 76f807499ac..6b84c19bbe7 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs @@ -83,14 +83,16 @@ getStartupInfo nc (SomeConsensusProtocol whichP pForInfo) fp = do let DegenLedgerConfig cfgShelley = Consensus.configLedger cfg in [getGenesisValues "Shelley" cfgShelley] Api.CardanoBlockType -> - let CardanoLedgerConfig cfgByron cfgShelley cfgAllegra - cfgMary cfgAlonzo cfgBabbage = Consensus.configLedger cfg - in getGenesisValuesByron cfg cfgByron - : getGenesisValues "Shelley" cfgShelley - : getGenesisValues "Allegra" cfgAllegra - : getGenesisValues "Mary" cfgMary - : getGenesisValues "Alonzo" cfgAlonzo - : [getGenesisValues "Babbage" cfgBabbage] + let CardanoLedgerConfig cfgByron cfgShelley cfgAllegra cfgMary cfgAlonzo + cfgBabbage cfgConway = Consensus.configLedger cfg + in [ getGenesisValuesByron cfg cfgByron + , getGenesisValues "Shelley" cfgShelley + , getGenesisValues "Allegra" cfgAllegra + , getGenesisValues "Mary" cfgMary + , getGenesisValues "Alonzo" cfgAlonzo + , getGenesisValues "Babbage" cfgBabbage + , getGenesisValues "Conway" cfgConway + ] pure (basicInfoCommon : protocolDependentItems) where getGenesisValues era config = diff --git a/cardano-node/src/Cardano/Node/Types.hs b/cardano-node/src/Cardano/Node/Types.hs index dc55cb6d547..dc17fc7e155 100644 --- a/cardano-node/src/Cardano/Node/Types.hs +++ b/cardano-node/src/Cardano/Node/Types.hs @@ -25,6 +25,7 @@ module Cardano.Node.Types , NodeProtocolConfiguration(..) , NodeShelleyProtocolConfiguration(..) , NodeAlonzoProtocolConfiguration(..) + , NodeConwayProtocolConfiguration(..) , VRFPrivateKeyFilePermissionError(..) , renderVRFPrivateKeyFilePermissionError ) where @@ -124,6 +125,7 @@ data NodeProtocolConfiguration = | NodeProtocolConfigurationCardano NodeByronProtocolConfiguration NodeShelleyProtocolConfiguration NodeAlonzoProtocolConfiguration + NodeConwayProtocolConfiguration NodeHardForkProtocolConfiguration deriving (Eq, Show) @@ -141,6 +143,13 @@ data NodeAlonzoProtocolConfiguration = } deriving (Eq, Show) +data NodeConwayProtocolConfiguration = + NodeConwayProtocolConfiguration { + npcConwayGenesisFile :: !GenesisFile + , npcConwayGenesisFileHash :: !(Maybe GenesisHash) + } + deriving (Eq, Show) + data NodeByronProtocolConfiguration = NodeByronProtocolConfiguration { npcByronGenesisFile :: !GenesisFile @@ -268,6 +277,9 @@ data NodeHardForkProtocolConfiguration = -- configured the same, or they will disagree. -- , npcTestBabbageHardForkAtVersion :: Maybe Word + + , npcTestConwayHardForkAtEpoch :: Maybe EpochNo + , npcTestConwayHardForkAtVersion :: Maybe Word } deriving (Eq, Show) @@ -283,10 +295,11 @@ instance AdjustFilePaths NodeProtocolConfiguration where adjustFilePaths f (NodeProtocolConfigurationShelley pc) = NodeProtocolConfigurationShelley (adjustFilePaths f pc) - adjustFilePaths f (NodeProtocolConfigurationCardano pcb pcs pca pch) = + adjustFilePaths f (NodeProtocolConfigurationCardano pcb pcs pca pcc pch) = NodeProtocolConfigurationCardano (adjustFilePaths f pcb) (adjustFilePaths f pcs) (adjustFilePaths f pca) + (adjustFilePaths f pcc) pch instance AdjustFilePaths NodeByronProtocolConfiguration where @@ -307,6 +320,12 @@ instance AdjustFilePaths NodeAlonzoProtocolConfiguration where } = x { npcAlonzoGenesisFile = adjustFilePaths f npcAlonzoGenesisFile } +instance AdjustFilePaths NodeConwayProtocolConfiguration where + adjustFilePaths f x@NodeConwayProtocolConfiguration { + npcConwayGenesisFile + } = + x { npcConwayGenesisFile = adjustFilePaths f npcConwayGenesisFile } + instance AdjustFilePaths SocketConfig where adjustFilePaths f x@SocketConfig{ncSocketPath} = x { ncSocketPath = adjustFilePaths f ncSocketPath } diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs index ef8cc3ff1c3..065193999cc 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs @@ -12,7 +12,8 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_GHC -Wno-deprecations #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Tracing.OrphanInstances.Consensus () where @@ -51,7 +52,7 @@ import Ouroboros.Consensus.Ledger.Inspect (InspectLedger, LedgerEvent import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTx, GenTxId, HasTxId, LedgerSupportsMempool, TxId, txForgetValidated, txId) import Ouroboros.Consensus.Ledger.SupportsProtocol (LedgerSupportsProtocol) -import Ouroboros.Consensus.Mempool.API (MempoolSize (..), TraceEventMempool (..)) +import Ouroboros.Consensus.Mempool (MempoolSize (..), TraceEventMempool (..)) import Ouroboros.Consensus.MiniProtocol.BlockFetch.Server (TraceBlockFetchServerEvent (..)) import Ouroboros.Consensus.MiniProtocol.ChainSync.Client (TraceChainSyncClientEvent (..)) @@ -67,8 +68,8 @@ import qualified Ouroboros.Consensus.Protocol.BFT as BFT import qualified Ouroboros.Consensus.Protocol.PBFT as PBFT import Ouroboros.Consensus.Storage.ImmutableDB.Chunks.Internal (ChunkNo (..), chunkNoToInt) -import Ouroboros.Consensus.Storage.LedgerDB.Types -import qualified Ouroboros.Consensus.Storage.LedgerDB.Types as LedgerDB +import Ouroboros.Consensus.Storage.LedgerDB (PushGoal (..), Pushing (..), PushStart (..)) +import qualified Ouroboros.Consensus.Storage.LedgerDB as LedgerDB import qualified Ouroboros.Consensus.Storage.VolatileDB.Impl as VolDb import Ouroboros.Network.BlockFetch.ClientState (TraceLabelPeer (..)) @@ -80,13 +81,13 @@ import qualified Ouroboros.Network.AnchoredFragment as AF import Ouroboros.Network.Block (BlockNo (..), ChainUpdate (..), SlotNo (..), StandardHash, Tip (..), blockHash, pointSlot, tipFromHeader) import Ouroboros.Network.Point (withOrigin) +import Ouroboros.Network.SizeInBytes (SizeInBytes (..)) import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB -- TODO: 'TraceCacheEvent' should be exported by the 'Impl' module import Data.Function (on) import qualified Ouroboros.Consensus.Storage.ImmutableDB.API as ImmDB import qualified Ouroboros.Consensus.Storage.ImmutableDB.Impl.Types as ImmDB -import qualified Ouroboros.Consensus.Storage.LedgerDB.OnDisk as LedgerDB {- HLINT ignore "Use const" -} @@ -119,6 +120,7 @@ instance ConvertRawHash blk => ConvertRawHash (Header blk) where instance HasPrivacyAnnotation (ChainDB.TraceEvent blk) instance HasSeverityAnnotation (ChainDB.TraceEvent blk) where + getSeverityAnnotation (ChainDB.TraceLedgerEvent _ev) = Debug getSeverityAnnotation (ChainDB.TraceAddBlockEvent ev) = case ev of ChainDB.IgnoreBlockOlderThanK {} -> Info ChainDB.IgnoreBlockAlreadyInVolatileDB {} -> Info @@ -149,7 +151,7 @@ instance HasSeverityAnnotation (ChainDB.TraceEvent blk) where LedgerDB.ReplayFromSnapshot {} -> Info LedgerDB.ReplayedBlock {} -> Info - getSeverityAnnotation (ChainDB.TraceLedgerEvent ev) = case ev of + getSeverityAnnotation (ChainDB.TraceSnapshotEvent ev) = case ev of LedgerDB.TookSnapshot {} -> Info LedgerDB.DeletedSnapshot {} -> Debug LedgerDB.InvalidSnapshot {} -> Error @@ -464,6 +466,7 @@ instance ( ConvertRawHash blk , InspectLedger blk) => HasTextFormatter (ChainDB.TraceEvent blk) where formatText tev _obj = case tev of + ChainDB.TraceLedgerEvent _ev -> "TraceLedgerEvent" ChainDB.TraceAddBlockEvent ev -> case ev of ChainDB.IgnoreBlockOlderThanK pt -> "Ignoring block older than K: " <> renderRealPointAsPhrase pt @@ -512,7 +515,7 @@ instance ( ConvertRawHash blk "Candidate contains blocks from future exceeding clock skew limit: " <> renderPointAsPhrase (AF.headPoint c) <> ", slots " <> Text.intercalate ", " (map (renderPoint . headerPoint) hdrs) - ChainDB.UpdateLedgerDbTraceEvent (LedgerDB.StartedPushingBlockToTheLedgerDb (LedgerDB.PushStart start) (LedgerDB.PushGoal goal) (LedgerDB.Pushing curr)) -> + ChainDB.UpdateLedgerDbTraceEvent (LedgerDB.StartedPushingBlockToTheLedgerDb (PushStart start) (PushGoal goal) (Pushing curr)) -> let fromSlot = unSlotNo $ realPointSlot start atSlot = unSlotNo $ realPointSlot curr atDiff = atSlot - fromSlot @@ -553,7 +556,7 @@ instance ( ConvertRawHash blk <> ". Progress: " <> showProgressT (fromIntegral atDiff) (fromIntegral toDiff) <> "%" - ChainDB.TraceLedgerEvent ev -> case ev of + ChainDB.TraceSnapshotEvent ev -> case ev of LedgerDB.InvalidSnapshot snap failure -> "Invalid snapshot " <> showT snap <> showT failure LedgerDB.TookSnapshot snap pt -> @@ -600,7 +603,7 @@ instance ( ConvertRawHash blk ChainDB.ValidCandidate af -> "Valid candidate at tip " <> renderPointAsPhrase (AF.lastPoint af) ChainDB.CandidateContainsFutureBlocks {} -> "Found a candidate containing future blocks during Initial chain selection, truncating the candidate and retrying to select a best candidate." ChainDB.CandidateContainsFutureBlocksExceedingClockSkew {} -> "Found a candidate containing future blocks exceeding clock skew during Initial chain selection, truncating the candidate and retrying to select a best candidate." - ChainDB.UpdateLedgerDbTraceEvent (LedgerDB.StartedPushingBlockToTheLedgerDb (LedgerDB.PushStart start) (LedgerDB.PushGoal goal) (LedgerDB.Pushing curr)) -> + ChainDB.UpdateLedgerDbTraceEvent (LedgerDB.StartedPushingBlockToTheLedgerDb (PushStart start) (PushGoal goal) (Pushing curr)) -> let fromSlot = unSlotNo $ realPointSlot start atSlot = unSlotNo $ realPointSlot curr atDiff = atSlot - fromSlot @@ -926,7 +929,7 @@ instance ( ConvertRawHash blk mconcat [ "kind" .= String "TraceAddBlockEvent.AddBlockValidation.CandidateContainsFutureBlocksExceedingClockSkew" , "block" .= renderPointForVerbosity verb (AF.headPoint c) , "headers" .= map (renderPointForVerbosity verb . headerPoint) hdrs ] - ChainDB.UpdateLedgerDbTraceEvent (LedgerDB.StartedPushingBlockToTheLedgerDb (LedgerDB.PushStart start) (LedgerDB.PushGoal goal) (LedgerDB.Pushing curr)) -> + ChainDB.UpdateLedgerDbTraceEvent (LedgerDB.StartedPushingBlockToTheLedgerDb (PushStart start) (PushGoal goal) (Pushing curr)) -> mconcat [ "kind" .= String "TraceAddBlockEvent.AddBlockValidation.UpdateLedgerDb" , "startingBlock" .= renderRealPoint start , "currentBlock" .= renderRealPoint curr @@ -954,6 +957,7 @@ instance ( ConvertRawHash blk mconcat [ "kind" .= String "TraceAddBlockEvent.PipeliningEvent.OutdatedTentativeHeader" , "block" .= renderPointForVerbosity verb (blockPoint hdr) ] + where addedHdrsNewChain :: AF.AnchoredFragment (Header blk) @@ -966,6 +970,10 @@ instance ( ConvertRawHash blk Nothing -> [] -- No sense to do validation here. chainLengthΔ :: AF.AnchoredFragment (Header blk) -> AF.AnchoredFragment (Header blk) -> Int chainLengthΔ = on (-) (fromWithOrigin (-1) . fmap (fromIntegral . unBlockNo) . AF.headBlockNo) + + toObject _verb (ChainDB.TraceLedgerEvent _ev) = + mconcat [ "kind" .= String "TraceLedgerEvent" ] + toObject MinimalVerbosity (ChainDB.TraceLedgerReplayEvent _ev) = mempty -- no output toObject verb (ChainDB.TraceLedgerReplayEvent ev) = case ev of LedgerDB.ReplayFromGenesis _replayTo -> @@ -979,17 +987,17 @@ instance ( ConvertRawHash blk , "slot" .= unSlotNo (realPointSlot pt) , "tip" .= withOrigin 0 unSlotNo (pointSlot replayTo) ] - toObject MinimalVerbosity (ChainDB.TraceLedgerEvent _ev) = mempty -- no output - toObject verb (ChainDB.TraceLedgerEvent ev) = case ev of + toObject MinimalVerbosity (ChainDB.TraceSnapshotEvent _ev) = mempty -- no output + toObject verb (ChainDB.TraceSnapshotEvent ev) = case ev of LedgerDB.TookSnapshot snap pt -> - mconcat [ "kind" .= String "TraceLedgerEvent.TookSnapshot" + mconcat [ "kind" .= String "TraceSnapshotEvent.TookSnapshot" , "snapshot" .= toObject verb snap , "tip" .= show pt ] LedgerDB.DeletedSnapshot snap -> - mconcat [ "kind" .= String "TraceLedgerEvent.DeletedSnapshot" + mconcat [ "kind" .= String "TraceSnapshotEvent.DeletedSnapshot" , "snapshot" .= toObject verb snap ] LedgerDB.InvalidSnapshot snap failure -> - mconcat [ "kind" .= String "TraceLedgerEvent.InvalidSnapshot" + mconcat [ "kind" .= String "TraceSnapshotEvent.InvalidSnapshot" , "snapshot" .= toObject verb snap , "failure" .= show failure ] @@ -1066,7 +1074,7 @@ instance ( ConvertRawHash blk , "block" .= renderPointForVerbosity verb (AF.headPoint c) , "headers" .= map (renderPointForVerbosity verb . headerPoint) hdrs ] ChainDB.UpdateLedgerDbTraceEvent - (StartedPushingBlockToTheLedgerDb (PushStart start) (PushGoal goal) (Pushing curr) ) -> + (LedgerDB.StartedPushingBlockToTheLedgerDb (PushStart start) (PushGoal goal) (Pushing curr) ) -> mconcat [ "kind" .= String "TraceAddBlockEvent.AddBlockValidation.UpdateLedgerDbTraceEvent.StartedPushingBlockToTheLedgerDb" , "startingBlock" .= renderRealPoint start , "currentBlock" .= renderRealPoint curr @@ -1449,7 +1457,7 @@ instance ( RunNode blk (Proxy @blk) MaximalVerbosity (blockHash blk) - , "blockSize" .= toJSON (estimateBlockSize (getHeader blk)) + , "blockSize" .= toJSON (getSizeInBytes $ estimateBlockSize (getHeader blk)) , "txIds" .= toJSON (map (show . txId . txForgetValidated) txs) ] toObject verb (TraceAdoptedBlock slotNo blk _txs) = @@ -1460,7 +1468,7 @@ instance ( RunNode blk (Proxy @blk) verb (blockHash blk) - , "blockSize" .= toJSON (estimateBlockSize (getHeader blk)) + , "blockSize" .= toJSON (getSizeInBytes $ estimateBlockSize (getHeader blk)) ] diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index 17802abaf55..1d4f77df1e2 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs @@ -100,6 +100,7 @@ import Ouroboros.Network.RethrowPolicy (ErrorCommand (..)) import Ouroboros.Network.Server2 (ServerTrace (..)) import qualified Ouroboros.Network.Server2 as Server import Ouroboros.Network.Snocket (LocalAddress (..)) +import Ouroboros.Network.SizeInBytes (SizeInBytes (..)) import Ouroboros.Network.Subscription (ConnectResult (..), DnsTrace (..), SubscriberError (..), SubscriptionTrace (..), WithDomainName (..), WithIPList (..)) @@ -744,14 +745,14 @@ instance ( ConvertTxId blk mconcat [ "kind" .= String "MsgBlock" , "agency" .= String (pack $ show stok) , "blockHash" .= renderHeaderHash (Proxy @blk) (blockHash blk) - , "blockSize" .= toJSON (estimateBlockSize (getHeader blk)) + , "blockSize" .= toJSON (getSizeInBytes $ estimateBlockSize (getHeader blk)) ] toObject verb (AnyMessageAndAgency stok (MsgBlock blk)) = mconcat [ "kind" .= String "MsgBlock" , "agency" .= String (pack $ show stok) , "blockHash" .= renderHeaderHash (Proxy @blk) (blockHash blk) - , "blockSize" .= toJSON (estimateBlockSize (getHeader blk)) + , "blockSize" .= toJSON (getSizeInBytes $ estimateBlockSize (getHeader blk)) , "txIds" .= toJSON (presentTx <$> extractTxs blk) ] where @@ -1125,7 +1126,7 @@ instance (HasHeader header, ConvertRawHash header) toObject _verb (BlockFetch.CompletedBlockFetch pt _ _ _ delay blockSize) = mconcat [ "kind" .= String "CompletedBlockFetch" , "delay" .= (realToFrac delay :: Double) - , "size" .= blockSize + , "size" .= getSizeInBytes blockSize , "block" .= String (case pt of GenesisPoint -> "Genesis" @@ -1370,6 +1371,9 @@ instance Show exception => ToObject (TraceLocalRootPeers RemoteAddress exception , "domainAddress" .= toJSON d , "reason" .= show dexception ] + toObject _verb (TraceLocalRootReconfigured _ _) = + mconcat [ "kind" .= String "LocalRootReconfigured" + ] instance ToJSON IP where toJSON ip = String (pack . show $ ip) diff --git a/cardano-node/src/Cardano/Tracing/Peer.hs b/cardano-node/src/Cardano/Tracing/Peer.hs index b1317a93364..7e60fdf80a0 100644 --- a/cardano-node/src/Cardano/Tracing/Peer.hs +++ b/cardano-node/src/Cardano/Tracing/Peer.hs @@ -10,6 +10,8 @@ module Cardano.Tracing.Peer , tracePeers ) where +import Cardano.Node.Orphans () + import qualified Control.Concurrent.Class.MonadSTM.Strict as STM import Control.DeepSeq (NFData (..)) import Data.Aeson (ToJSON (..), Value (..), toJSON, (.=)) diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index 4a7447b7888..837a625dc83 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -77,7 +77,7 @@ import Ouroboros.Consensus.Ledger.Query (BlockQuery) import Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTx, GenTxId, HasTxs, LedgerSupportsMempool) import Ouroboros.Consensus.Ledger.SupportsProtocol (LedgerSupportsProtocol) -import Ouroboros.Consensus.Mempool.API (MempoolSize (..), TraceEventMempool (..)) +import Ouroboros.Consensus.Mempool (MempoolSize (..), TraceEventMempool (..)) import qualified Ouroboros.Consensus.Network.NodeToClient as NodeToClient import qualified Ouroboros.Consensus.Network.NodeToNode as NodeToNode import Ouroboros.Consensus.Node (NetworkP2PMode (..)) @@ -109,8 +109,7 @@ import Ouroboros.Network.NodeToClient (LocalAddress) import Ouroboros.Network.NodeToNode (RemoteAddress) import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB -import qualified Ouroboros.Consensus.Storage.LedgerDB.OnDisk as LedgerDB -import qualified Ouroboros.Consensus.Storage.LedgerDB.Types as LedgerDB +import qualified Ouroboros.Consensus.Storage.LedgerDB as LedgerDB import Cardano.Tracing.Config import Cardano.Tracing.HasIssuer (BlockIssuerVerificationKeyHash (..), HasIssuer (..)) @@ -172,7 +171,7 @@ nullTracersP2P = Tracers , peersTracer = nullTracer } -nullTracersNonP2P :: Tracers peer localPeer blk Diffusion.NonP2P +nullTracersNonP2P :: Tracers peer localPeer blk 'Diffusion.NonP2P nullTracersNonP2P = Tracers { chainDBTracer = nullTracer , consensusTracers = Consensus.nullTracers diff --git a/cardano-submit-api/cardano-submit-api.cabal b/cardano-submit-api/cardano-submit-api.cabal index a40e3c13f83..558545404a2 100644 --- a/cardano-submit-api/cardano-submit-api.cabal +++ b/cardano-submit-api/cardano-submit-api.cabal @@ -50,6 +50,7 @@ library , optparse-applicative-fork , ouroboros-consensus-cardano , ouroboros-network + , ouroboros-network-protocols , prometheus , servant , servant-server diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index e2e47e9e83f..156fd7c933d 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -48,6 +48,7 @@ library , hedgehog-extras ^>= 0.4 , optparse-applicative-fork , ouroboros-network + , ouroboros-network-api , process , random , resourcet diff --git a/cardano-testnet/src/Testnet/Babbage.hs b/cardano-testnet/src/Testnet/Babbage.hs index 1ef00fa88d8..4bc830c454d 100644 --- a/cardano-testnet/src/Testnet/Babbage.hs +++ b/cardano-testnet/src/Testnet/Babbage.hs @@ -70,9 +70,12 @@ babbageTestnet testnetOptions H.Conf {..} = do alonzoBabbageTestGenesisJsonSourceFile <- H.noteShow $ base "scripts/babbage/alonzo-babbage-test-genesis.json" alonzoBabbageTestGenesisJsonTargetFile <- H.noteShow $ tempAbsPath "genesis.alonzo.spec.json" - H.copyFile alonzoBabbageTestGenesisJsonSourceFile alonzoBabbageTestGenesisJsonTargetFile + conwayBabbageTestGenesisJsonSourceFile <- H.noteShow $ base "scripts/babbage/conway-babbage-test-genesis.json" + conwayBabbageTestGenesisJsonTargetFile <- H.noteShow $ tempAbsPath "genesis.conway.spec.json" + H.copyFile conwayBabbageTestGenesisJsonSourceFile conwayBabbageTestGenesisJsonTargetFile + configurationFile <- H.noteShow $ tempAbsPath "configuration.yaml" H.readFile configurationTemplate >>= H.writeFile configurationFile @@ -85,6 +88,7 @@ babbageTestnet testnetOptions H.Conf {..} = do . HM.insert "ByronGenesisFile" (toJSON @String "genesis/byron/genesis.json") . HM.insert "ShelleyGenesisFile" (toJSON @String "genesis/shelley/genesis.json") . HM.insert "AlonzoGenesisFile" (toJSON @String "genesis/shelley/genesis.alonzo.json") + . HM.insert "ConwayGenesisFile" (toJSON @String "genesis/shelley/genesis.conway.json") . HM.insert "RequiresNetworkMagic" (toJSON @String "RequiresMagic") . HM.insert "LastKnownBlockVersion-Major" (toJSON @Int 6) . HM.insert "LastKnownBlockVersion-Minor" (toJSON @Int 0) @@ -165,6 +169,7 @@ babbageTestnet testnetOptions H.Conf {..} = do H.renameFile (tempAbsPath "byron-gen-command/genesis.json") (tempAbsPath "genesis/byron/genesis.json") H.renameFile (tempAbsPath "genesis.alonzo.json") (tempAbsPath "genesis/shelley/genesis.alonzo.json") + H.renameFile (tempAbsPath "genesis.conway.json") (tempAbsPath "genesis/shelley/genesis.conway.json") H.renameFile (tempAbsPath "genesis.json") (tempAbsPath "genesis/shelley/genesis.json") H.rewriteJsonFile (tempAbsPath "genesis/byron/genesis.json") $ J.rewriteObject diff --git a/cardano-testnet/src/Testnet/Cardano.hs b/cardano-testnet/src/Testnet/Cardano.hs index 3374687c573..99b7656c4ac 100644 --- a/cardano-testnet/src/Testnet/Cardano.hs +++ b/cardano-testnet/src/Testnet/Cardano.hs @@ -250,6 +250,7 @@ cardanoTestnet testnetOptions H.Conf {..} = do . HM.insert "ByronGenesisFile" (J.toJSON @String "byron/genesis.json") . HM.insert "ShelleyGenesisFile" (J.toJSON @String "shelley/genesis.json") . HM.insert "AlonzoGenesisFile" (J.toJSON @String "shelley/genesis.alonzo.json") + . HM.insert "ConwayGenesisFile" (J.toJSON @String "shelley/genesis.conway.json") . HM.insert "RequiresNetworkMagic" (J.toJSON @String "RequiresMagic") . HM.insert "LastKnownBlockVersion-Major" (J.toJSON @Int 6) . HM.insert "LastKnownBlockVersion-Minor" (J.toJSON @Int 0) @@ -386,6 +387,10 @@ cardanoTestnet testnetOptions H.Conf {..} = do alonzoSpecFile <- H.noteTempFile tempAbsPath "shelley/genesis.alonzo.spec.json" liftIO $ IO.copyFile sourceAlonzoGenesisSpecFile alonzoSpecFile + let sourceConwayGenesisSpecFile = base "cardano-cli/test/data/golden/conway/genesis.conway.spec.json" + conwaySpecFile <- H.noteTempFile tempAbsPath "shelley/genesis.conway.spec.json" + liftIO $ IO.copyFile sourceConwayGenesisSpecFile conwaySpecFile + execCli_ [ "genesis", "create" , "--testnet-magic", show @Int testnetMagic @@ -440,6 +445,7 @@ cardanoTestnet testnetOptions H.Conf {..} = do -- Generated alonzo/genesis.json --TODO: rationalise the naming convention on these genesis json files. H.cat $ tempAbsPath "shelley/genesis.alonzo.json" + H.cat $ tempAbsPath "shelley/genesis.conway.json" -- Make the pool operator cold keys -- This was done already for the BFT nodes as part of the genesis creation @@ -699,10 +705,12 @@ cardanoTestnet testnetOptions H.Conf {..} = do byronGenesisHash <- getByronGenesisHash $ tempAbsPath "byron/genesis.json" shelleyGenesisHash <- getShelleyGenesisHash $ tempAbsPath "shelley/genesis.json" alonzoGenesisHash <- getShelleyGenesisHash $ tempAbsPath "shelley/genesis.alonzo.json" + conwayGenesisHash <- getShelleyGenesisHash $ tempAbsPath "shelley/genesis.conway.json" H.rewriteYamlFile (tempAbsPath "configuration.yaml") . J.rewriteObject $ HM.insert "ByronGenesisHash" byronGenesisHash . HM.insert "ShelleyGenesisHash" shelleyGenesisHash . HM.insert "AlonzoGenesisHash" alonzoGenesisHash + . HM.insert "ConwayGenesisHash" conwayGenesisHash -------------------------------- -- Launch cluster of three nodes diff --git a/cardano-testnet/src/Testnet/Options.hs b/cardano-testnet/src/Testnet/Options.hs index 9efce2c84ed..e00a193c2d5 100644 --- a/cardano-testnet/src/Testnet/Options.hs +++ b/cardano-testnet/src/Testnet/Options.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -Wno-unused-local-binds -Wno-unused-matches #-} diff --git a/cardano-testnet/src/Testnet/Shelley.hs b/cardano-testnet/src/Testnet/Shelley.hs index dc78bd6959c..b8611072ced 100644 --- a/cardano-testnet/src/Testnet/Shelley.hs +++ b/cardano-testnet/src/Testnet/Shelley.hs @@ -183,6 +183,10 @@ shelleyTestnet testnetOptions H.Conf {..} = do alonzoSpecFile <- H.noteTempFile tempAbsPath "genesis.alonzo.spec.json" liftIO $ IO.copyFile sourceAlonzoGenesisSpecFile alonzoSpecFile + let sourceConwayGenesisSpecFile = base "cardano-cli/test/data/golden/conway/genesis.conway.spec.json" + conwaySpecFile <- H.noteTempFile tempAbsPath "genesis.conway.spec.json" + liftIO $ IO.copyFile sourceConwayGenesisSpecFile conwaySpecFile + -- Set up our template execCli_ [ "genesis", "create" diff --git a/cardano-tracer/cardano-tracer.cabal b/cardano-tracer/cardano-tracer.cabal index 0085deda796..7a294201e30 100644 --- a/cardano-tracer/cardano-tracer.cabal +++ b/cardano-tracer/cardano-tracer.cabal @@ -143,7 +143,7 @@ library , filepath , mime-mail , optparse-applicative - , ouroboros-network + , ouroboros-network-api , ouroboros-network-framework , signal , smtp-mail == 0.3.0.0 @@ -209,7 +209,7 @@ library demo-forwarder-lib , filepath , generic-data , optparse-applicative-fork - , ouroboros-network + , ouroboros-network-api , ouroboros-network-framework , tasty-quickcheck , time @@ -249,7 +249,7 @@ library demo-acceptor-lib , filepath , generic-data , optparse-applicative-fork - , ouroboros-network + , ouroboros-network-api , stm , text , tasty-quickcheck @@ -300,7 +300,7 @@ test-suite cardano-tracer-test , filepath , generic-data , optparse-applicative-fork - , ouroboros-network + , ouroboros-network-api , ouroboros-network-framework , stm , tasty @@ -355,6 +355,7 @@ test-suite cardano-tracer-test-ext , Glob , optparse-applicative-fork , ouroboros-network + , ouroboros-network-api , ouroboros-network-framework , process , QuickCheck diff --git a/cardano-tracer/src/Cardano/Tracer/Acceptors/Client.hs b/cardano-tracer/src/Cardano/Tracer/Acceptors/Client.hs index 9179d3ad567..9badcf35824 100644 --- a/cardano-tracer/src/Cardano/Tracer/Acceptors/Client.hs +++ b/cardano-tracer/src/Cardano/Tracer/Acceptors/Client.hs @@ -23,7 +23,7 @@ import Ouroboros.Network.Protocol.Handshake.Codec (cborTermVersionData import Ouroboros.Network.Protocol.Handshake.Type (Handshake) import Ouroboros.Network.Protocol.Handshake.Version (acceptableVersion, simpleSingletonVersions) -import Ouroboros.Network.Snocket (LocalAddress, LocalSocket, Snocket, +import Ouroboros.Network.Snocket (LocalAddress, LocalSocket, Snocket, makeLocalBearer, localAddressFromPath, localSnocket) import Ouroboros.Network.Socket (ConnectionId (..), connectToNode, nullNetworkConnectTracers) @@ -89,6 +89,7 @@ doConnectToForwarder doConnectToForwarder snocket address netMagic timeLimits app = connectToNode snocket + makeLocalBearer mempty -- LocalSocket does not require to be configured (codecHandshake forwardingVersionCodec) timeLimits diff --git a/cardano-tracer/src/Cardano/Tracer/Acceptors/Server.hs b/cardano-tracer/src/Cardano/Tracer/Acceptors/Server.hs index 75019a94759..21bb57efce4 100644 --- a/cardano-tracer/src/Cardano/Tracer/Acceptors/Server.hs +++ b/cardano-tracer/src/Cardano/Tracer/Acceptors/Server.hs @@ -26,7 +26,7 @@ import Ouroboros.Network.Protocol.Handshake.Type (Handshake) import Ouroboros.Network.Protocol.Handshake.Version (acceptableVersion, simpleSingletonVersions) import Ouroboros.Network.Snocket (LocalAddress, LocalSocket, Snocket, - localAddressFromPath, localSnocket) + makeLocalBearer, localAddressFromPath, localSnocket) import Ouroboros.Network.Socket (AcceptedConnectionsLimit (..), ConnectionId (..), SomeResponderApplication (..), cleanNetworkMutableState, newNetworkMutableState, nullNetworkServerTracers, withServerNode) @@ -94,6 +94,7 @@ doListenToForwarder snocket address netMagic timeLimits app = do race_ (cleanNetworkMutableState networkState) $ withServerNode snocket + makeLocalBearer mempty -- LocalSocket does not need to be configured nullNetworkServerTracers networkState diff --git a/cardano-tracer/test/Cardano/Tracer/Test/Forwarder.hs b/cardano-tracer/test/Cardano/Tracer/Test/Forwarder.hs index bf3a4d47d05..7718adf8117 100644 --- a/cardano-tracer/test/Cardano/Tracer/Test/Forwarder.hs +++ b/cardano-tracer/test/Cardano/Tracer/Test/Forwarder.hs @@ -41,7 +41,8 @@ import Ouroboros.Network.Protocol.Handshake.Codec (cborTermVersionData import Ouroboros.Network.Protocol.Handshake.Type (Handshake) import Ouroboros.Network.Protocol.Handshake.Version (acceptableVersion, simpleSingletonVersions) -import Ouroboros.Network.Snocket (Snocket, localAddressFromPath, localSnocket) +import Ouroboros.Network.Snocket (MakeBearer, Snocket, makeLocalBearer, + localAddressFromPath, localSnocket) import Ouroboros.Network.Socket (AcceptedConnectionsLimit (..), SomeResponderApplication (..), cleanNetworkMutableState, connectToNode, newNetworkMutableState, nullNetworkConnectTracers, nullNetworkServerTracers, @@ -100,6 +101,7 @@ launchForwardersSimple' ts iomgr mode p connSize disconnSize = do doConnectToAcceptor ts (localSnocket iomgr) + makeLocalBearer (localAddressFromPath p) noTimeLimitsHandshake (ekgConfig, tfConfig, dpfConfig) @@ -107,6 +109,7 @@ launchForwardersSimple' ts iomgr mode p connSize disconnSize = do doListenToAcceptor ts (localSnocket iomgr) + makeLocalBearer (localAddressFromPath p) noTimeLimitsHandshake (ekgConfig, tfConfig, dpfConfig) @@ -139,6 +142,7 @@ launchForwardersSimple' ts iomgr mode p connSize disconnSize = do doConnectToAcceptor :: TestSetup Identity -> Snocket IO fd addr + -> MakeBearer IO fd -> addr -> ProtocolTimeLimits (Handshake ForwardingVersion Term) -> ( EKGF.ForwarderConfiguration @@ -146,7 +150,7 @@ doConnectToAcceptor , DPF.ForwarderConfiguration ) -> IO () -doConnectToAcceptor TestSetup{..} snocket address timeLimits (ekgConfig, tfConfig, dpfConfig) = do +doConnectToAcceptor TestSetup{..} snocket muxBearer address timeLimits (ekgConfig, tfConfig, dpfConfig) = do store <- EKG.newStore EKG.registerGcMetrics store sink <- initForwardSink tfConfig @@ -155,6 +159,7 @@ doConnectToAcceptor TestSetup{..} snocket address timeLimits (ekgConfig, tfConfi withAsync (traceObjectsWriter sink) $ \_ -> do connectToNode snocket + muxBearer mempty (codecHandshake forwardingVersionCodec) timeLimits @@ -190,6 +195,7 @@ doListenToAcceptor :: Ord addr => TestSetup Identity -> Snocket IO fd addr + -> MakeBearer IO fd -> addr -> ProtocolTimeLimits (Handshake ForwardingVersion Term) -> ( EKGF.ForwarderConfiguration @@ -198,7 +204,7 @@ doListenToAcceptor ) -> IO () doListenToAcceptor TestSetup{..} - snocket address timeLimits (ekgConfig, tfConfig, dpfConfig) = do + snocket muxBearer address timeLimits (ekgConfig, tfConfig, dpfConfig) = do store <- EKG.newStore EKG.registerGcMetrics store @@ -210,6 +216,7 @@ doListenToAcceptor TestSetup{..} race_ (cleanNetworkMutableState networkState) $ withServerNode snocket + muxBearer mempty nullNetworkServerTracers networkState diff --git a/configuration/cardano/mainnet-config.json b/configuration/cardano/mainnet-config.json index 1e0786de63d..fb7198e6c0a 100644 --- a/configuration/cardano/mainnet-config.json +++ b/configuration/cardano/mainnet-config.json @@ -5,6 +5,8 @@ "ApplicationVersion": 1, "ByronGenesisFile": "mainnet-byron-genesis.json", "ByronGenesisHash": "5f20df933584822601f9e3f8c024eb5eb252fe8cefb24d1317dc3d432e940ebb", + "ConwayGenesisFile": "mainnet-conway-genesis.json", + "ConwayGenesisHash": "f28f1c1280ea0d32f8cd3143e268650d6c1a8e221522ce4a7d20d62fc09783e1", "LastKnownBlockVersion-Alt": 0, "LastKnownBlockVersion-Major": 3, "LastKnownBlockVersion-Minor": 0, diff --git a/configuration/cardano/mainnet-config.yaml b/configuration/cardano/mainnet-config.yaml index 77abd0ff0e5..9cbf1fb9221 100644 --- a/configuration/cardano/mainnet-config.yaml +++ b/configuration/cardano/mainnet-config.yaml @@ -7,6 +7,8 @@ AlonzoGenesisFile: mainnet-alonzo-genesis.json AlonzoGenesisHash: 7e94a15f55d1e82d10f09203fa1d40f8eede58fd8066542cf6566008068ed874 ByronGenesisFile: mainnet-byron-genesis.json ByronGenesisHash: 5f20df933584822601f9e3f8c024eb5eb252fe8cefb24d1317dc3d432e940ebb +ConwayGenesisFile: mainnet-conway-genesis.json +ConwayGenesisHash: f28f1c1280ea0d32f8cd3143e268650d6c1a8e221522ce4a7d20d62fc09783e1 ShelleyGenesisFile: mainnet-shelley-genesis.json ShelleyGenesisHash: 1a3be38bcbb7911969283716ad7aa550250226b76a61fc51cc9a9a35d9276d81 diff --git a/configuration/cardano/mainnet-conway-genesis.json b/configuration/cardano/mainnet-conway-genesis.json new file mode 100644 index 00000000000..4525ef4a58c --- /dev/null +++ b/configuration/cardano/mainnet-conway-genesis.json @@ -0,0 +1,3 @@ +{ + "genDelegs": {} +} diff --git a/configuration/chairman/byron-shelley/configuration.yaml b/configuration/chairman/byron-shelley/configuration.yaml index f55fa087693..b7e3f394ad2 100644 --- a/configuration/chairman/byron-shelley/configuration.yaml +++ b/configuration/chairman/byron-shelley/configuration.yaml @@ -9,6 +9,7 @@ ByronGenesisFile: byron/genesis.json ShelleyGenesisFile: shelley/genesis.json AlonzoGenesisFile: shelley/genesis.alonzo.json +AlonzoGenesisFile: shelley/genesis.conway.json SocketPath: db/node.socket ##### Blockfetch Protocol diff --git a/scripts/babbage/conway-babbage-test-genesis.json b/scripts/babbage/conway-babbage-test-genesis.json new file mode 100644 index 00000000000..4525ef4a58c --- /dev/null +++ b/scripts/babbage/conway-babbage-test-genesis.json @@ -0,0 +1,3 @@ +{ + "genDelegs": {} +} diff --git a/scripts/babbage/mkfiles.sh b/scripts/babbage/mkfiles.sh index 76239c75c1c..e11cf3b05cc 100755 --- a/scripts/babbage/mkfiles.sh +++ b/scripts/babbage/mkfiles.sh @@ -85,6 +85,7 @@ $CARDANO_CLI byron genesis genesis \ cp scripts/babbage/alonzo-babbage-test-genesis.json "${ROOT}/genesis.alonzo.spec.json" +cp scripts/babbage/conway-babbage-test-genesis.json "${ROOT}/genesis.conway.spec.json" cp configuration/defaults/byron-mainnet/configuration.yaml "${ROOT}/" $SED -i "${ROOT}/configuration.yaml" \ @@ -94,6 +95,7 @@ $SED -i "${ROOT}/configuration.yaml" \ -e 's|GenesisFile: genesis.json|ByronGenesisFile: genesis/byron/genesis.json|' \ -e '/ByronGenesisFile/ aShelleyGenesisFile: genesis/shelley/genesis.json' \ -e '/ByronGenesisFile/ aAlonzoGenesisFile: genesis/shelley/genesis.alonzo.json' \ + -e '/ByronGenesisFile/ aConwayGenesisFile: genesis/shelley/genesis.conway.json' \ -e 's/RequiresNoMagic/RequiresMagic/' \ -e 's/LastKnownBlockVersion-Major: 0/LastKnownBlockVersion-Major: 6/' \ -e 's/LastKnownBlockVersion-Minor: 2/LastKnownBlockVersion-Minor: 0/' @@ -103,6 +105,7 @@ $SED -i "${ROOT}/configuration.yaml" \ echo "TestMaryHardForkAtEpoch: 0" >> "${ROOT}/configuration.yaml" echo "TestAlonzoHardForkAtEpoch: 0" >> "${ROOT}/configuration.yaml" echo "TestBabbageHardForkAtEpoch: 0" >> "${ROOT}/configuration.yaml" + echo "TestConwayHardForkAtEpoch: 0" >> "${ROOT}/configuration.yaml" echo "TestEnableDevelopmentNetworkProtocols: True" >> "${ROOT}/configuration.yaml" # Copy the cost mode @@ -134,6 +137,7 @@ mkdir -p "${ROOT}/genesis/shelley" mv "${ROOT}/byron-gen-command/genesis.json" "${ROOT}/genesis/byron/genesis-wrong.json" mv "${ROOT}/genesis.alonzo.json" "${ROOT}/genesis/shelley/genesis.alonzo.json" +mv "${ROOT}/genesis.conway.json" "${ROOT}/genesis/shelley/genesis.conway.json" mv "${ROOT}/genesis.json" "${ROOT}/genesis/shelley/genesis.json" jq --raw-output '.protocolConsts.protocolMagic = 42' "${ROOT}/genesis/byron/genesis-wrong.json" > "${ROOT}/genesis/byron/genesis.json" diff --git a/trace-dispatcher/src/Cardano/Logging/Forwarding.hs b/trace-dispatcher/src/Cardano/Logging/Forwarding.hs index c9945c9a229..362f4f480dc 100644 --- a/trace-dispatcher/src/Cardano/Logging/Forwarding.hs +++ b/trace-dispatcher/src/Cardano/Logging/Forwarding.hs @@ -31,7 +31,8 @@ import Ouroboros.Network.Protocol.Handshake.Codec (cborTermVersionData import Ouroboros.Network.Protocol.Handshake.Type (Handshake) import Ouroboros.Network.Protocol.Handshake.Version (acceptableVersion, simpleSingletonVersions) -import Ouroboros.Network.Snocket (Snocket, localAddressFromPath, localSnocket) +import Ouroboros.Network.Snocket (Snocket, MakeBearer, localAddressFromPath, localSnocket, + makeLocalBearer) import Ouroboros.Network.Socket (AcceptedConnectionsLimit (..), SomeResponderApplication (..), cleanNetworkMutableState, connectToNode, newNetworkMutableState, nullNetworkConnectTracers, nullNetworkServerTracers, @@ -157,14 +158,15 @@ launchForwardersViaLocalSocket launchForwardersViaLocalSocket iomgr magic ekgConfig tfConfig dpfConfig sink ekgStore dpStore p mode = (case mode of - Initiator -> doConnectToAcceptor magic (localSnocket iomgr) mempty - Responder -> doListenToAcceptor magic (localSnocket iomgr) mempty) + Initiator -> doConnectToAcceptor magic (localSnocket iomgr) makeLocalBearer mempty + Responder -> doListenToAcceptor magic (localSnocket iomgr) makeLocalBearer mempty) (localAddressFromPath p) noTimeLimitsHandshake ekgConfig tfConfig dpfConfig sink ekgStore dpStore doConnectToAcceptor :: NetworkMagic -> Snocket IO fd addr + -> MakeBearer IO fd -> (fd -> IO ()) -> addr -> ProtocolTimeLimits (Handshake ForwardingVersion Term) @@ -175,10 +177,11 @@ doConnectToAcceptor -> Maybe EKG.Store -> DataPointStore -> IO () -doConnectToAcceptor magic snocket configureSocket address timeLimits +doConnectToAcceptor magic snocket makeBearer configureSocket address timeLimits ekgConfig tfConfig dpfConfig sink ekgStore dpStore = do connectToNode snocket + makeBearer configureSocket (codecHandshake forwardingVersionCodec) timeLimits @@ -219,6 +222,7 @@ doListenToAcceptor :: Ord addr => NetworkMagic -> Snocket IO fd addr + -> MakeBearer IO fd -> (fd -> addr -> IO ()) -> addr -> ProtocolTimeLimits (Handshake ForwardingVersion Term) @@ -229,12 +233,13 @@ doListenToAcceptor -> Maybe EKG.Store -> DataPointStore -> IO () -doListenToAcceptor magic snocket configureSocket address timeLimits +doListenToAcceptor magic snocket makeBearer configureSocket address timeLimits ekgConfig tfConfig dpfConfig sink ekgStore dpStore = do networkState <- newNetworkMutableState race_ (cleanNetworkMutableState networkState) $ withServerNode snocket + makeBearer configureSocket nullNetworkServerTracers networkState diff --git a/trace-dispatcher/trace-dispatcher.cabal b/trace-dispatcher/trace-dispatcher.cabal index 6c0a4761143..9489c41236c 100644 --- a/trace-dispatcher/trace-dispatcher.cabal +++ b/trace-dispatcher/trace-dispatcher.cabal @@ -52,11 +52,12 @@ library , contra-tracer , ekg , ekg-core - , ekg-forward == 0.3.0 + , ekg-forward >= 0.3.0 , hostname , network , optparse-applicative-fork , ouroboros-network + , ouroboros-network-api , ouroboros-network-framework , serialise , stm diff --git a/trace-forward/trace-forward.cabal b/trace-forward/trace-forward.cabal index 447e93334e1..568904b77c7 100644 --- a/trace-forward/trace-forward.cabal +++ b/trace-forward/trace-forward.cabal @@ -63,6 +63,7 @@ library , contra-tracer , extra , io-classes ^>= 0.3 + , ouroboros-network-api , ouroboros-network-framework , serialise , stm @@ -95,6 +96,7 @@ test-suite test , contra-tracer , io-classes ^>= 0.3 , io-sim + , ouroboros-network-api , ouroboros-network-framework , trace-forward , QuickCheck