diff --git a/.github/workflows/haskell-wasm.yml b/.github/workflows/haskell-wasm.yml index 3a4870d462..776ecf21b8 100644 --- a/.github/workflows/haskell-wasm.yml +++ b/.github/workflows/haskell-wasm.yml @@ -114,8 +114,8 @@ jobs: - name: Restore cached deps run: | - wget "https://agrius.feralhosting.com/palas/wasm-cache/4c200033737be4736cd2a363d64c49a385937d5ea57d8e52773f65d08bbd1342.tar.bz2" - tar -jxf 4c200033737be4736cd2a363d64c49a385937d5ea57d8e52773f65d08bbd1342.tar.bz2 + wget "https://agrius.feralhosting.com/palas/wasm-cache/c98ffd34ef84bbd524f7c750e96452c13063b960c05cb2d3361e343377978cc8.tar.xz" + tar -xf c98ffd34ef84bbd524f7c750e96452c13063b960c05cb2d3361e343377978cc8.tar.xz rm -fr ~/.ghc-wasm/.cabal/store/ mv store ~/.ghc-wasm/.cabal/ diff --git a/.github/workflows/hls.yml b/.github/workflows/hls.yml index 72ed6d3095..2941420032 100644 --- a/.github/workflows/hls.yml +++ b/.github/workflows/hls.yml @@ -14,7 +14,7 @@ jobs: test-hls-works: env: # Modify this value to "invalidate" the cache. - HLS_CACHE_VERSION: "2025-09-04" + HLS_CACHE_VERSION: "2025-09-23" runs-on: ubuntu-latest timeout-minutes: 60 diff --git a/cabal.project b/cabal.project index 00318cf5ad..fff04abd9f 100644 --- a/cabal.project +++ b/cabal.project @@ -13,21 +13,21 @@ repository cardano-haskell-packages -- See CONTRIBUTING for information about these, including some Nix commands -- you need to run if you change them index-state: - , hackage.haskell.org 2025-06-22T20:18:27Z - , cardano-haskell-packages 2025-06-20T09:11:51Z + , hackage.haskell.org 2025-09-11T01:58:40Z + , cardano-haskell-packages 2025-09-20T20:31:08Z packages: cardano-api cardano-api-gen cardano-wasm - cardano-rpc + -- TODO fix potential issues with build-type: Custom and protoc and reenable + -- cardano-rpc extra-packages: Cabal, process if impl(ghc < 9.8) constraints: interpolatedstring-perl6:setup.time source -constraints: process >= 1.6.26.1 -- It may slow down build plan preparation, but without it cabal has problems -- with solving constraints. Remove this when not needed anymore. @@ -61,18 +61,19 @@ if impl (ghc >= 9.12) -- https://github.com/kapralVV/Unique/issues/11 , Unique:hashable + -- WASM compilation specific if arch(wasm32) source-repository-package type: git - location: https://github.com/amesgen/plutus.git - tag: dc1edea4458d6fb794b245a26c730620265645f3 + location: https://github.com/intersectmbo/plutus.git + tag: 210c8375cd82eb2670b703b0975c26589dd40b2f subdir: plutus-core plutus-ledger-api plutus-tx - --sha256: sha256-QBtLmoS54b5QMAKIDOJIM6lmRC+1leBpuGKaFc7QQos= + --sha256: sha256-icAg87JKdCkeuNZvVwNlT0v1/O0wOYwIQ6LzXj9iTYM= package plutus-core flags: +do-not-build-plutus-exec @@ -86,11 +87,11 @@ if arch(wasm32) source-repository-package type: git location: https://github.com/palas/ouroboros-network.git - tag: ef3e30603e4e45dac336a085114ee22b7aa8c9ed + tag: bbc8bd70386a951e8633e4966e661df079cdc103 subdir: ouroboros-network ouroboros-network-framework - --sha256: sha256-+IdAmWJqzRy+erKONywtk+5YLrm63q942nZavoEA4E4= + --sha256: sha256-7m9lMZlQzjbfaGpWA5ipDGloQ2uhIQmFRoUFQ7GCDl8= source-repository-package type: git @@ -161,3 +162,24 @@ if arch(wasm32) -- Do NOT add more source-repository-package stanzas here unless they are strictly -- temporary! Please read the section in CONTRIBUTING about updating dependencies. +source-repository-package + type: git + location: https://github.com/IntersectMBO/ouroboros-consensus + -- latest master + tag: 71b02607c8a39ed4d8c983b281b05452ed8c01ce + --sha256: sha256-/vnZnAPsEuqQMzG5NGHaWk9vyefBWMft7/rKQ+yyYTQ= + subdir: + ouroboros-consensus + ouroboros-consensus-cardano + ouroboros-consensus-diffusion + ouroboros-consensus-protocol + sop-extras + strict-sop-core + +source-repository-package + type: git + location: https://github.com/input-output-hk/kes-agent + tag: bf203c4e7f7e6aab947b077e178baac3ecb2541d + --sha256: sha256-cURVbhbTvK6iPKaXVjCovBezyE5UVs46iarmVyWA2Uc= + subdir: + kes-agent diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index e4915b0e03..cf73203451 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -129,9 +129,10 @@ library cardano-ledger-api >=1.11, cardano-ledger-babbage >=1.11, cardano-ledger-binary >=1.6, - cardano-ledger-byron >=1.1, + cardano-ledger-byron >=1.2, cardano-ledger-conway >=1.19, - cardano-ledger-core >=1.17, + cardano-ledger-core >=1.17 && <1.19, + cardano-ledger-dijkstra >=0.1, cardano-ledger-mary >=1.8, cardano-ledger-shelley >=1.16, cardano-protocol-tpraos >=1.4, @@ -153,7 +154,6 @@ library iproute, memory, microlens, - microlens-aeson, mono-traversable, mtl, network, @@ -165,12 +165,12 @@ library ouroboros-consensus-diffusion ^>=0.23, ouroboros-consensus-protocol ^>=0.12, ouroboros-network, - ouroboros-network-api >=0.14, + ouroboros-network-api >=0.15, ouroboros-network-framework, - ouroboros-network-protocols >=0.14, + ouroboros-network-protocols >=0.15, parsec, - plutus-core, - plutus-ledger-api ^>=1.45, + plutus-core ^>=1.53, + plutus-ledger-api ^>=1.53, pretty-simple, prettyprinter, prettyprinter-ansi-terminal, @@ -188,7 +188,7 @@ library time, transformers, transformers-except ^>=0.1.3, - typed-protocols ^>=0.3, + typed-protocols ^>=1.0, validation, vector, yaml, @@ -311,7 +311,7 @@ library gen build-depends: FailT, - QuickCheck, + QuickCheck <2.16, aeson >=1.5.6.0, base16-bytestring, bytestring, @@ -319,11 +319,13 @@ library gen cardano-binary >=1.6 && <1.8, cardano-crypto-class ^>=2.2.1, cardano-crypto-test ^>=1.6, + cardano-crypto-wrapper, cardano-ledger-alonzo >=1.8.1, cardano-ledger-babbage, - cardano-ledger-byron-test >=1.5, + cardano-ledger-byron, cardano-ledger-conway, cardano-ledger-core >=1.14, + cardano-ledger-dijkstra >=0.1, cardano-ledger-mary, cardano-ledger-shelley >=1.13, cardano-strict-containers, @@ -347,7 +349,7 @@ test-suite cardano-api-test type: exitcode-stdio-1.0 build-depends: FailT, - QuickCheck, + QuickCheck <2.16, aeson >=1.5.6.0, base16-bytestring, bytestring, @@ -359,7 +361,7 @@ test-suite cardano-api-test cardano-crypto-tests ^>=2.2, cardano-crypto-wrapper, cardano-ledger-alonzo, - cardano-ledger-api >=1.9, + cardano-ledger-api >=1.11, cardano-ledger-binary, cardano-ledger-conway, cardano-ledger-core >=1.14, @@ -373,13 +375,12 @@ test-suite cardano-api-test hedgehog >=1.1, hedgehog-extras, hedgehog-quickcheck, - interpolatedstring-perl6, microlens, mtl, ouroboros-consensus, ouroboros-consensus-cardano, ouroboros-consensus-protocol, - plutus-ledger-api, + raw-strings-qq, tasty, tasty-hedgehog, tasty-quickcheck, @@ -432,7 +433,7 @@ test-suite cardano-api-golden cardano-crypto-class ^>=2.2.1, cardano-data >=1.0, cardano-ledger-alonzo, - cardano-ledger-api >=1.9, + cardano-ledger-api >=1.11, cardano-ledger-binary, cardano-ledger-core >=1.14, cardano-ledger-shelley, @@ -441,10 +442,10 @@ test-suite cardano-api-golden errors, filepath, hedgehog >=1.1, - hedgehog-extras ^>=0.8, + hedgehog-extras ^>=0.10, microlens, - plutus-core ^>=1.45, - plutus-ledger-api, + plutus-core ^>=1.53, + plutus-ledger-api ^>=1.53, tasty, tasty-discover, tasty-hedgehog, diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Era.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Era.hs index b64290895b..3b041b0232 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Era.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Era.hs @@ -36,6 +36,7 @@ shelleyBasedEraTestConstraints = \case ShelleyBasedEraAlonzo -> id ShelleyBasedEraBabbage -> id ShelleyBasedEraConway -> id + ShelleyBasedEraDijkstra -> id conwayEraOnwardsTestConstraints :: () @@ -48,3 +49,4 @@ conwayEraOnwardsTestConstraints -> a conwayEraOnwardsTestConstraints = \case ConwayEraOnwardsConway -> id + ConwayEraOnwardsDijkstra -> id diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Orphans.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Orphans.hs index 6a256faee4..1d1caf5c6b 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Orphans.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Orphans.hs @@ -24,16 +24,19 @@ import Cardano.Ledger.Address () import Cardano.Ledger.Alonzo.PParams qualified as Ledger import Cardano.Ledger.Alonzo.Scripts qualified as Alonzo import Cardano.Ledger.Babbage.PParams qualified as Ledger -import Cardano.Ledger.BaseTypes (textToDns, textToUrl) +import Cardano.Ledger.BaseTypes import Cardano.Ledger.BaseTypes qualified as Ledger import Cardano.Ledger.Coin qualified as L import Cardano.Ledger.Conway.Governance qualified as Ledger import Cardano.Ledger.Conway.PParams qualified as Ledger import Cardano.Ledger.Core qualified as Ledger +import Cardano.Ledger.Dijkstra (DijkstraEra) +import Cardano.Ledger.Dijkstra.PParams import Cardano.Ledger.HKD (HKD, NoUpdate (..)) import Cardano.Ledger.Keys (VRFVerKeyHash (..)) import Cardano.Ledger.Mary.Value qualified as ConcreteValue import Cardano.Ledger.Mary.Value qualified as Ledger +import Cardano.Ledger.Plutus.CostModels qualified as L import Cardano.Ledger.Plutus.CostModels qualified as Ledger import Cardano.Ledger.Plutus.Language qualified as L import Cardano.Ledger.Plutus.Language qualified as Ledger @@ -79,6 +82,7 @@ import Test.QuickCheck , scale , shrinkBoundedEnum , sublistOf + , suchThatMap , vectorOf ) import Test.QuickCheck.Gen (Gen (MkGen)) @@ -392,7 +396,7 @@ multiAssetFromListBounded = instance Arbitrary L.GovActionId where arbitrary = L.GovActionId <$> arbitrary <*> arbitrary -deriving instance Arbitrary (L.GovPurposeId p era) +deriving instance Arbitrary (L.GovPurposeId p) instance Arbitrary L.DRep where arbitrary = @@ -736,7 +740,7 @@ instance Arbitrary Alonzo.CostModels where genValidCostModel :: Ledger.Language -> Gen Ledger.CostModel genValidCostModel lang = do - newParamValues <- vectorOf (Ledger.costModelParamsCount lang) arbitrary + newParamValues <- vectorOf (L.costModelInitParamCount lang) arbitrary either (\err -> error $ "Corrupt cost model: " ++ show err) pure $ Ledger.mkCostModel lang newParamValues @@ -772,12 +776,12 @@ genCostModelValues lang = do Positive sub <- arbitrary (,) lang' <$> oneof - [ listAtLeast (Ledger.costModelParamsCount lang) + [ listAtLeast (L.costModelInitParamCount lang) , take (tooFew sub) <$> arbitrary ] where lang' = fromIntegral (fromEnum lang) - tooFew sub = Ledger.costModelParamsCount lang - sub + tooFew sub = L.costModelInitParamCount lang - sub listAtLeast :: Int -> Gen [Int64] listAtLeast x = do NonNegative y <- arbitrary @@ -805,3 +809,25 @@ obtainArbitraryConstraints era f = case era of ShelleyBasedEraAlonzo -> f ShelleyBasedEraBabbage -> f ShelleyBasedEraConway -> f + ShelleyBasedEraDijkstra -> f + +instance Arbitrary (DijkstraPParams Identity DijkstraEra) where + arbitrary = genericArbitraryU + +instance Arbitrary (DijkstraPParams StrictMaybe DijkstraEra) where + arbitrary = genericArbitraryU + +instance Arbitrary PositiveInterval where + arbitrary = do + p <- chooseInt (0, maxDecimalsWord64) + let y = 10 ^ p :: Word64 + x <- choose (1, 10 ^ (maxDecimalsWord64 :: Int)) + pure $ unsafeBoundedRational $ promoteRatio (x % y) + +instance (Arbitrary a, HasZero a) => Arbitrary (NonZero a) where + arbitrary = arbitrary `suchThatMap` nonZero + +instance Arbitrary (L.CompactForm Coin) where + arbitrary = + L.CompactCoin <$> oneof [choose (0, 1000000), fromIntegral <$> (arbitrary :: Gen Word), arbitrary] + shrink (L.CompactCoin i) = L.CompactCoin <$> shrink i diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index 9f1a9d656a..08800a9a64 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE EmptyCase #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE NamedFieldPuns #-} @@ -161,9 +162,14 @@ import Cardano.Api.Parser.Text qualified as P import Cardano.Api.Tx qualified as A import Cardano.Binary qualified as CBOR +import Cardano.Chain.UTxO qualified as Byron +import Cardano.Crypto.DSIGN.Class qualified as Crypto import Cardano.Crypto.Hash qualified as Crypto import Cardano.Crypto.Hash.Class qualified as CRYPTO +import Cardano.Crypto.Hashing qualified as ByronCrypto +import Cardano.Crypto.ProtocolMagic qualified as Byron import Cardano.Crypto.Seed qualified as Crypto +import Cardano.Crypto.Signing qualified as Crypto import Cardano.Ledger.Alonzo.Scripts qualified as Alonzo import Cardano.Ledger.BaseTypes qualified as Ledger import Cardano.Ledger.Core qualified as Ledger @@ -181,6 +187,7 @@ import Data.Int (Int64) import Data.Maybe import Data.Ratio (Ratio, (%)) import Data.String +import Data.Text (Text) import Data.Typeable import Data.Word (Word16, Word32, Word64) import GHC.Exts (IsList (..)) @@ -192,7 +199,6 @@ import Test.Gen.Cardano.Api.Hardcoded import Test.Gen.Cardano.Api.Metadata (genTxMetadata) import Test.Gen.Cardano.Api.Orphans (obtainArbitraryConstraints) -import Test.Cardano.Chain.UTxO.Gen (genVKWitness) import Test.Cardano.Crypto.Gen (genProtocolMagicId) import Hedgehog (Gen, MonadGen, Range) @@ -216,9 +222,6 @@ genAddressShelley = genAddressInEra :: ShelleyBasedEra era -> Gen (AddressInEra era) genAddressInEra sbe = shelleyAddressInEra sbe <$> genAddressShelley -_genAddressInEraByron :: Gen (AddressInEra era) -_genAddressInEraByron = byronAddressInEra <$> genAddressByron - genKESPeriod :: Gen KESPeriod genKESPeriod = KESPeriod <$> Gen.word Range.constantBounded @@ -301,6 +304,9 @@ genPlutusScript l = PlutusScriptV3 -> do PlutusScript _ s <- genPlutusV3Script return s + PlutusScriptV4 -> do + PlutusScript _ s <- genPlutusV4Script + return s genValidPlutusScript :: PlutusScriptVersion lang -> Gen (PlutusScript lang) genValidPlutusScript l = @@ -314,6 +320,9 @@ genValidPlutusScript l = PlutusScriptV3 -> do PlutusScript _ s <- genValidPlutusV3Script return s + PlutusScriptV4 -> do + PlutusScript _ s <- genValidPlutusV4Script + return s genPlutusV1Script :: Gen (Script PlutusScriptV1) genPlutusV1Script = do @@ -346,6 +355,14 @@ genPlutusV3Script = do let v3ScriptBytes = Base16.decodeLenient v3AlwaysSucceedsPlutusScriptHex return . PlutusScript PlutusScriptV3 . PlutusScriptSerialised $ SBS.toShort v3ScriptBytes +-- TODO: This is not generating v4 scripts. +genPlutusV4Script :: Gen (Script PlutusScriptV4) +genPlutusV4Script = do + v3AlwaysSucceedsPlutusScriptHex <- + Gen.element [v3AlwaysSucceedsPlutusScriptDoubleEncoded, v3AlwaysSucceedsPlutusScript] + let v3ScriptBytes = Base16.decodeLenient v3AlwaysSucceedsPlutusScriptHex + return . PlutusScript PlutusScriptV4 . PlutusScriptSerialised $ SBS.toShort v3ScriptBytes + genValidPlutusV3Script :: Gen (Script PlutusScriptV3) genValidPlutusV3Script = do v3AlwaysSucceedsPlutusScriptHex <- @@ -353,6 +370,14 @@ genValidPlutusV3Script = do let v3ScriptBytes = Base16.decodeLenient v3AlwaysSucceedsPlutusScriptHex return . PlutusScript PlutusScriptV3 . PlutusScriptSerialised $ SBS.toShort v3ScriptBytes +-- TODO: This is not generating v4 scripts. +genValidPlutusV4Script :: Gen (Script PlutusScriptV4) +genValidPlutusV4Script = do + v3AlwaysSucceedsPlutusScriptHex <- + Gen.element [v3AlwaysSucceedsPlutusScript] + let v3ScriptBytes = Base16.decodeLenient v3AlwaysSucceedsPlutusScriptHex + return . PlutusScript PlutusScriptV4 . PlutusScriptSerialised $ SBS.toShort v3ScriptBytes + genScriptDataSchema :: Gen ScriptDataJsonSchema genScriptDataSchema = Gen.element [ScriptDataJsonNoSchema, ScriptDataJsonDetailedSchema] @@ -1163,6 +1188,47 @@ genVerificationKeyHash genVerificationKeyHash roletoken = verificationKeyHash <$> genVerificationKey roletoken +genVKWitness :: Byron.ProtocolMagicId -> Gen Byron.TxInWitness +genVKWitness pm = Byron.VKWitness <$> genByronVerificationKey <*> genTxSig pm + +genTxSig :: Byron.ProtocolMagicId -> Gen Byron.TxSig +genTxSig pm = Crypto.sign pm <$> genSignTag <*> genByronSigningKey <*> genTxSigData + +genTxSigData :: Gen Byron.TxSigData +genTxSigData = Byron.TxSigData <$> genTxHash + +genTxHash :: Gen (ByronCrypto.Hash Byron.Tx) +genTxHash = coerce <$> genTextHash + +genTextHash :: Gen (ByronCrypto.Hash Text) +genTextHash = ByronCrypto.serializeCborHash <$> Gen.text (Range.linear 0 10) Gen.alphaNum + +genSignTag :: Gen Crypto.SignTag +genSignTag = + Gen.choice + [ pure Crypto.SignForTestingOnly + , pure Crypto.SignTx + , pure Crypto.SignRedeemTx + , pure Crypto.SignVssCert + , pure Crypto.SignUSProposal + , pure Crypto.SignCommitment + , pure Crypto.SignUSVote + , Crypto.SignBlock <$> genByronVerificationKey + , pure Crypto.SignCertificate + ] + +genByronVerificationKey :: Gen Crypto.VerificationKey +genByronVerificationKey = fst <$> genKeypair + +genByronSigningKey :: Gen Crypto.SigningKey +genByronSigningKey = snd <$> genKeypair + +genKeypair :: Gen (Crypto.VerificationKey, Crypto.SigningKey) +genKeypair = Crypto.deterministicKeyGen <$> gen32Bytes + +gen32Bytes :: Gen ByteString +gen32Bytes = Gen.bytes (Range.singleton 32) + genByronKeyWitness :: Gen (KeyWitness ByronEra) genByronKeyWitness = do pmId <- genProtocolMagicId @@ -1361,6 +1427,13 @@ genTxOutDatumHashTxContext era = case era of , TxOutSupplementalDatum AlonzoEraOnwardsConway <$> genHashableScriptData , TxOutDatumInline BabbageEraOnwardsConway <$> genHashableScriptData ] + ShelleyBasedEraDijkstra -> + Gen.choice + [ pure TxOutDatumNone + , TxOutDatumHash AlonzoEraOnwardsDijkstra <$> genHashScriptData + , TxOutSupplementalDatum AlonzoEraOnwardsDijkstra <$> genHashableScriptData + , TxOutDatumInline BabbageEraOnwardsDijkstra <$> genHashableScriptData + ] genTxOutDatumHashUTxOContext :: ShelleyBasedEra era -> Gen (TxOutDatum CtxUTxO era) genTxOutDatumHashUTxOContext era = case era of @@ -1384,6 +1457,12 @@ genTxOutDatumHashUTxOContext era = case era of , TxOutDatumHash AlonzoEraOnwardsConway <$> genHashScriptData , TxOutDatumInline BabbageEraOnwardsConway <$> genHashableScriptData ] + ShelleyBasedEraDijkstra -> + Gen.choice + [ pure TxOutDatumNone + , TxOutDatumHash AlonzoEraOnwardsDijkstra <$> genHashScriptData + , TxOutDatumInline BabbageEraOnwardsDijkstra <$> genHashableScriptData + ] mkDummyHash :: forall h a. CRYPTO.HashAlgorithm h => Int -> CRYPTO.Hash h a mkDummyHash = coerce . CRYPTO.hashWithSerialiser @h CBOR.toCBOR @@ -1564,11 +1643,18 @@ genAnyPlutusScriptVersion = do plutusScriptLangaugeInEra :: Exp.Era era -> PlutusScriptVersion lang -> ScriptLanguageInEra lang era +plutusScriptLangaugeInEra Exp.DijkstraEra l = + case l of + PlutusScriptV1 -> PlutusScriptV1InDijkstra + PlutusScriptV2 -> PlutusScriptV2InDijkstra + PlutusScriptV3 -> PlutusScriptV3InDijkstra + PlutusScriptV4 -> PlutusScriptV4InDijkstra plutusScriptLangaugeInEra Exp.ConwayEra l = case l of PlutusScriptV1 -> PlutusScriptV1InConway PlutusScriptV2 -> PlutusScriptV2InConway PlutusScriptV3 -> PlutusScriptV3InConway + PlutusScriptV4 -> case undefined :: ScriptLanguageInEra PlutusScriptV4 ConwayEra of {} genApiPlutusScriptWitness :: WitCtx witctx -> Exp.Era era -> Gen (Api.ScriptWitness witctx era) diff --git a/cardano-api/src/Cardano/Api/Block.hs b/cardano-api/src/Cardano/Api/Block.hs index 8760593873..20ccaaea70 100644 --- a/cardano-api/src/Cardano/Api/Block.hs +++ b/cardano-api/src/Cardano/Api/Block.hs @@ -72,7 +72,6 @@ import Ouroboros.Consensus.Byron.Ledger qualified as Consensus import Ouroboros.Consensus.Cardano.Block qualified as Consensus import Ouroboros.Consensus.HardFork.Combinator qualified as Consensus import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus -import Ouroboros.Consensus.Shelley.Protocol.Abstract qualified as Consensus import Ouroboros.Network.Block qualified as Consensus import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), object, withObject, (.:), (.=)) @@ -153,6 +152,12 @@ instance Show (Block era) where ( showString "ShelleyBlock ShelleyBasedEraConway " . showsPrec 11 block ) + showsPrec p (ShelleyBlock ShelleyBasedEraDijkstra block) = + showParen + (p >= 11) + ( showString "ShelleyBlock ShelleyBasedEraDijkstra " + . showsPrec 11 block + ) getBlockTxs :: forall era. Block era -> [Tx era] getBlockTxs = \case @@ -167,7 +172,6 @@ getShelleyBlockTxs :: forall era ledgerera blockheader . ShelleyLedgerEra era ~ ledgerera => Consensus.ShelleyCompatible (ConsensusProtocol era) ledgerera - => Consensus.ShelleyProtocolHeader (ConsensusProtocol era) ~ blockheader => ShelleyBasedEra era -> Ledger.Block blockheader ledgerera -> [Tx era] @@ -203,6 +207,7 @@ fromConsensusBlock = \case Consensus.BlockAlonzo b' -> BlockInMode cardanoEra $ ShelleyBlock ShelleyBasedEraAlonzo b' Consensus.BlockBabbage b' -> BlockInMode cardanoEra $ ShelleyBlock ShelleyBasedEraBabbage b' Consensus.BlockConway b' -> BlockInMode cardanoEra $ ShelleyBlock ShelleyBasedEraConway b' + Consensus.BlockDijkstra b' -> BlockInMode cardanoEra $ ShelleyBlock ShelleyBasedEraDijkstra b' toConsensusBlock :: () @@ -217,6 +222,7 @@ toConsensusBlock = \case BlockInMode _ (ShelleyBlock ShelleyBasedEraAlonzo b') -> Consensus.BlockAlonzo b' BlockInMode _ (ShelleyBlock ShelleyBasedEraBabbage b') -> Consensus.BlockBabbage b' BlockInMode _ (ShelleyBlock ShelleyBasedEraConway b') -> Consensus.BlockConway b' + BlockInMode _ (ShelleyBlock ShelleyBasedEraDijkstra b') -> Consensus.BlockDijkstra b' -- ---------------------------------------------------------------------------- -- Block headers diff --git a/cardano-api/src/Cardano/Api/Certificate/Internal.hs b/cardano-api/src/Cardano/Api/Certificate/Internal.hs index 24d91fd65c..301e4d97f7 100644 --- a/cardano-api/src/Cardano/Api/Certificate/Internal.hs +++ b/cardano-api/src/Cardano/Api/Certificate/Internal.hs @@ -67,6 +67,7 @@ module Cardano.Api.Certificate.Internal , fromShelleyCertificate , toShelleyPoolParams , fromShelleyPoolParams + , fromShelleyStakePoolState -- * Data family instances , AsType (..) @@ -100,6 +101,7 @@ import Cardano.Ledger.Api qualified as L import Cardano.Ledger.BaseTypes (strictMaybe) import Cardano.Ledger.Coin qualified as L import Cardano.Ledger.Keys qualified as Ledger +import Cardano.Ledger.State qualified as Ledger import Control.Monad.Except (MonadError (..)) import Data.ByteString (ByteString) @@ -234,6 +236,7 @@ certificateToTxCert c = ConwayCertificate eon cert -> case eon of ConwayEraOnwardsConway -> cert + ConwayEraOnwardsDijkstra -> error "certificateToTxCert: Dijkstra era is not yet supported" -- ---------------------------------------------------------------------------- -- Stake pool parameters @@ -576,6 +579,7 @@ filterUnRegCreds = Ledger.RetirePoolTxCert _ _ -> Nothing Ledger.MirTxCert _ -> Nothing Ledger.GenesisDelegTxCert{} -> Nothing + _ -> error "dijkstra" ConwayCertificate cEra conwayCert -> conwayEraOnwardsConstraints cEra $ case conwayCert of Ledger.RegPoolTxCert _ -> Nothing @@ -593,6 +597,7 @@ filterUnRegCreds = Ledger.RegTxCert _ -> Nothing -- stake cred deregistration w/o deposit Ledger.UnRegTxCert cred -> Just cred + _ -> error "dijkstra" filterUnRegDRepCreds :: Certificate era -> Maybe (Ledger.Credential Ledger.DRepRole) @@ -615,6 +620,7 @@ filterUnRegDRepCreds = \case Ledger.RegTxCert _ -> Nothing -- stake cred deregistration w/o deposit Ledger.UnRegTxCert _ -> Nothing + _ -> error "dijkstra" -- ---------------------------------------------------------------------------- -- Internal conversion functions @@ -777,6 +783,74 @@ fromShelleyPoolParams Text.encodeUtf8 . Ledger.dnsToText +fromShelleyStakePoolState + :: Ledger.KeyHash Ledger.StakePool + -> Ledger.StakePoolState + -> StakePoolParameters +fromShelleyStakePoolState + poolId + Ledger.StakePoolState + { Ledger.spsVrf + , Ledger.spsPledge + , Ledger.spsCost + , Ledger.spsMargin + , Ledger.spsRewardAccount + , Ledger.spsOwners + , Ledger.spsRelays + , Ledger.spsMetadata + } = + StakePoolParameters + { stakePoolId = StakePoolKeyHash poolId + , stakePoolVRF = VrfKeyHash (Ledger.fromVRFVerKeyHash spsVrf) + , stakePoolCost = spsCost + , stakePoolMargin = Ledger.unboundRational spsMargin + , stakePoolRewardAccount = fromShelleyStakeAddr spsRewardAccount + , stakePoolPledge = spsPledge + , stakePoolOwners = map StakeKeyHash (toList spsOwners) + , stakePoolRelays = + map + fromShelleyStakePoolRelay + (toList spsRelays) + , stakePoolMetadata = + fromShelleyPoolMetadata + <$> Ledger.strictMaybeToMaybe spsMetadata + } + where + fromShelleyStakePoolRelay :: Ledger.StakePoolRelay -> StakePoolRelay + fromShelleyStakePoolRelay (Ledger.SingleHostAddr mport mipv4 mipv6) = + StakePoolRelayIp + (Ledger.strictMaybeToMaybe mipv4) + (Ledger.strictMaybeToMaybe mipv6) + (fromIntegral . Ledger.portToWord16 <$> Ledger.strictMaybeToMaybe mport) + fromShelleyStakePoolRelay (Ledger.SingleHostName mport dnsname) = + StakePoolRelayDnsARecord + (fromShelleyDnsName dnsname) + (fromIntegral . Ledger.portToWord16 <$> Ledger.strictMaybeToMaybe mport) + fromShelleyStakePoolRelay (Ledger.MultiHostName dnsname) = + StakePoolRelayDnsSrvRecord + (fromShelleyDnsName dnsname) + + fromShelleyPoolMetadata :: Ledger.PoolMetadata -> StakePoolMetadataReference + fromShelleyPoolMetadata + Ledger.PoolMetadata + { Ledger.pmUrl + , Ledger.pmHash + } = + StakePoolMetadataReference + { stakePoolMetadataURL = Ledger.urlToText pmUrl + , stakePoolMetadataHash = + StakePoolMetadataHash + . fromMaybe (error "fromShelleyPoolMetadata: invalid hash. TODO: proper validation") + . Ledger.hashFromBytes + $ pmHash + } + + -- TODO: change the ledger rep of the DNS name to use ShortByteString + fromShelleyDnsName :: Ledger.DnsName -> ByteString + fromShelleyDnsName = + Text.encodeUtf8 + . Ledger.dnsToText + data AnchorDataFromCertificateError = InvalidPoolMetadataHashError Ledger.Url ByteString deriving (Eq, Show) @@ -803,6 +877,7 @@ getAnchorDataFromCertificate c = Ledger.RetirePoolTxCert _ _ -> return Nothing Ledger.GenesisDelegTxCert{} -> return Nothing Ledger.MirTxCert _ -> return Nothing + _ -> error "dijkstra" ConwayCertificate ceo ccert -> conwayEraOnwardsConstraints ceo $ case ccert of @@ -819,6 +894,7 @@ getAnchorDataFromCertificate c = Ledger.UpdateDRepTxCert _ mAnchor -> return $ Ledger.strictMaybeToMaybe mAnchor Ledger.AuthCommitteeHotKeyTxCert _ _ -> return Nothing Ledger.ResignCommitteeColdTxCert _ mAnchor -> return $ Ledger.strictMaybeToMaybe mAnchor + _ -> error "dijkstra" where anchorDataFromPoolMetadata :: MonadError AnchorDataFromCertificateError m diff --git a/cardano-api/src/Cardano/Api/Consensus/Internal/InMode.hs b/cardano-api/src/Cardano/Api/Consensus/Internal/InMode.hs index ca10b1abd5..8fea91d371 100644 --- a/cardano-api/src/Cardano/Api/Consensus/Internal/InMode.hs +++ b/cardano-api/src/Cardano/Api/Consensus/Internal/InMode.hs @@ -100,6 +100,9 @@ fromConsensusGenTx = \case Consensus.HardForkGenTx (Consensus.OneEraGenTx (S (S (S (S (S (S (Z tx')))))))) -> let Consensus.ShelleyTx _txid shelleyEraTx = tx' in TxInMode ShelleyBasedEraConway (ShelleyTx ShelleyBasedEraConway shelleyEraTx) + Consensus.HardForkGenTx (Consensus.OneEraGenTx (S (S (S (S (S (S (S (Z tx'))))))))) -> + let Consensus.ShelleyTx _txid shelleyEraTx = tx' + in TxInMode ShelleyBasedEraDijkstra (ShelleyTx ShelleyBasedEraDijkstra shelleyEraTx) toConsensusGenTx :: () @@ -132,6 +135,10 @@ toConsensusGenTx (TxInMode ShelleyBasedEraConway (ShelleyTx _ tx)) = Consensus.HardForkGenTx (Consensus.OneEraGenTx (S (S (S (S (S (S (Z tx')))))))) where tx' = Consensus.mkShelleyTx tx +toConsensusGenTx (TxInMode ShelleyBasedEraDijkstra (ShelleyTx _ tx)) = + Consensus.HardForkGenTx (Consensus.OneEraGenTx (S (S (S (S (S (S (S (Z tx'))))))))) + where + tx' = Consensus.mkShelleyTx tx -- ---------------------------------------------------------------------------- -- Transaction ids in the context of a consensus mode @@ -193,6 +200,12 @@ toConsensusTxId (TxIdInMode ConwayEra txid) = where txid' :: Consensus.TxId (Consensus.GenTx Consensus.StandardConwayBlock) txid' = Consensus.ShelleyTxId $ toShelleyTxId txid +toConsensusTxId (TxIdInMode DijkstraEra txid) = + Consensus.HardForkGenTxId + (Consensus.OneEraGenTxId (S (S (S (S (S (S (S (Z (Consensus.WrapGenTxId txid')))))))))) + where + txid' :: Consensus.TxId (Consensus.GenTx Consensus.StandardDijkstraBlock) + txid' = Consensus.ShelleyTxId $ toShelleyTxId txid -- ---------------------------------------------------------------------------- -- Transaction validation errors in the context of eras and consensus modes @@ -300,5 +313,7 @@ fromConsensusApplyTxErr = \case TxValidationErrorInCardanoMode $ ShelleyTxValidationError ShelleyBasedEraBabbage err Consensus.ApplyTxErrConway err -> TxValidationErrorInCardanoMode $ ShelleyTxValidationError ShelleyBasedEraConway err + Consensus.ApplyTxErrDijkstra err -> + TxValidationErrorInCardanoMode $ ShelleyTxValidationError ShelleyBasedEraDijkstra err Consensus.ApplyTxErrWrongEra err -> TxValidationEraMismatch err diff --git a/cardano-api/src/Cardano/Api/Consensus/Internal/Mode.hs b/cardano-api/src/Cardano/Api/Consensus/Internal/Mode.hs index c4e4100c16..bf0a7155dc 100644 --- a/cardano-api/src/Cardano/Api/Consensus/Internal/Mode.hs +++ b/cardano-api/src/Cardano/Api/Consensus/Internal/Mode.hs @@ -83,6 +83,7 @@ type family ConsensusBlockForEra era where ConsensusBlockForEra AlonzoEra = Consensus.StandardAlonzoBlock ConsensusBlockForEra BabbageEra = Consensus.StandardBabbageBlock ConsensusBlockForEra ConwayEra = Consensus.StandardConwayBlock + ConsensusBlockForEra DijkstraEra = Consensus.StandardDijkstraBlock type family ConsensusCryptoForBlock block where ConsensusCryptoForBlock Consensus.ByronBlockHFC = StandardCrypto @@ -98,6 +99,7 @@ type family ConsensusProtocol era where ConsensusProtocol AlonzoEra = Consensus.TPraos StandardCrypto ConsensusProtocol BabbageEra = Consensus.Praos StandardCrypto ConsensusProtocol ConwayEra = Consensus.Praos StandardCrypto + ConsensusProtocol DijkstraEra = Consensus.Praos StandardCrypto type family ChainDepStateProtocol era where ChainDepStateProtocol ShelleyEra = Consensus.TPraosState @@ -128,6 +130,9 @@ eraIndex5 = eraIndexSucc eraIndex4 eraIndex6 :: Consensus.EraIndex (x6 : x5 : x4 : x3 : x2 : x1 : x0 : xs) eraIndex6 = eraIndexSucc eraIndex5 +eraIndex7 :: Consensus.EraIndex (x7 : x6 : x5 : x4 : x3 : x2 : x1 : x0 : xs) +eraIndex7 = eraIndexSucc eraIndex6 + toConsensusEraIndex :: () => Consensus.CardanoBlock StandardCrypto ~ Consensus.HardForkBlock xs @@ -141,6 +146,7 @@ toConsensusEraIndex = \case AlonzoEra -> eraIndex4 BabbageEra -> eraIndex5 ConwayEra -> eraIndex6 + DijkstraEra -> eraIndex7 fromConsensusEraIndex :: () @@ -161,3 +167,5 @@ fromConsensusEraIndex = \case AnyCardanoEra BabbageEra Consensus.EraIndex (S (S (S (S (S (S (Z (K ())))))))) -> AnyCardanoEra ConwayEra + Consensus.EraIndex (S (S (S (S (S (S (S _))))))) -> + AnyCardanoEra DijkstraEra diff --git a/cardano-api/src/Cardano/Api/Consensus/Internal/Protocol.hs b/cardano-api/src/Cardano/Api/Consensus/Internal/Protocol.hs index d58167c5e9..0caeed268e 100644 --- a/cardano-api/src/Cardano/Api/Consensus/Internal/Protocol.hs +++ b/cardano-api/src/Cardano/Api/Consensus/Internal/Protocol.hs @@ -22,7 +22,7 @@ where import Cardano.Api.Consensus.Internal.Mode -import Ouroboros.Consensus.Block.Forging (BlockForging) +import Ouroboros.Consensus.Block.Forging (MkBlockForging (..)) import Ouroboros.Consensus.Byron.ByronHFC (ByronBlockHFC) import Ouroboros.Consensus.Cardano import Ouroboros.Consensus.Cardano.Block @@ -31,6 +31,7 @@ import Ouroboros.Consensus.HardFork.Combinator.Embed.Unary import Ouroboros.Consensus.Ledger.SupportsProtocol qualified as Consensus (LedgerSupportsProtocol) import Ouroboros.Consensus.Node.ProtocolInfo (ProtocolClientInfo (..), ProtocolInfo (..)) import Ouroboros.Consensus.Node.Run (RunNode) +import Ouroboros.Consensus.Protocol.Praos.AgentClient import Ouroboros.Consensus.Protocol.TPraos qualified as Consensus import Ouroboros.Consensus.Shelley.Eras qualified as Consensus (ShelleyEra) import Ouroboros.Consensus.Shelley.Ledger.Block qualified as Consensus (ShelleyBlock) @@ -38,13 +39,18 @@ import Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol () import Ouroboros.Consensus.Shelley.ShelleyHFC (ShelleyBlockHFC) import Ouroboros.Consensus.Util.IOLike (IOLike) +import Control.Tracer qualified as Tracer import Data.Bifunctor (bimap) import Type.Reflection ((:~:) (..)) class (RunNode blk, IOLike m) => Protocol m blk where data ProtocolInfoArgs blk - protocolInfo :: ProtocolInfoArgs blk -> (ProtocolInfo blk, m [BlockForging m blk]) + protocolInfo + :: ProtocolInfoArgs blk + -> ( ProtocolInfo blk + , Tracer.Tracer m KESAgentClientTrace -> m [MkBlockForging m blk] + ) -- | Node client support for each consensus protocol. -- @@ -59,10 +65,13 @@ instance IOLike m => Protocol m ByronBlockHFC where data ProtocolInfoArgs ByronBlockHFC = ProtocolInfoArgsByron ProtocolParamsByron protocolInfo (ProtocolInfoArgsByron params) = ( inject $ protocolInfoByron params - , pure . map inject $ blockForgingByron params + , \_ -> pure . map (MkBlockForging . pure . inject) $ blockForgingByron params ) -instance (CardanoHardForkConstraints StandardCrypto, IOLike m) => Protocol m (CardanoBlock StandardCrypto) where +instance + (CardanoHardForkConstraints StandardCrypto, IOLike m, MonadKESAgent m) + => Protocol m (CardanoBlock StandardCrypto) + where data ProtocolInfoArgs (CardanoBlock StandardCrypto) = ProtocolInfoArgsCardano (CardanoProtocolParams StandardCrypto) @@ -89,6 +98,7 @@ instance (Consensus.TPraos StandardCrypto) ShelleyEra ) + , MonadKESAgent m ) => Protocol m (ShelleyBlockHFC (Consensus.TPraos StandardCrypto) ShelleyEra) where @@ -98,7 +108,7 @@ instance (ProtocolParamsShelleyBased StandardCrypto) ProtVer protocolInfo (ProtocolInfoArgsShelley genesis paramsShelleyBased_ paramsShelley_) = - bimap inject (fmap $ map inject) $ + bimap inject (fmap $ fmap $ map inject) $ protocolInfoShelley genesis paramsShelleyBased_ paramsShelley_ instance diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Case.hs b/cardano-api/src/Cardano/Api/Era/Internal/Case.hs index a7049a6d6e..996bac75b1 100644 --- a/cardano-api/src/Cardano/Api/Era/Internal/Case.hs +++ b/cardano-api/src/Cardano/Api/Era/Internal/Case.hs @@ -52,6 +52,7 @@ caseByronOrShelleyBasedEra l r = \case AlonzoEra -> r ShelleyBasedEraAlonzo BabbageEra -> r ShelleyBasedEraBabbage ConwayEra -> r ShelleyBasedEraConway + DijkstraEra -> error "caseByronOrShelleyBasedEra: DijkstraEra is not supported" -- | @caseByronToAlonzoOrBabbageEraOnwards f g era@ applies @f@ to byron, shelley, allegra, mary, and alonzo; -- and @g@ to babbage and later eras. @@ -69,6 +70,7 @@ caseByronToAlonzoOrBabbageEraOnwards l r = \case AlonzoEra -> l ByronToAlonzoEraAlonzo BabbageEra -> r BabbageEraOnwardsBabbage ConwayEra -> r BabbageEraOnwardsConway + DijkstraEra -> error "caseByronToAlonzoOrBabbageEraOnwards: DijkstraEra is not supported" -- | @caseShelleyEraOnlyOrAllegraEraOnwards f g era@ applies @f@ to shelley; -- and applies @g@ to allegra and later eras. @@ -85,6 +87,7 @@ caseShelleyEraOnlyOrAllegraEraOnwards l r = \case ShelleyBasedEraAlonzo -> r AllegraEraOnwardsAlonzo ShelleyBasedEraBabbage -> r AllegraEraOnwardsBabbage ShelleyBasedEraConway -> r AllegraEraOnwardsConway + ShelleyBasedEraDijkstra -> error "caseShelleyEraOnlyOrAllegraEraOnwards: DijkstraEra is not supported" -- | @caseShelleyToAllegraOrMaryEraOnwards f g era@ applies @f@ to shelley and allegra; -- and applies @g@ to mary and later eras. @@ -101,6 +104,7 @@ caseShelleyToAllegraOrMaryEraOnwards l r = \case ShelleyBasedEraAlonzo -> r MaryEraOnwardsAlonzo ShelleyBasedEraBabbage -> r MaryEraOnwardsBabbage ShelleyBasedEraConway -> r MaryEraOnwardsConway + ShelleyBasedEraDijkstra -> error "caseShelleyToAllegraOrMaryEraOnwards: DijkstraEra is not supported" -- | @caseShelleyToMaryOrAlonzoEraOnwards f g era@ applies @f@ to shelley, allegra, and mary; -- and applies @g@ to alonzo and later eras. @@ -117,6 +121,7 @@ caseShelleyToMaryOrAlonzoEraOnwards l r = \case ShelleyBasedEraAlonzo -> r AlonzoEraOnwardsAlonzo ShelleyBasedEraBabbage -> r AlonzoEraOnwardsBabbage ShelleyBasedEraConway -> r AlonzoEraOnwardsConway + ShelleyBasedEraDijkstra -> error "caseShelleyToMaryOrAlonzoEraOnwards: DijkstraEra is not supported" -- | @caseShelleyToAlonzoOrBabbageEraOnwards f g era@ applies @f@ to shelley, allegra, mary, and alonzo; -- and applies @g@ to babbage and later eras. @@ -133,6 +138,7 @@ caseShelleyToAlonzoOrBabbageEraOnwards l r = \case ShelleyBasedEraAlonzo -> l ShelleyToAlonzoEraAlonzo ShelleyBasedEraBabbage -> r BabbageEraOnwardsBabbage ShelleyBasedEraConway -> r BabbageEraOnwardsConway + ShelleyBasedEraDijkstra -> error "caseShelleyToAlonzoOrBabbageEraOnwards: DijkstraEra is not supported" -- | @caseShelleyToBabbageOrConwayEraOnwards f g era@ applies @f@ to eras before conway; -- and applies @g@ to conway and later eras. @@ -149,6 +155,7 @@ caseShelleyToBabbageOrConwayEraOnwards l r = \case ShelleyBasedEraAlonzo -> l ShelleyToBabbageEraAlonzo ShelleyBasedEraBabbage -> l ShelleyToBabbageEraBabbage ShelleyBasedEraConway -> r ConwayEraOnwardsConway + ShelleyBasedEraDijkstra -> error "caseShelleyToBabbageOrConwayEraOnwards: DijkstraEra is not supported" {-# DEPRECATED shelleyToAlonzoEraToShelleyToBabbageEra "Use convert instead" #-} shelleyToAlonzoEraToShelleyToBabbageEra @@ -170,6 +177,7 @@ alonzoEraOnwardsToMaryEraOnwards = \case AlonzoEraOnwardsAlonzo -> MaryEraOnwardsAlonzo AlonzoEraOnwardsBabbage -> MaryEraOnwardsBabbage AlonzoEraOnwardsConway -> MaryEraOnwardsConway + AlonzoEraOnwardsDijkstra -> MaryEraOnwardsDijkstra {-# DEPRECATED babbageEraOnwardsToMaryEraOnwards "Use convert instead" #-} babbageEraOnwardsToMaryEraOnwards @@ -179,6 +187,7 @@ babbageEraOnwardsToMaryEraOnwards babbageEraOnwardsToMaryEraOnwards = \case BabbageEraOnwardsBabbage -> MaryEraOnwardsBabbage BabbageEraOnwardsConway -> MaryEraOnwardsConway + BabbageEraOnwardsDijkstra -> MaryEraOnwardsDijkstra {-# DEPRECATED babbageEraOnwardsToAlonzoEraOnwards "Use convert instead" #-} babbageEraOnwardsToAlonzoEraOnwards @@ -188,3 +197,4 @@ babbageEraOnwardsToAlonzoEraOnwards babbageEraOnwardsToAlonzoEraOnwards = \case BabbageEraOnwardsBabbage -> AlonzoEraOnwardsBabbage BabbageEraOnwardsConway -> AlonzoEraOnwardsConway + BabbageEraOnwardsDijkstra -> AlonzoEraOnwardsDijkstra diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Core.hs b/cardano-api/src/Cardano/Api/Era/Internal/Core.hs index bc6dadeca4..1594f882c4 100644 --- a/cardano-api/src/Cardano/Api/Era/Internal/Core.hs +++ b/cardano-api/src/Cardano/Api/Era/Internal/Core.hs @@ -19,6 +19,7 @@ module Cardano.Api.Era.Internal.Core , AlonzoEra , BabbageEra , ConwayEra + , DijkstraEra -- * CardanoEra , CardanoEra (..) @@ -87,6 +88,9 @@ data BabbageEra -- | A type used as a tag to distinguish the Conway era. data ConwayEra +-- | A type used as a tag to distinguish the DijkstraEra era. +data DijkstraEra + instance HasTypeProxy ByronEra where data AsType ByronEra = AsByronEra proxyToAsType _ = AsByronEra @@ -115,6 +119,10 @@ instance HasTypeProxy ConwayEra where data AsType ConwayEra = AsConwayEra proxyToAsType _ = AsConwayEra +instance HasTypeProxy DijkstraEra where + data AsType DijkstraEra = AsDijkstraEra + proxyToAsType _ = AsDijkstraEra + -- ---------------------------------------------------------------------------- -- Eon @@ -263,6 +271,7 @@ data CardanoEra era where AlonzoEra :: CardanoEra AlonzoEra BabbageEra :: CardanoEra BabbageEra ConwayEra :: CardanoEra ConwayEra + DijkstraEra :: CardanoEra DijkstraEra -- when you add era here, change `instance Bounded AnyCardanoEra` @@ -321,6 +330,9 @@ instance IsCardanoEra BabbageEra where instance IsCardanoEra ConwayEra where cardanoEra = ConwayEra +instance IsCardanoEra DijkstraEra where + cardanoEra = DijkstraEra + type CardanoEraConstraints era = ( Typeable era , IsCardanoEra era @@ -339,6 +351,7 @@ cardanoEraConstraints = \case AlonzoEra -> id BabbageEra -> id ConwayEra -> id + DijkstraEra -> id data AnyCardanoEra where AnyCardanoEra @@ -372,6 +385,7 @@ instance Enum AnyCardanoEra where AnyCardanoEra AlonzoEra -> 4 AnyCardanoEra BabbageEra -> 5 AnyCardanoEra ConwayEra -> 6 + AnyCardanoEra DijkstraEra -> 7 toEnum = \case 0 -> AnyCardanoEra ByronEra @@ -409,6 +423,7 @@ cardanoEraToStringLike = \case AlonzoEra -> "Alonzo" BabbageEra -> "Babbage" ConwayEra -> "Conway" + DijkstraEra -> "Dijkstra" anyCardanoEraFromStringLike :: (IsString a, Eq a) => a -> Either a AnyCardanoEra {-# INLINE anyCardanoEraFromStringLike #-} @@ -433,6 +448,7 @@ anyCardanoEra = \case AlonzoEra -> AnyCardanoEra AlonzoEra BabbageEra -> AnyCardanoEra BabbageEra ConwayEra -> AnyCardanoEra ConwayEra + DijkstraEra -> AnyCardanoEra DijkstraEra -- | 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 diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Eon/AllegraEraOnwards.hs b/cardano-api/src/Cardano/Api/Era/Internal/Eon/AllegraEraOnwards.hs index 709c3fee0a..4f05537032 100644 --- a/cardano-api/src/Cardano/Api/Era/Internal/Eon/AllegraEraOnwards.hs +++ b/cardano-api/src/Cardano/Api/Era/Internal/Eon/AllegraEraOnwards.hs @@ -46,6 +46,7 @@ data AllegraEraOnwards era where AllegraEraOnwardsAlonzo :: AllegraEraOnwards AlonzoEra AllegraEraOnwardsBabbage :: AllegraEraOnwards BabbageEra AllegraEraOnwardsConway :: AllegraEraOnwards ConwayEra + AllegraEraOnwardsDijkstra :: AllegraEraOnwards DijkstraEra deriving instance Show (AllegraEraOnwards era) @@ -60,6 +61,7 @@ instance Eon AllegraEraOnwards where AlonzoEra -> yes AllegraEraOnwardsAlonzo BabbageEra -> yes AllegraEraOnwardsBabbage ConwayEra -> yes AllegraEraOnwardsConway + DijkstraEra -> yes AllegraEraOnwardsDijkstra instance ToCardanoEra AllegraEraOnwards where toCardanoEra = \case @@ -68,6 +70,7 @@ instance ToCardanoEra AllegraEraOnwards where AllegraEraOnwardsAlonzo -> AlonzoEra AllegraEraOnwardsBabbage -> BabbageEra AllegraEraOnwardsConway -> ConwayEra + AllegraEraOnwardsDijkstra -> DijkstraEra instance Convert AllegraEraOnwards CardanoEra where convert = toCardanoEra @@ -79,6 +82,7 @@ instance Convert AllegraEraOnwards ShelleyBasedEra where AllegraEraOnwardsAlonzo -> ShelleyBasedEraAlonzo AllegraEraOnwardsBabbage -> ShelleyBasedEraBabbage AllegraEraOnwardsConway -> ShelleyBasedEraConway + AllegraEraOnwardsDijkstra -> ShelleyBasedEraDijkstra type AllegraEraOnwardsConstraints era = ( C.HashAlgorithm L.HASH @@ -116,6 +120,7 @@ allegraEraOnwardsConstraints = \case AllegraEraOnwardsAlonzo -> id AllegraEraOnwardsBabbage -> id AllegraEraOnwardsConway -> id + _ -> const $ error "allegraEraOnwardsConstraints: Dijkstra era not supported" {-# DEPRECATED allegraEraOnwardsToShelleyBasedEra "Use 'convert' instead." #-} allegraEraOnwardsToShelleyBasedEra :: AllegraEraOnwards era -> ShelleyBasedEra era diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Eon/AlonzoEraOnwards.hs b/cardano-api/src/Cardano/Api/Era/Internal/Eon/AlonzoEraOnwards.hs index 5c688eeac0..d48f1fa643 100644 --- a/cardano-api/src/Cardano/Api/Era/Internal/Eon/AlonzoEraOnwards.hs +++ b/cardano-api/src/Cardano/Api/Era/Internal/Eon/AlonzoEraOnwards.hs @@ -53,6 +53,7 @@ data AlonzoEraOnwards era where AlonzoEraOnwardsAlonzo :: AlonzoEraOnwards AlonzoEra AlonzoEraOnwardsBabbage :: AlonzoEraOnwards BabbageEra AlonzoEraOnwardsConway :: AlonzoEraOnwards ConwayEra + AlonzoEraOnwardsDijkstra :: AlonzoEraOnwards DijkstraEra deriving instance Show (AlonzoEraOnwards era) @@ -67,12 +68,14 @@ instance Eon AlonzoEraOnwards where AlonzoEra -> yes AlonzoEraOnwardsAlonzo BabbageEra -> yes AlonzoEraOnwardsBabbage ConwayEra -> yes AlonzoEraOnwardsConway + DijkstraEra -> yes AlonzoEraOnwardsDijkstra instance ToCardanoEra AlonzoEraOnwards where toCardanoEra = \case AlonzoEraOnwardsAlonzo -> AlonzoEra AlonzoEraOnwardsBabbage -> BabbageEra AlonzoEraOnwardsConway -> ConwayEra + AlonzoEraOnwardsDijkstra -> DijkstraEra instance Convert AlonzoEraOnwards CardanoEra where convert = toCardanoEra @@ -82,6 +85,7 @@ instance Convert AlonzoEraOnwards ShelleyBasedEra where AlonzoEraOnwardsAlonzo -> ShelleyBasedEraAlonzo AlonzoEraOnwardsBabbage -> ShelleyBasedEraBabbage AlonzoEraOnwardsConway -> ShelleyBasedEraConway + AlonzoEraOnwardsDijkstra -> ShelleyBasedEraDijkstra type AlonzoEraOnwardsConstraints era = ( C.HashAlgorithm L.HASH @@ -127,6 +131,7 @@ alonzoEraOnwardsConstraints = \case AlonzoEraOnwardsAlonzo -> id AlonzoEraOnwardsBabbage -> id AlonzoEraOnwardsConway -> id + AlonzoEraOnwardsDijkstra -> const $ error "alonzoEraOnwardsConstraints: Dijkstra era not yet supported" {-# DEPRECATED alonzoEraOnwardsToShelleyBasedEra "Use 'convert' instead." #-} alonzoEraOnwardsToShelleyBasedEra :: AlonzoEraOnwards era -> ShelleyBasedEra era diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Eon/BabbageEraOnwards.hs b/cardano-api/src/Cardano/Api/Era/Internal/Eon/BabbageEraOnwards.hs index de9d823caa..09c7ca6e60 100644 --- a/cardano-api/src/Cardano/Api/Era/Internal/Eon/BabbageEraOnwards.hs +++ b/cardano-api/src/Cardano/Api/Era/Internal/Eon/BabbageEraOnwards.hs @@ -51,6 +51,7 @@ import Data.Typeable (Typeable) data BabbageEraOnwards era where BabbageEraOnwardsBabbage :: BabbageEraOnwards BabbageEra BabbageEraOnwardsConway :: BabbageEraOnwards ConwayEra + BabbageEraOnwardsDijkstra :: BabbageEraOnwards DijkstraEra deriving instance Show (BabbageEraOnwards era) @@ -65,11 +66,13 @@ instance Eon BabbageEraOnwards where AlonzoEra -> no BabbageEra -> yes BabbageEraOnwardsBabbage ConwayEra -> yes BabbageEraOnwardsConway + DijkstraEra -> yes BabbageEraOnwardsDijkstra instance ToCardanoEra BabbageEraOnwards where toCardanoEra = \case BabbageEraOnwardsBabbage -> BabbageEra BabbageEraOnwardsConway -> ConwayEra + BabbageEraOnwardsDijkstra -> DijkstraEra instance Convert BabbageEraOnwards CardanoEra where convert = toCardanoEra @@ -78,16 +81,19 @@ instance Convert BabbageEraOnwards ShelleyBasedEra where convert = \case BabbageEraOnwardsBabbage -> ShelleyBasedEraBabbage BabbageEraOnwardsConway -> ShelleyBasedEraConway + BabbageEraOnwardsDijkstra -> ShelleyBasedEraDijkstra instance Convert BabbageEraOnwards MaryEraOnwards where convert = \case BabbageEraOnwardsBabbage -> MaryEraOnwardsBabbage BabbageEraOnwardsConway -> MaryEraOnwardsConway + BabbageEraOnwardsDijkstra -> MaryEraOnwardsDijkstra instance Convert BabbageEraOnwards AlonzoEraOnwards where convert = \case BabbageEraOnwardsBabbage -> AlonzoEraOnwardsBabbage BabbageEraOnwardsConway -> AlonzoEraOnwardsConway + BabbageEraOnwardsDijkstra -> AlonzoEraOnwardsDijkstra type BabbageEraOnwardsConstraints era = ( C.HashAlgorithm L.HASH @@ -131,6 +137,7 @@ babbageEraOnwardsConstraints babbageEraOnwardsConstraints = \case BabbageEraOnwardsBabbage -> id BabbageEraOnwardsConway -> id + BabbageEraOnwardsDijkstra -> const $ error "babbageEraOnwardsConstraints: DijkstraEra is currently not supported" {-# DEPRECATED babbageEraOnwardsToShelleyBasedEra "Use 'convert' instead." #-} babbageEraOnwardsToShelleyBasedEra :: BabbageEraOnwards era -> ShelleyBasedEra era diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ByronToAlonzoEra.hs b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ByronToAlonzoEra.hs index e5b31553cb..318ea303df 100644 --- a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ByronToAlonzoEra.hs +++ b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ByronToAlonzoEra.hs @@ -40,6 +40,7 @@ instance Eon ByronToAlonzoEra where AlonzoEra -> yes ByronToAlonzoEraAlonzo BabbageEra -> no ConwayEra -> no + DijkstraEra -> no instance ToCardanoEra ByronToAlonzoEra where toCardanoEra = \case diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ConwayEraOnwards.hs b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ConwayEraOnwards.hs index b2f2139e15..a759d36a2f 100644 --- a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ConwayEraOnwards.hs +++ b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ConwayEraOnwards.hs @@ -38,9 +38,9 @@ import Cardano.Ledger.Api qualified as L import Cardano.Ledger.BaseTypes qualified as L import Cardano.Ledger.Conway.Core qualified as L import Cardano.Ledger.Conway.Governance qualified as L +import Cardano.Ledger.Conway.State qualified as L import Cardano.Ledger.Conway.TxCert qualified as L import Cardano.Ledger.Mary.Value qualified as L -import Cardano.Ledger.State qualified as L import Cardano.Protocol.Crypto qualified as L import Ouroboros.Consensus.Protocol.Abstract qualified as Consensus import Ouroboros.Consensus.Protocol.Praos.Common qualified as Consensus @@ -52,6 +52,7 @@ import Data.Typeable (Typeable) data ConwayEraOnwards era where ConwayEraOnwardsConway :: ConwayEraOnwards ConwayEra + ConwayEraOnwardsDijkstra :: ConwayEraOnwards DijkstraEra deriving instance Show (ConwayEraOnwards era) @@ -68,10 +69,12 @@ instance Eon ConwayEraOnwards where AlonzoEra -> no BabbageEra -> no ConwayEra -> yes ConwayEraOnwardsConway + DijkstraEra -> yes ConwayEraOnwardsDijkstra instance ToCardanoEra ConwayEraOnwards where toCardanoEra = \case ConwayEraOnwardsConway -> ConwayEra + ConwayEraOnwardsDijkstra -> DijkstraEra instance Convert ConwayEraOnwards CardanoEra where convert = toCardanoEra @@ -79,20 +82,25 @@ instance Convert ConwayEraOnwards CardanoEra where instance Convert ConwayEraOnwards ShelleyBasedEra where convert = \case ConwayEraOnwardsConway -> ShelleyBasedEraConway + ConwayEraOnwardsDijkstra -> ShelleyBasedEraDijkstra instance Convert ConwayEraOnwards AllegraEraOnwards where convert = \case ConwayEraOnwardsConway -> AllegraEraOnwardsConway + ConwayEraOnwardsDijkstra -> AllegraEraOnwardsDijkstra instance Convert ConwayEraOnwards AlonzoEraOnwards where convert ConwayEraOnwardsConway = AlonzoEraOnwardsConway + convert ConwayEraOnwardsDijkstra = AlonzoEraOnwardsDijkstra instance Convert ConwayEraOnwards BabbageEraOnwards where convert = \case ConwayEraOnwardsConway -> BabbageEraOnwardsConway + ConwayEraOnwardsDijkstra -> BabbageEraOnwardsDijkstra type ConwayEraOnwardsConstraints era = - ( C.HashAlgorithm L.HASH + ( L.ConwayEraCertState (ShelleyLedgerEra era) + , C.HashAlgorithm L.HASH , C.Signable (L.VRF L.StandardCrypto) L.Seed , Consensus.PraosProtocolSupportsNode (ConsensusProtocol era) , Consensus.ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era) ~ ConsensusBlockForEra era @@ -137,6 +145,7 @@ conwayEraOnwardsConstraints -> a conwayEraOnwardsConstraints = \case ConwayEraOnwardsConway -> id + _ -> const $ error "conwayEraOnwardsConstraints: Dijkstra era is not yet supported" {-# DEPRECATED conwayEraOnwardsToShelleyBasedEra "Use 'convert' instead." #-} conwayEraOnwardsToShelleyBasedEra :: ConwayEraOnwards era -> ShelleyBasedEra era diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Eon/MaryEraOnwards.hs b/cardano-api/src/Cardano/Api/Era/Internal/Eon/MaryEraOnwards.hs index 2e93bca9fe..076f6b7b78 100644 --- a/cardano-api/src/Cardano/Api/Era/Internal/Eon/MaryEraOnwards.hs +++ b/cardano-api/src/Cardano/Api/Era/Internal/Eon/MaryEraOnwards.hs @@ -48,6 +48,7 @@ data MaryEraOnwards era where MaryEraOnwardsAlonzo :: MaryEraOnwards AlonzoEra MaryEraOnwardsBabbage :: MaryEraOnwards BabbageEra MaryEraOnwardsConway :: MaryEraOnwards ConwayEra + MaryEraOnwardsDijkstra :: MaryEraOnwards DijkstraEra deriving instance Show (MaryEraOnwards era) @@ -62,6 +63,7 @@ instance Eon MaryEraOnwards where AlonzoEra -> yes MaryEraOnwardsAlonzo BabbageEra -> yes MaryEraOnwardsBabbage ConwayEra -> yes MaryEraOnwardsConway + DijkstraEra -> yes MaryEraOnwardsDijkstra instance ToCardanoEra MaryEraOnwards where toCardanoEra = \case @@ -69,6 +71,7 @@ instance ToCardanoEra MaryEraOnwards where MaryEraOnwardsAlonzo -> AlonzoEra MaryEraOnwardsBabbage -> BabbageEra MaryEraOnwardsConway -> ConwayEra + MaryEraOnwardsDijkstra -> DijkstraEra instance Convert MaryEraOnwards CardanoEra where convert = toCardanoEra @@ -79,6 +82,7 @@ instance Convert MaryEraOnwards ShelleyBasedEra where MaryEraOnwardsAlonzo -> ShelleyBasedEraAlonzo MaryEraOnwardsBabbage -> ShelleyBasedEraBabbage MaryEraOnwardsConway -> ShelleyBasedEraConway + MaryEraOnwardsDijkstra -> ShelleyBasedEraDijkstra type MaryEraOnwardsConstraints era = ( C.HashAlgorithm L.HASH @@ -117,6 +121,7 @@ maryEraOnwardsConstraints = \case MaryEraOnwardsAlonzo -> id MaryEraOnwardsBabbage -> id MaryEraOnwardsConway -> id + MaryEraOnwardsDijkstra -> const $ error "maryEraOnwardsConstraints: Dijkstra era is not yet supported" {-# DEPRECATED maryEraOnwardsToShelleyBasedEra "Use 'convert' instead." #-} maryEraOnwardsToShelleyBasedEra :: MaryEraOnwards era -> ShelleyBasedEra era diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyBasedEra.hs b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyBasedEra.hs index 08ecceca08..dc66a8233b 100644 --- a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyBasedEra.hs +++ b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyBasedEra.hs @@ -129,6 +129,7 @@ data ShelleyBasedEra era where ShelleyBasedEraAlonzo :: ShelleyBasedEra AlonzoEra ShelleyBasedEraBabbage :: ShelleyBasedEra BabbageEra ShelleyBasedEraConway :: ShelleyBasedEra ConwayEra + ShelleyBasedEraDijkstra :: ShelleyBasedEra DijkstraEra instance NFData (ShelleyBasedEra era) where rnf = \case @@ -138,6 +139,7 @@ instance NFData (ShelleyBasedEra era) where ShelleyBasedEraAlonzo -> () ShelleyBasedEraBabbage -> () ShelleyBasedEraConway -> () + ShelleyBasedEraDijkstra -> () deriving instance Eq (ShelleyBasedEra era) @@ -169,6 +171,7 @@ instance Eon ShelleyBasedEra where AlonzoEra -> yes ShelleyBasedEraAlonzo BabbageEra -> yes ShelleyBasedEraBabbage ConwayEra -> yes ShelleyBasedEraConway + DijkstraEra -> yes ShelleyBasedEraDijkstra instance ToCardanoEra ShelleyBasedEra where toCardanoEra = \case @@ -178,6 +181,7 @@ instance ToCardanoEra ShelleyBasedEra where ShelleyBasedEraAlonzo -> AlonzoEra ShelleyBasedEraBabbage -> BabbageEra ShelleyBasedEraConway -> ConwayEra + ShelleyBasedEraDijkstra -> DijkstraEra instance Convert ShelleyBasedEra CardanoEra where convert = toCardanoEra @@ -206,6 +210,9 @@ instance IsShelleyBasedEra BabbageEra where instance IsShelleyBasedEra ConwayEra where shelleyBasedEra = ShelleyBasedEraConway +instance IsShelleyBasedEra DijkstraEra where + shelleyBasedEra = ShelleyBasedEraDijkstra + type ShelleyBasedEraConstraints era = ( C.HashAlgorithm L.HASH , C.Signable (L.VRF L.StandardCrypto) L.Seed @@ -248,6 +255,7 @@ shelleyBasedEraConstraints = \case ShelleyBasedEraAlonzo -> id ShelleyBasedEraBabbage -> id ShelleyBasedEraConway -> id + ShelleyBasedEraDijkstra -> const $ error "shelleyBasedEraConstraints: Dijkstra is not yet supported" data AnyShelleyBasedEra where AnyShelleyBasedEra @@ -277,6 +285,7 @@ instance Enum AnyShelleyBasedEra where AnyShelleyBasedEra ShelleyBasedEraAlonzo -> 4 AnyShelleyBasedEra ShelleyBasedEraBabbage -> 5 AnyShelleyBasedEra ShelleyBasedEraConway -> 6 + AnyShelleyBasedEra ShelleyBasedEraDijkstra -> 7 toEnum = \case 1 -> AnyShelleyBasedEra ShelleyBasedEraShelley @@ -340,6 +349,7 @@ type family ShelleyLedgerEra era = ledgerera | ledgerera -> era where ShelleyLedgerEra AlonzoEra = L.AlonzoEra ShelleyLedgerEra BabbageEra = L.BabbageEra ShelleyLedgerEra ConwayEra = L.ConwayEra + ShelleyLedgerEra DijkstraEra = L.DijkstraEra -- | Lookup the lower major protocol version for the shelley based era. In other words -- this is the major protocol version that the era has started in. @@ -351,6 +361,7 @@ eraProtVerLow = \case ShelleyBasedEraAlonzo -> L.eraProtVerLow @L.AlonzoEra ShelleyBasedEraBabbage -> L.eraProtVerLow @L.BabbageEra ShelleyBasedEraConway -> L.eraProtVerLow @L.ConwayEra + ShelleyBasedEraDijkstra -> L.eraProtVerLow @L.DijkstraEra requireShelleyBasedEra :: () diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyEraOnly.hs b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyEraOnly.hs index cdbc90c9db..8e5d76de09 100644 --- a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyEraOnly.hs +++ b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyEraOnly.hs @@ -57,6 +57,7 @@ instance Eon ShelleyEraOnly where AlonzoEra -> no BabbageEra -> no ConwayEra -> no + DijkstraEra -> no instance ToCardanoEra ShelleyEraOnly where toCardanoEra = \case diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToAllegraEra.hs b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToAllegraEra.hs index 73ebb6fb06..529487624c 100644 --- a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToAllegraEra.hs +++ b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToAllegraEra.hs @@ -59,6 +59,7 @@ instance Eon ShelleyToAllegraEra where AlonzoEra -> no BabbageEra -> no ConwayEra -> no + DijkstraEra -> no instance ToCardanoEra ShelleyToAllegraEra where toCardanoEra = \case diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToAlonzoEra.hs b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToAlonzoEra.hs index 9d7c425cb2..8c38e43e91 100644 --- a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToAlonzoEra.hs +++ b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToAlonzoEra.hs @@ -59,6 +59,7 @@ instance Eon ShelleyToAlonzoEra where AlonzoEra -> yes ShelleyToAlonzoEraAlonzo BabbageEra -> no ConwayEra -> no + DijkstraEra -> no instance ToCardanoEra ShelleyToAlonzoEra where toCardanoEra = \case diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToBabbageEra.hs b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToBabbageEra.hs index f40f67799b..0eede2a88d 100644 --- a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToBabbageEra.hs +++ b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToBabbageEra.hs @@ -62,6 +62,7 @@ instance Eon ShelleyToBabbageEra where AlonzoEra -> yes ShelleyToBabbageEraAlonzo BabbageEra -> yes ShelleyToBabbageEraBabbage ConwayEra -> no + DijkstraEra -> no instance ToCardanoEra ShelleyToBabbageEra where toCardanoEra = \case diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToMaryEra.hs b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToMaryEra.hs index ed504a4783..c8219bdd5a 100644 --- a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToMaryEra.hs +++ b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToMaryEra.hs @@ -59,6 +59,7 @@ instance Eon ShelleyToMaryEra where AlonzoEra -> no BabbageEra -> no ConwayEra -> no + DijkstraEra -> no instance ToCardanoEra ShelleyToMaryEra where toCardanoEra = \case diff --git a/cardano-api/src/Cardano/Api/Experimental/Era.hs b/cardano-api/src/Cardano/Api/Experimental/Era.hs index 8c1c87fe32..8effb65f7d 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Era.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Era.hs @@ -26,6 +26,7 @@ module Cardano.Api.Experimental.Era , DeprecatedEra (..) , EraCommonConstraints , obtainCommonConstraints + , obtainConwayConstraints , eraToSbe , eraToBabbageEraOnwards , sbeToEra @@ -34,7 +35,7 @@ where import Cardano.Api.Consensus import Cardano.Api.Era qualified as Api -import Cardano.Api.Era.Internal.Core (BabbageEra, ConwayEra, Eon (..)) +import Cardano.Api.Era.Internal.Core (BabbageEra, ConwayEra, DijkstraEra, Eon (..)) import Cardano.Api.Era.Internal.Eon.AlonzoEraOnwards import Cardano.Api.Era.Internal.Eon.BabbageEraOnwards import Cardano.Api.Era.Internal.Eon.Convert @@ -70,6 +71,7 @@ import Prettyprinter -- and the next (upcoming) era. type family LedgerEra era = (r :: Type) | r -> era where LedgerEra ConwayEra = Ledger.ConwayEra + LedgerEra DijkstraEra = L.DijkstraEra -- | An existential wrapper for types of kind @k -> Type@. It can hold any -- era, for example, @Some Era@. The era witness can be brought back into scope, @@ -98,6 +100,7 @@ data Some (f :: k -> Type) where data Era era where -- | The currently active era on the Cardano mainnet. ConwayEra :: Era ConwayEra + DijkstraEra :: Era DijkstraEra deriving instance Show (Era era) @@ -108,6 +111,8 @@ instance Pretty (Era era) where instance TestEquality Era where testEquality ConwayEra ConwayEra = Just Refl + testEquality DijkstraEra DijkstraEra = Just Refl + testEquality _ _ = Nothing instance ToJSON (Era era) where toJSON = eraToStringLike @@ -126,6 +131,7 @@ instance Enum (Some Era) where toEnum 0 = Some ConwayEra toEnum i = error $ "Enum.toEnum: invalid argument " <> show i <> " - does not correspond to any era" fromEnum (Some ConwayEra) = 0 + fromEnum (Some DijkstraEra) = 1 instance Ord (Some Era) where compare e1 e2 = compare (fromEnum e1) (fromEnum e2) @@ -155,16 +161,19 @@ instance Eon Era where instance Api.ToCardanoEra Era where toCardanoEra = \case ConwayEra -> Api.ConwayEra + DijkstraEra -> Api.DijkstraEra eraToStringLike :: IsString a => Era era -> a {-# INLINE eraToStringLike #-} eraToStringLike = \case ConwayEra -> "Conway" + DijkstraEra -> "Dijkstra" eraFromStringLike :: (IsString a, Eq a) => a -> Either a (Some Era) {-# INLINE eraFromStringLike #-} eraFromStringLike = \case "Conway" -> pure $ Some ConwayEra + "Dijkstra" -> pure $ Some DijkstraEra wrong -> Left wrong -- | How to deprecate an era: @@ -205,30 +214,37 @@ eraToSbe = convert instance Convert Era Api.CardanoEra where convert = \case ConwayEra -> Api.ConwayEra + DijkstraEra -> Api.DijkstraEra instance Convert Era ShelleyBasedEra where convert = \case ConwayEra -> ShelleyBasedEraConway + DijkstraEra -> ShelleyBasedEraDijkstra instance Convert Era AlonzoEraOnwards where convert = \case ConwayEra -> AlonzoEraOnwardsConway + DijkstraEra -> AlonzoEraOnwardsDijkstra instance Convert Era BabbageEraOnwards where convert = \case ConwayEra -> BabbageEraOnwardsConway + DijkstraEra -> BabbageEraOnwardsDijkstra instance Convert Era MaryEraOnwards where convert = \case ConwayEra -> MaryEraOnwardsConway + DijkstraEra -> MaryEraOnwardsDijkstra instance Convert Era ConwayEraOnwards where convert = \case ConwayEra -> ConwayEraOnwardsConway + DijkstraEra -> ConwayEraOnwardsDijkstra instance Convert ConwayEraOnwards Era where convert = \case ConwayEraOnwardsConway -> ConwayEra + ConwayEraOnwardsDijkstra -> DijkstraEra newtype DeprecatedEra era = DeprecatedEra (ShelleyBasedEra era) @@ -245,6 +261,7 @@ sbeToEra => ShelleyBasedEra era -> m (Era era) sbeToEra ShelleyBasedEraConway = return ConwayEra +sbeToEra ShelleyBasedEraDijkstra = return DijkstraEra sbeToEra e@ShelleyBasedEraBabbage = throwError $ DeprecatedEra e sbeToEra e@ShelleyBasedEraAlonzo = throwError $ DeprecatedEra e sbeToEra e@ShelleyBasedEraMary = throwError $ DeprecatedEra e @@ -264,19 +281,27 @@ class IsEra era where instance IsEra ConwayEra where useEra = ConwayEra +instance IsEra DijkstraEra where + useEra = DijkstraEra + obtainCommonConstraints :: Era era -> (EraCommonConstraints era => a) -> a -obtainCommonConstraints ConwayEra x = x +obtainCommonConstraints = \case + ConwayEra -> id + DijkstraEra -> id + +obtainConwayConstraints :: Era ConwayEra -> (EraConwayConstraints => a) -> a +obtainConwayConstraints ConwayEra a = a type EraCommonConstraints era = ( L.AllegraEraScript (LedgerEra era) , L.AlonzoEraTx (LedgerEra era) , L.BabbageEraPParams (LedgerEra era) , L.BabbageEraTxBody (LedgerEra era) + , L.ConwayEraTxBody (LedgerEra era) , L.ConwayEraTxCert (LedgerEra era) - , L.TxCert (LedgerEra era) ~ L.ConwayTxCert (LedgerEra era) , L.Era (LedgerEra era) , L.EraScript (LedgerEra era) , L.EraTx (LedgerEra era) @@ -286,7 +311,6 @@ type EraCommonConstraints era = , FromCBOR (ChainDepState (ConsensusProtocol era)) , L.NativeScript (LedgerEra era) ~ L.Timelock (LedgerEra era) , PraosProtocolSupportsNode (ConsensusProtocol era) - , L.ShelleyEraTxCert (LedgerEra era) , ShelleyLedgerEra era ~ LedgerEra era , ToJSON (ChainDepState (ConsensusProtocol era)) , L.HashAnnotated (Ledger.TxBody (LedgerEra era)) L.EraIndependentTxBody @@ -294,3 +318,9 @@ type EraCommonConstraints era = , Api.IsShelleyBasedEra era , IsEra era ) + +type EraConwayConstraints = + ( EraCommonConstraints ConwayEra + , L.TxCert (LedgerEra ConwayEra) ~ L.ConwayTxCert (LedgerEra ConwayEra) + , L.ShelleyEraTxCert (LedgerEra ConwayEra) + ) diff --git a/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/IndexedPlutusScriptWitness.hs b/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/IndexedPlutusScriptWitness.hs index c0c5d1530c..12a2206a07 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/IndexedPlutusScriptWitness.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/IndexedPlutusScriptWitness.hs @@ -211,3 +211,4 @@ obtainAlonzoScriptPurposeConstraints v = AlonzoEraOnwardsAlonzo -> id AlonzoEraOnwardsBabbage -> id AlonzoEraOnwardsConway -> id + AlonzoEraOnwardsDijkstra -> id diff --git a/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/ScriptWitness.hs b/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/ScriptWitness.hs index 668be236cc..085c292a7c 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/ScriptWitness.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/ScriptWitness.hs @@ -74,6 +74,7 @@ getPlutusScriptWitnessLanguage (PlutusScriptWitness l _ _ _ _) = L.SPlutusV1 -> L.plutusLanguage l L.SPlutusV2 -> L.plutusLanguage l L.SPlutusV3 -> L.plutusLanguage l + L.SPlutusV4 -> L.plutusLanguage l -- | Every Plutus script has a purpose that indicates -- what that script is witnessing. @@ -100,21 +101,27 @@ type family PlutusScriptDatumF (lang :: L.Language) (purpose :: PlutusScriptPurp PlutusScriptDatumF L.PlutusV1 SpendingScript = HashableScriptData PlutusScriptDatumF L.PlutusV2 SpendingScript = HashableScriptData PlutusScriptDatumF L.PlutusV3 SpendingScript = Maybe HashableScriptData -- CIP-69 + PlutusScriptDatumF L.PlutusV4 SpendingScript = Maybe HashableScriptData -- CIP-69 PlutusScriptDatumF L.PlutusV1 MintingScript = NoScriptDatum PlutusScriptDatumF L.PlutusV2 MintingScript = NoScriptDatum PlutusScriptDatumF L.PlutusV3 MintingScript = NoScriptDatum + PlutusScriptDatumF L.PlutusV4 MintingScript = NoScriptDatum PlutusScriptDatumF L.PlutusV1 WithdrawingScript = NoScriptDatum PlutusScriptDatumF L.PlutusV2 WithdrawingScript = NoScriptDatum PlutusScriptDatumF L.PlutusV3 WithdrawingScript = NoScriptDatum + PlutusScriptDatumF L.PlutusV4 WithdrawingScript = NoScriptDatum PlutusScriptDatumF L.PlutusV1 CertifyingScript = NoScriptDatum PlutusScriptDatumF L.PlutusV2 CertifyingScript = NoScriptDatum PlutusScriptDatumF L.PlutusV3 CertifyingScript = NoScriptDatum + PlutusScriptDatumF L.PlutusV4 CertifyingScript = NoScriptDatum PlutusScriptDatumF L.PlutusV1 ProposingScript = NoScriptDatum PlutusScriptDatumF L.PlutusV2 ProposingScript = NoScriptDatum PlutusScriptDatumF L.PlutusV3 ProposingScript = NoScriptDatum + PlutusScriptDatumF L.PlutusV4 ProposingScript = NoScriptDatum PlutusScriptDatumF L.PlutusV1 VotingScript = NoScriptDatum PlutusScriptDatumF L.PlutusV2 VotingScript = NoScriptDatum PlutusScriptDatumF L.PlutusV3 VotingScript = NoScriptDatum + PlutusScriptDatumF L.PlutusV4 VotingScript = NoScriptDatum data PlutusScriptDatum (lang :: L.Language) (purpose :: PlutusScriptPurpose) where SpendingScriptDatum diff --git a/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/Shim/LegacyScripts.hs b/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/Shim/LegacyScripts.hs index 88a69f6570..009a701f74 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/Shim/LegacyScripts.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/Shim/LegacyScripts.hs @@ -119,11 +119,13 @@ toPlutusScriptDatum -> Old.ScriptDatum Old.WitCtxTxIn -> PlutusScriptDatum (Old.ToLedgerPlutusLanguage lang) (ToPlutusScriptPurpose TxInItem) -- ^ Encapsulates CIP-69: V3 spending script datums are optional +toPlutusScriptDatum WitTxIn{} Old.PlutusScriptV4 (Old.ScriptDatumForTxIn r) = SpendingScriptDatum r toPlutusScriptDatum WitTxIn{} Old.PlutusScriptV3 (Old.ScriptDatumForTxIn r) = SpendingScriptDatum r -- \^ V2 and V1 spending script datums are required toPlutusScriptDatum WitTxIn{} Old.PlutusScriptV2 (Old.ScriptDatumForTxIn (Just r)) = SpendingScriptDatum r toPlutusScriptDatum WitTxIn{} Old.PlutusScriptV1 (Old.ScriptDatumForTxIn (Just r)) = SpendingScriptDatum r -- \^ V2 and V3 scripts can have inline datums +toPlutusScriptDatum WitTxIn{} Old.PlutusScriptV4 Old.InlineScriptDatum = InlineDatum toPlutusScriptDatum WitTxIn{} Old.PlutusScriptV3 Old.InlineScriptDatum = InlineDatum toPlutusScriptDatum WitTxIn{} Old.PlutusScriptV2 Old.InlineScriptDatum = InlineDatum -- \^ Everything else is not allowed. The old api does not prevent these invalid combinations. @@ -206,6 +208,7 @@ obtainConstraints v = Old.PlutusScriptV1 -> id Old.PlutusScriptV2 -> id Old.PlutusScriptV3 -> id + Old.PlutusScriptV4 -> id toPlutusSLanguage :: Old.PlutusScriptVersion lang -> L.SLanguage (Old.ToLedgerPlutusLanguage lang) @@ -213,3 +216,4 @@ toPlutusSLanguage = \case Old.PlutusScriptV1 -> L.SPlutusV1 Old.PlutusScriptV2 -> L.SPlutusV2 Old.PlutusScriptV3 -> L.SPlutusV3 + Old.PlutusScriptV4 -> L.SPlutusV4 diff --git a/cardano-api/src/Cardano/Api/Experimental/Tx.hs b/cardano-api/src/Cardano/Api/Experimental/Tx.hs index 297bebabaa..6872ff7a72 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Tx.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Tx.hs @@ -169,7 +169,6 @@ import Cardano.Crypto.Hash qualified as Hash import Cardano.Ledger.Alonzo.TxBody qualified as L import Cardano.Ledger.Api qualified as L import Cardano.Ledger.Binary qualified as Ledger -import Cardano.Ledger.Conway.TxBody qualified as L import Cardano.Ledger.Core qualified as Ledger import Cardano.Ledger.Hashes qualified as L hiding (Hash) @@ -222,7 +221,8 @@ makeUnsignedTx :: Era era -> TxBodyContent BuildTx era -> Either TxBodyError (UnsignedTx era) -makeUnsignedTx era bc = obtainCommonConstraints era $ do +makeUnsignedTx DijkstraEra _ = error "makeUnsignedTx: Dijkstra era not supported yet" +makeUnsignedTx era@ConwayEra bc = obtainCommonConstraints era $ do let sbe = convert era aeon = convert era TxScriptWitnessRequirements languages scripts datums redeemers <- @@ -289,7 +289,7 @@ makeUnsignedTx era bc = obtainCommonConstraints era $ do & L.datsTxWitsL .~ datums & L.rdmrsTxWitsL .~ redeemers - eraSpecificTxBody <- eraSpecificLedgerTxBody era ledgerTxBody bc + let eraSpecificTxBody = eraSpecificLedgerTxBody era ledgerTxBody bc return . UnsignedTx $ L.mkBasicTx eraSpecificTxBody @@ -301,22 +301,25 @@ eraSpecificLedgerTxBody :: Era era -> Ledger.TxBody (LedgerEra era) -> TxBodyContent BuildTx era - -> Either TxBodyError (Ledger.TxBody (LedgerEra era)) -eraSpecificLedgerTxBody ConwayEra ledgerbody bc = - let propProcedures = txProposalProcedures bc - voteProcedures = txVotingProcedures bc - treasuryDonation = txTreasuryDonation bc - currentTresuryValue = txCurrentTreasuryValue bc - in return $ - ledgerbody - & L.proposalProceduresTxBodyL - .~ convProposalProcedures (maybe TxProposalProceduresNone unFeatured propProcedures) - & L.votingProceduresTxBodyL - .~ convVotingProcedures (maybe TxVotingProceduresNone unFeatured voteProcedures) - & L.treasuryDonationTxBodyL - .~ maybe (L.Coin 0) unFeatured treasuryDonation - & L.currentTreasuryValueTxBodyL - .~ L.maybeToStrictMaybe (unFeatured =<< currentTresuryValue) + -> Ledger.TxBody (LedgerEra era) +eraSpecificLedgerTxBody era ledgerbody bc = + body era + where + body e = + let propProcedures = txProposalProcedures bc + voteProcedures = txVotingProcedures bc + treasuryDonation = txTreasuryDonation bc + currentTresuryValue = txCurrentTreasuryValue bc + in obtainCommonConstraints e $ + ledgerbody + & L.proposalProceduresTxBodyL + .~ convProposalProcedures (maybe TxProposalProceduresNone unFeatured propProcedures) + & L.votingProceduresTxBodyL + .~ convVotingProcedures (maybe TxVotingProceduresNone unFeatured voteProcedures) + & L.treasuryDonationTxBodyL + .~ maybe (L.Coin 0) unFeatured treasuryDonation + & L.currentTreasuryValueTxBodyL + .~ L.maybeToStrictMaybe (unFeatured =<< currentTresuryValue) hashTxBody :: L.HashAnnotated (Ledger.TxBody era) L.EraIndependentTxBody diff --git a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/AnyWitness.hs b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/AnyWitness.hs index 24536ba065..dc38bb7d5b 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/AnyWitness.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/AnyWitness.hs @@ -29,6 +29,7 @@ import Cardano.Ledger.Alonzo.Scripts qualified as L import Cardano.Ledger.Babbage.Scripts qualified as L import Cardano.Ledger.Conway.Scripts qualified as L import Cardano.Ledger.Core qualified as L +import Cardano.Ledger.Dijkstra.Scripts qualified as Dijkstra import Cardano.Ledger.Plutus.Data qualified as L import Cardano.Ledger.Plutus.Language qualified as L @@ -98,15 +99,17 @@ getAnyWitnessScript era ss@(AnySimpleScriptWitness{}) = ShelleyBasedEraShelley -> getAnyWitnessSimpleScript ss ShelleyBasedEraAllegra -> getAnyWitnessSimpleScript ss ShelleyBasedEraMary -> getAnyWitnessSimpleScript ss - ShelleyBasedEraAlonzo -> L.TimelockScript <$> getAnyWitnessSimpleScript ss - ShelleyBasedEraBabbage -> L.TimelockScript <$> getAnyWitnessSimpleScript ss - ShelleyBasedEraConway -> L.TimelockScript <$> getAnyWitnessSimpleScript ss + ShelleyBasedEraAlonzo -> L.NativeScript <$> getAnyWitnessSimpleScript ss + ShelleyBasedEraBabbage -> L.NativeScript <$> getAnyWitnessSimpleScript ss + ShelleyBasedEraConway -> L.NativeScript <$> getAnyWitnessSimpleScript ss + ShelleyBasedEraDijkstra -> L.NativeScript <$> getAnyWitnessSimpleScript ss getAnyWitnessScript era ps@(AnyPlutusScriptWitness{}) = forShelleyBasedEraInEon era Nothing $ \aEon -> case aEon of AlonzoEraOnwardsAlonzo -> L.PlutusScript <$> getAnyWitnessPlutusScript aEon ps AlonzoEraOnwardsBabbage -> L.PlutusScript <$> getAnyWitnessPlutusScript aEon ps AlonzoEraOnwardsConway -> L.PlutusScript <$> getAnyWitnessPlutusScript aEon ps + AlonzoEraOnwardsDijkstra -> L.PlutusScript <$> getAnyWitnessPlutusScript aEon ps -- It should be noted that 'PlutusRunnable' is constructed via deserialization. The deserialization -- instance lives in ledger and will fail for an invalid script language/era pairing. Therefore @@ -127,6 +130,9 @@ fromPlutusRunnable L.SPlutusV1 eon runnable = AlonzoEraOnwardsConway -> let plutusScript = L.plutusFromRunnable runnable in Just $ L.ConwayPlutusV1 plutusScript + AlonzoEraOnwardsDijkstra -> + let plutusScript = L.plutusFromRunnable runnable + in Just $ Dijkstra.DijkstraPlutusV1 plutusScript fromPlutusRunnable L.SPlutusV2 eon runnable = case eon of AlonzoEraOnwardsAlonzo -> Nothing @@ -136,6 +142,9 @@ fromPlutusRunnable L.SPlutusV2 eon runnable = AlonzoEraOnwardsConway -> let plutusScript = L.plutusFromRunnable runnable in Just $ L.ConwayPlutusV2 plutusScript + AlonzoEraOnwardsDijkstra -> + let plutusScript = L.plutusFromRunnable runnable + in Just $ Dijkstra.DijkstraPlutusV2 plutusScript fromPlutusRunnable L.SPlutusV3 eon runnable = case eon of AlonzoEraOnwardsAlonzo -> Nothing @@ -143,6 +152,19 @@ fromPlutusRunnable L.SPlutusV3 eon runnable = AlonzoEraOnwardsConway -> let plutusScript = L.plutusFromRunnable runnable in Just $ L.ConwayPlutusV3 plutusScript + AlonzoEraOnwardsDijkstra -> + let plutusScript = L.plutusFromRunnable runnable + in Just $ Dijkstra.DijkstraPlutusV3 plutusScript +fromPlutusRunnable L.SPlutusV4 eon runnable = + case eon of + AlonzoEraOnwardsAlonzo -> Nothing + AlonzoEraOnwardsBabbage -> Nothing + AlonzoEraOnwardsConway -> + let plutusScript = L.plutusFromRunnable runnable + in Just $ error "fromPlutusRunnable: ConwayPlutusV4" plutusScript + AlonzoEraOnwardsDijkstra -> + let plutusScript = L.plutusFromRunnable runnable + in Just $ Dijkstra.DijkstraPlutusV4 plutusScript toAlonzoDatum :: AlonzoEraOnwards era @@ -160,5 +182,6 @@ getPlutusDatum getPlutusDatum L.SPlutusV1 (SpendingScriptDatum d) = Just d getPlutusDatum L.SPlutusV2 (SpendingScriptDatum d) = Just d getPlutusDatum L.SPlutusV3 (SpendingScriptDatum d) = d +getPlutusDatum L.SPlutusV4 (SpendingScriptDatum _d) = error "dijkstra" getPlutusDatum _ InlineDatum = Nothing getPlutusDatum _ NoScriptDatum = Nothing diff --git a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Certificate.hs b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Certificate.hs index 0cf740ae4f..651b89d568 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Certificate.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Certificate.hs @@ -21,8 +21,8 @@ where import Cardano.Api.Address qualified as Api import Cardano.Api.Certificate.Internal qualified as Api +import Cardano.Api.Era.Internal.Core (DijkstraEra) import Cardano.Api.Era.Internal.Eon.Convert -import Cardano.Api.Era.Internal.Eon.ConwayEraOnwards import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra import Cardano.Api.Era.Internal.Eon.ShelleyToBabbageEra qualified as Api import Cardano.Api.Experimental.Era @@ -82,13 +82,19 @@ instance shelleyBasedEraConstraints (shelleyBasedEra @era) $ Certificate <$> CBOR.decodeFull' bs convertToOldApiCertificate :: Era era -> Certificate (LedgerEra era) -> Api.Certificate era -convertToOldApiCertificate ConwayEra (Certificate cert) = - Api.ConwayCertificate ConwayEraOnwardsConway cert +convertToOldApiCertificate e@ConwayEra (Certificate cert) = + obtainConwayConstraints e $ Api.ConwayCertificate (convert e) cert +convertToOldApiCertificate DijkstraEra _ = error "Dijkstra era not supported yet" convertToNewCertificate :: Era era -> Api.Certificate era -> Certificate (LedgerEra era) -convertToNewCertificate ConwayEra (Api.ConwayCertificate _ cert) = Certificate cert -convertToNewCertificate ConwayEra (Api.ShelleyRelatedCertificate sToBab _) = - case sToBab :: Api.ShelleyToBabbageEra ConwayEra of {} +convertToNewCertificate era (Api.ConwayCertificate _ cert) = + case era of + ConwayEra -> Certificate cert + DijkstraEra -> error "convertToNewCertificate: DijkstraEra not supported" +convertToNewCertificate era (Api.ShelleyRelatedCertificate sToBab _) = + case era of + ConwayEra -> case sToBab :: Api.ShelleyToBabbageEra ConwayEra of {} + DijkstraEra -> case sToBab :: Api.ShelleyToBabbageEra DijkstraEra of {} mkTxCertificates :: forall era @@ -98,29 +104,30 @@ mkTxCertificates mkTxCertificates [] = TxCertificatesNone mkTxCertificates certs = TxCertificates (convert useEra) $ fromList $ map (getStakeCred useEra) certs - where - getStakeCred - :: Era era - -> (Certificate (LedgerEra era), AnyWitness (LedgerEra era)) - -> ( Api.Certificate era - , Api.BuildTxWith - Api.BuildTx - (Maybe (Api.StakeCredential, Api.Witness Api.WitCtxStake era)) - ) - getStakeCred era (Certificate cert, witness) = - case era of - ConwayEra -> do - let oldApiCert = Api.ConwayCertificate (convert era) cert - mStakeCred = Api.selectStakeCredentialWitness oldApiCert - wit = - case witness of - AnyKeyWitnessPlaceholder -> Api.KeyWitness Api.KeyWitnessForStakeAddr - AnySimpleScriptWitness ss -> - Api.ScriptWitness Api.ScriptWitnessForStakeAddr $ newToOldSimpleScriptWitness era ss - AnyPlutusScriptWitness psw -> - Api.ScriptWitness Api.ScriptWitnessForStakeAddr $ - newToOldPlutusCertificateScriptWitness ConwayEra psw - (oldApiCert, pure $ (,wit) <$> mStakeCred) + +getStakeCred + :: Era era + -> (Certificate (LedgerEra era), AnyWitness (LedgerEra era)) + -> ( Api.Certificate era + , Api.BuildTxWith + Api.BuildTx + (Maybe (Api.StakeCredential, Api.Witness Api.WitCtxStake era)) + ) +getStakeCred e@ConwayEra (Certificate cert, witness) = do + let oldApiCert = obtainConwayConstraints e $ Api.ConwayCertificate (convert e) cert + mStakeCred = Api.selectStakeCredentialWitness oldApiCert + wit = + case witness of + AnyKeyWitnessPlaceholder -> Api.KeyWitness Api.KeyWitnessForStakeAddr + AnySimpleScriptWitness ss -> + Api.ScriptWitness Api.ScriptWitnessForStakeAddr $ + obtainCommonConstraints e $ + newToOldSimpleScriptWitness e ss + AnyPlutusScriptWitness psw -> + Api.ScriptWitness Api.ScriptWitnessForStakeAddr $ + newToOldPlutusCertificateScriptWitness e psw + (oldApiCert, pure $ (,wit) <$> mStakeCred) +getStakeCred DijkstraEra _ = error "Dijkstra era not supported yet" newToOldSimpleScriptWitness :: L.AllegraEraScript (LedgerEra era) @@ -164,12 +171,40 @@ newToOldPlutusCertificateScriptWitness ConwayEra (Exp.PlutusScriptWitness Plutus Api.NoScriptDatumForStake redeemer execUnits +newToOldPlutusCertificateScriptWitness ConwayEra (Exp.PlutusScriptWitness Plutus.SPlutusV4 _scriptOrRef _ _redeemer _execUnits) = + error "dijkstra" +newToOldPlutusCertificateScriptWitness DijkstraEra (Exp.PlutusScriptWitness Plutus.SPlutusV1 scriptOrRef _ redeemer execUnits) = + Api.PlutusScriptWitness + Api.PlutusScriptV1InDijkstra + Api.PlutusScriptV1 + (newToOldPlutusScriptOrReferenceInput DijkstraEra scriptOrRef) + Api.NoScriptDatumForStake + redeemer + execUnits +newToOldPlutusCertificateScriptWitness DijkstraEra (Exp.PlutusScriptWitness Plutus.SPlutusV2 scriptOrRef _ redeemer execUnits) = + Api.PlutusScriptWitness + Api.PlutusScriptV2InDijkstra + Api.PlutusScriptV2 + (newToOldPlutusScriptOrReferenceInput DijkstraEra scriptOrRef) + Api.NoScriptDatumForStake + redeemer + execUnits +newToOldPlutusCertificateScriptWitness DijkstraEra (Exp.PlutusScriptWitness Plutus.SPlutusV3 scriptOrRef _ redeemer execUnits) = + Api.PlutusScriptWitness + Api.PlutusScriptV3InDijkstra + Api.PlutusScriptV3 + (newToOldPlutusScriptOrReferenceInput DijkstraEra scriptOrRef) + Api.NoScriptDatumForStake + redeemer + execUnits +newToOldPlutusCertificateScriptWitness DijkstraEra (Exp.PlutusScriptWitness Plutus.SPlutusV4 _scriptOrRef _ _redeemer _execUnits) = + error "dijkstra" newToOldPlutusScriptOrReferenceInput :: Era era -> Exp.PlutusScriptOrReferenceInput lang (LedgerEra era) -> Api.PlutusScriptOrReferenceInput oldlang -newToOldPlutusScriptOrReferenceInput ConwayEra (Exp.PReferenceScript txin) = Api.PReferenceScript txin -newToOldPlutusScriptOrReferenceInput ConwayEra (Exp.PScript (Exp.PlutusScriptInEra plutusRunnable)) = +newToOldPlutusScriptOrReferenceInput _ (Exp.PReferenceScript txin) = Api.PReferenceScript txin +newToOldPlutusScriptOrReferenceInput _ (Exp.PScript (Exp.PlutusScriptInEra plutusRunnable)) = let oldScript = L.unPlutusBinary . L.plutusBinary $ L.plutusFromRunnable plutusRunnable in Api.PScript $ Api.PlutusScriptSerialised oldScript diff --git a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/TxScriptWitnessRequirements.hs b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/TxScriptWitnessRequirements.hs index a458bd3e8f..b73287832f 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/TxScriptWitnessRequirements.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/TxScriptWitnessRequirements.hs @@ -61,6 +61,13 @@ instance Semigroup (TxScriptWitnessRequirements L.ConwayEra) where instance Monoid (TxScriptWitnessRequirements L.ConwayEra) where mempty = TxScriptWitnessRequirements mempty mempty mempty mempty +instance Semigroup (TxScriptWitnessRequirements L.DijkstraEra) where + (<>) (TxScriptWitnessRequirements l1 s1 d1 r1) (TxScriptWitnessRequirements l2 s2 d2 r2) = + TxScriptWitnessRequirements (l1 <> l2) (s1 <> s2) (d1 <> d2) (r1 <> r2) + +instance Monoid (TxScriptWitnessRequirements L.DijkstraEra) where + mempty = TxScriptWitnessRequirements mempty mempty mempty mempty + getTxScriptWitnessRequirements :: AlonzoEraOnwards era -> [(Witnessable witnessable (ShelleyLedgerEra era), AnyWitness (ShelleyLedgerEra era))] @@ -93,6 +100,7 @@ obtainMonoidConstraint eon = case eon of AlonzoEraOnwardsAlonzo -> id AlonzoEraOnwardsBabbage -> id AlonzoEraOnwardsConway -> id + AlonzoEraOnwardsDijkstra -> id extractExecutionUnits :: TxScriptWitnessRequirements era -> [ExecutionUnits] extractExecutionUnits (TxScriptWitnessRequirements _ _ _ redeemers) = diff --git a/cardano-api/src/Cardano/Api/Genesis.hs b/cardano-api/src/Cardano/Api/Genesis.hs index 92fa1899db..3c32d2337b 100644 --- a/cardano-api/src/Cardano/Api/Genesis.hs +++ b/cardano-api/src/Cardano/Api/Genesis.hs @@ -2,7 +2,6 @@ module Cardano.Api.Genesis ( ShelleyGenesis (..) , shelleyGenesisDefaults , alonzoGenesisDefaults - , decodeAlonzoGenesis , conwayGenesisDefaults -- ** Configuration diff --git a/cardano-api/src/Cardano/Api/Genesis/Internal.hs b/cardano-api/src/Cardano/Api/Genesis/Internal.hs index f7afc1838d..b93fca0d21 100644 --- a/cardano-api/src/Cardano/Api/Genesis/Internal.hs +++ b/cardano-api/src/Cardano/Api/Genesis/Internal.hs @@ -3,7 +3,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralisedNewtypeDeriving #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} @@ -13,7 +12,6 @@ module Cardano.Api.Genesis.Internal ( ShelleyGenesis (..) , shelleyGenesisDefaults , alonzoGenesisDefaults - , decodeAlonzoGenesis , conwayGenesisDefaults -- ** Configuration @@ -38,20 +36,7 @@ module Cardano.Api.Genesis.Internal ) where -import Cardano.Api.Era.Internal.Core - ( CardanoEra - , forEraMaybeEon - , monoidForEraInEon - ) -import Cardano.Api.Era.Internal.Eon.ConwayEraOnwards import Cardano.Api.IO -import Cardano.Api.Monad.Error - ( ExceptT - , MonadError (throwError) - , MonadTransError - , liftEither - , modifyError - ) import Cardano.Chain.Genesis qualified import Cardano.Crypto.Hash.Blake2b qualified @@ -61,6 +46,7 @@ import Cardano.Ledger.Alonzo.Scripts (ExUnits (..), Prices (..)) import Cardano.Ledger.Api (CoinPerWord (..)) import Cardano.Ledger.BaseTypes as Ledger import Cardano.Ledger.Coin (Coin (..)) +import Cardano.Ledger.Coin qualified as L import Cardano.Ledger.Conway.Genesis (ConwayGenesis (..)) import Cardano.Ledger.Conway.PParams ( DRepVotingThresholds (..) @@ -82,33 +68,25 @@ import PlutusCore.Evaluation.Machine.CostModelInterface import PlutusCore.Evaluation.Machine.ExBudgetingDefaults import PlutusCore.Evaluation.Machine.MachineParameters import PlutusLedgerApi.Common (IsParamName, readParamName) -import PlutusLedgerApi.V2 qualified as V2 import PlutusLedgerApi.V3 qualified as V3 import Control.Monad import Control.Monad.Trans.Fail.String (errorFail) -import Data.Aeson qualified as A import Data.ByteString (ByteString) -import Data.ByteString.Lazy qualified as LBS import Data.Default.Class qualified as DefaultClass import Data.Functor.Identity import Data.Int (Int64) -import Data.List (sortOn) import Data.ListMap qualified as ListMap -import Data.Map (Map) import Data.Map.Strict qualified as M import Data.Map.Strict qualified as Map import Data.Maybe import Data.Ratio -import Data.Set qualified as S import Data.Text (Text) import Data.Time qualified as Time import Data.Typeable -import Data.Vector qualified as V import GHC.Exts (IsList (..)) import GHC.Stack (HasCallStack) import Lens.Micro -import Lens.Micro.Aeson qualified as AL import Barbies (bmap) import UntypedPlutusCore.Evaluation.Machine.Cek.CekMachineCosts @@ -195,7 +173,7 @@ shelleyGenesisDefaults = -- pot = tx_fees + ρ * remaining_reserves & ppRhoL .~ unsafeBR (1 % 10) -- How much of reserves goes into pot & ppTauL .~ unsafeBR (1 % 10) -- τ * remaining_reserves is sent to treasury every epoch - & ppKeyDepositL .~ 400000 -- require a non-zero deposit when registering keys + & ppKeyDepositL .~ L.Coin 400000 -- require a non-zero deposit when registering keys , -- genesis keys and initial funds sgGenDelegs = M.empty , sgStaking = emptyGenesisStaking @@ -277,9 +255,11 @@ conwayGenesisDefaults = costModelParamsForTesting :: HasCallStack => [(V3.ParamName, Int64)] costModelParamsForTesting = - Map.toList $ - fromJust $ - extractCostModelParamsLedgerOrder mCostModel + -- all geneses should contain only the number of cost model params equal to the initial number + take (L.costModelInitParamCount PlutusV3) + . Map.toList + . fromJust + $ extractCostModelParamsLedgerOrder mCostModel mCostModel :: MCostModel mCostModel = @@ -338,116 +318,11 @@ type MBuiltinCostModel = BuiltinCostModelBase MCostingFun (%!) :: forall r. (HasCallStack, Typeable r, BoundedRational r) => Integer -> Integer -> r n %! d = unsafeBoundedRational $ n Data.Ratio.% d --- | Decode Alonzo genesis in an optionally era sensitive way. --- --- Because the Plutus V2 cost model has changed between Babbage and Conway era, we need to know the era if we --- want to decde Alonzo Genesis with a cost model baked in. If the V2 cost model is present in genesis, you --- need to provide an era witness. --- --- When an era witness is provided, for Plutus V2 model the function additionally: --- 1. Does extra cost model parameters name validation: Checks for mandatory 175 parameters if provided in --- a map form. --- 2. If >= Conway: adds defaults for new 10 parameters, if they were not provided (maxBound) --- 3. Removes extra parameters above the max count: Babbage - 175, Conway - 185. -decodeAlonzoGenesis - :: forall era t m - . MonadTransError String t m - => Maybe (CardanoEra era) - -- ^ An optional era witness in which we're reading the genesis - -> LBS.ByteString - -- ^ Genesis JSON - -> t m AlonzoGenesis -decodeAlonzoGenesis Nothing genesisBs = - modifyError ("Cannot decode Alonzo genesis: " <>) $ - liftEither $ - A.eitherDecode genesisBs -decodeAlonzoGenesis (Just era) genesisBs = modifyError ("Cannot decode era-sensitive Alonzo genesis: " <>) $ do - genesisValue :: A.Value <- liftEither $ A.eitherDecode genesisBs - -- Making a fixup of a costmodel is easier before JSON deserialization. This also saves us from building - -- plutus' EvaluationContext one more time after cost model update. - genesisValue' <- - (AL.key "costModels" . AL.key "PlutusV2" . AL._Value) setCostModelDefaultValues genesisValue - fromJsonE genesisValue' - where - setCostModelDefaultValues :: A.Value -> ExceptT String m A.Value - setCostModelDefaultValues = \case - obj@(A.Object _) -> do - -- decode cost model into a map first - costModel :: Map V2.ParamName Int64 <- - modifyError ("Decoding cost model object: " <>) $ fromJsonE obj - - let costModelWithDefaults = - sortOn fst - . toList - $ M.union costModel optionalCostModelDefaultValues - - -- check that we have all required params - unless (allCostModelParams == (fst <$> costModelWithDefaults)) $ do - let allCostModelParamsSet = fromList allCostModelParams - providedCostModelParamsSet = fromList $ fst <$> costModelWithDefaults - throwError $ - "Missing V2 Plutus cost model parameters: " - <> show (toList $ S.difference allCostModelParamsSet providedCostModelParamsSet) - - -- We have already have required params, we already added optional ones (which are trimmed later - -- if required). Continue processing further in array representation. - setCostModelDefaultValues . A.toJSON $ map snd costModelWithDefaults - A.Array vec - -- here we rely on an assumption that params are in correct order, so that we can take only the - -- required ones for an era - | V.length vec < costModelExpectedCount -> - pure . A.Array . V.take costModelExpectedCount $ - vec <> (A.toJSON . snd <$> optionalCostModelDefaultValues) - | V.length vec > costModelExpectedCount -> pure . A.Array $ V.take costModelExpectedCount vec - other -> pure other - - -- Plutus V2 params expected count depending on an era - costModelExpectedCount :: Int - costModelExpectedCount - -- use all available parameters >= conway - | isConwayOnwards = length allCostModelParams - -- use only required params in < conway - | otherwise = L.costModelParamsCount L.PlutusV2 -- Babbage - - -- A list-like of tuples (param name, value) with default maxBound value - optionalCostModelDefaultValues :: (Item l ~ (V2.ParamName, Int64), IsList l) => l - optionalCostModelDefaultValues = fromList $ map (,maxBound) optionalV2costModelParams - - allCostModelParams :: [V2.ParamName] - allCostModelParams = [minBound .. maxBound] - - -- The new V2 cost model params introduced in Conway - optionalV2costModelParams :: [V2.ParamName] - optionalV2costModelParams = - [ V2.IntegerToByteString'cpu'arguments'c0 - , V2.IntegerToByteString'cpu'arguments'c1 - , V2.IntegerToByteString'cpu'arguments'c2 - , V2.IntegerToByteString'memory'arguments'intercept - , V2.IntegerToByteString'memory'arguments'slope - , V2.ByteStringToInteger'cpu'arguments'c0 - , V2.ByteStringToInteger'cpu'arguments'c1 - , V2.ByteStringToInteger'cpu'arguments'c2 - , V2.ByteStringToInteger'memory'arguments'intercept - , V2.ByteStringToInteger'memory'arguments'slope - ] - - fromJsonE :: A.FromJSON a => A.Value -> ExceptT String m a - fromJsonE v = - case A.fromJSON v of - A.Success a -> pure a - A.Error e -> throwError e - - isConwayOnwards = isJust $ forEraMaybeEon @ConwayEraOnwards era - -- | Some reasonable starting defaults for constructing a 'AlonzoGenesis'. -- Based on https://github.com/IntersectMBO/cardano-node/blob/master/cardano-testnet/src/Testnet/Defaults.hs --- The era determines Plutus V2 cost model parameters: --- * Conway: 185 --- * <= Babbage: 175 alonzoGenesisDefaults - :: CardanoEra era - -> AlonzoGenesis -alonzoGenesisDefaults era = + :: AlonzoGenesis +alonzoGenesisDefaults = AlonzoGenesis { agPrices = Prices @@ -823,23 +698,6 @@ alonzoGenesisDefaults era = , 32947 , 10 ] - <> defaultV2CostModelNewConwayParams - - -- New Conway cost model parameters - defaultV2CostModelNewConwayParams = - monoidForEraInEon @ConwayEraOnwards era $ - const - [ 1292075 - , 24469 - , 74 - , 0 - , 1 - , 936157 - , 49601 - , 237 - , 0 - , 1 - ] -- | Convert Rational to a bounded rational. Throw an exception when the rational is out of bounds. unsafeBoundedRational diff --git a/cardano-api/src/Cardano/Api/Governance/Internal/Action/ProposalProcedure.hs b/cardano-api/src/Cardano/Api/Governance/Internal/Action/ProposalProcedure.hs index f1b6002bb4..6ca5b03cfb 100644 --- a/cardano-api/src/Cardano/Api/Governance/Internal/Action/ProposalProcedure.hs +++ b/cardano-api/src/Cardano/Api/Governance/Internal/Action/ProposalProcedure.hs @@ -44,13 +44,13 @@ data AnyGovernanceAction = forall era. AnyGovernanceAction (Gov.GovAction era) -- TODO: Conway - Transitiion to Ledger.GovAction data GovernanceAction era = MotionOfNoConfidence - (StrictMaybe (Ledger.GovPurposeId Ledger.CommitteePurpose (ShelleyLedgerEra era))) + (StrictMaybe (Ledger.GovPurposeId Ledger.CommitteePurpose)) | ProposeNewConstitution - (StrictMaybe (Ledger.GovPurposeId Ledger.ConstitutionPurpose (ShelleyLedgerEra era))) + (StrictMaybe (Ledger.GovPurposeId Ledger.ConstitutionPurpose)) Ledger.Anchor (StrictMaybe Shelley.ScriptHash) | ProposeNewCommittee - (StrictMaybe (Ledger.GovPurposeId Ledger.CommitteePurpose (ShelleyLedgerEra era))) + (StrictMaybe (Ledger.GovPurposeId Ledger.CommitteePurpose)) [L.Credential ColdCommitteeRole] -- ^ Old constitutional committee (Map (L.Credential ColdCommitteeRole) EpochNo) @@ -63,11 +63,11 @@ data GovernanceAction era [(Network, StakeCredential, L.Coin)] !(StrictMaybe Shelley.ScriptHash) | InitiateHardfork - (StrictMaybe (Ledger.GovPurposeId Ledger.HardForkPurpose (ShelleyLedgerEra era))) + (StrictMaybe (Ledger.GovPurposeId Ledger.HardForkPurpose)) ProtVer | -- | Governance policy UpdatePParams - (StrictMaybe (Ledger.GovPurposeId Ledger.PParamUpdatePurpose (ShelleyLedgerEra era))) + (StrictMaybe (Ledger.GovPurposeId Ledger.PParamUpdatePurpose)) (Ledger.PParamsUpdate (ShelleyLedgerEra era)) !(StrictMaybe Shelley.ScriptHash) diff --git a/cardano-api/src/Cardano/Api/Internal/Orphans/Serialisation.hs b/cardano-api/src/Cardano/Api/Internal/Orphans/Serialisation.hs index 472fb4bcac..22713af1bd 100644 --- a/cardano-api/src/Cardano/Api/Internal/Orphans/Serialisation.hs +++ b/cardano-api/src/Cardano/Api/Internal/Orphans/Serialisation.hs @@ -46,10 +46,12 @@ import Cardano.Chain.Update.Validation.Voting qualified as L.Voting import Cardano.Crypto.Hash qualified as Crypto import Cardano.Ledger.Allegra.Rules qualified as L import Cardano.Ledger.Alonzo.PParams qualified as Ledger +import Cardano.Ledger.Alonzo.Rules qualified as Alonzo import Cardano.Ledger.Alonzo.Rules qualified as L import Cardano.Ledger.Alonzo.Tx qualified as L import Cardano.Ledger.Api qualified as L import Cardano.Ledger.Babbage.PParams qualified as Ledger +import Cardano.Ledger.Babbage.Rules qualified as Babbage import Cardano.Ledger.Babbage.Rules qualified as L import Cardano.Ledger.BaseTypes (strictMaybeToMaybe) import Cardano.Ledger.BaseTypes qualified as L @@ -92,11 +94,20 @@ import PlutusLedgerApi.V2 qualified as V2 import Codec.Binary.Bech32 qualified as Bech32 import Codec.CBOR.Read qualified as CBOR -import Data.Aeson (KeyValue ((.=)), ToJSON (..), ToJSONKey (..), object, pairs) +import Data.Aeson + ( KeyValue ((.=)) + , ToJSON (..) + , ToJSONKey (..) + , defaultOptions + , genericToJSON + , object + , pairs + ) import Data.Aeson qualified as A import Data.Aeson qualified as Aeson import Data.Bifunctor import Data.ByteString qualified as BS +import Data.ByteString.Base16 qualified as B16 import Data.ByteString.Base16 qualified as Base16 import Data.ByteString.Builder qualified as BSB import Data.ByteString.Char8 qualified as C8 @@ -108,6 +119,7 @@ import Data.ListMap qualified as ListMap import Data.Maybe.Strict (StrictMaybe (..)) import Data.Monoid import Data.Text qualified as T +import Data.Text qualified as Text import Data.Text.Encoding qualified as Text import Data.Typeable (Typeable) import Data.Word (Word16) @@ -199,20 +211,27 @@ deriving anyclass instance ToJSON (L.PredicateFailure (L.EraRule "UTXO" ledgerera)) => ToJSON (L.ShelleyPpupPredFailure ledgerera) -deriving anyclass instance +instance ( ToJSON (L.PredicateFailure (L.EraRule "UTXO" ledgerera)) , ToJSON (L.PlutusPurpose L.AsItem ledgerera) , ToJSON (L.PlutusPurpose L.AsIx ledgerera) ) => ToJSON (L.AlonzoUtxowPredFailure ledgerera) + where + toJSON = genericToJSON defaultOptions -deriving anyclass instance +instance ToJSON C8.ByteString where + toJSON = Aeson.String . Text.decodeLatin1 . B16.encode + +instance ( ToJSON (L.PredicateFailure (L.EraRule "UTXO" ledgerera)) , ToJSON (L.TxCert ledgerera) , ToJSON (L.PlutusPurpose L.AsItem ledgerera) , ToJSON (L.PlutusPurpose L.AsIx ledgerera) ) => ToJSON (L.BabbageUtxowPredFailure ledgerera) + where + toJSON = genericToJSON defaultOptions deriving anyclass instance ToJSON (L.PredicateFailure (L.EraRule "LEDGER" ledgerera)) diff --git a/cardano-api/src/Cardano/Api/Ledger/Internal/Reexport.hs b/cardano-api/src/Cardano/Api/Ledger/Internal/Reexport.hs index 912f78e67f..4b8ada4d1d 100644 --- a/cardano-api/src/Cardano/Api/Ledger/Internal/Reexport.hs +++ b/cardano-api/src/Cardano/Api/Ledger/Internal/Reexport.hs @@ -64,6 +64,8 @@ module Cardano.Api.Ledger.Internal.Reexport , fromEraCBOR , ppMinFeeAL , ppMinUTxOValueL + -- Dijkstra + , DijkstraPlutusPurpose (..) -- Conway , Anchor (..) , Committee (..) @@ -112,7 +114,7 @@ module Cardano.Api.Ledger.Internal.Reexport , toPlainDecoder -- Shelley , secondsToNominalDiffTimeMicro - , AccountState (..) + , ChainAccountState (..) , NewEpochState (..) , ShelleyGenesisStaking (..) -- Babbage @@ -271,7 +273,6 @@ import Cardano.Ledger.Binary , toPlainDecoder ) import Cardano.Ledger.Binary.Plain (Decoder, serializeAsHexText) -import Cardano.Ledger.CertState (DRepState (..), csCommitteeCredsL) import Cardano.Ledger.Coin (Coin (..), addDeltaCoin, toDeltaCoin) import Cardano.Ledger.Conway.Core ( DRepVotingThresholds (..) @@ -298,6 +299,7 @@ import Cardano.Ledger.Conway.Governance ) import Cardano.Ledger.Conway.PParams (UpgradeConwayPParams (..)) import Cardano.Ledger.Conway.Scripts (ConwayPlutusPurpose (..)) +import Cardano.Ledger.Conway.State (DRepState (..), csCommitteeCredsL) import Cardano.Ledger.Conway.TxCert ( ConwayDelegCert (..) , ConwayEraTxCert (..) @@ -320,6 +322,7 @@ import Cardano.Ledger.Core ) import Cardano.Ledger.Credential (Credential (..), credToText) import Cardano.Ledger.DRep (DRep (..), drepAnchorL, drepDepositL, drepExpiryL) +import Cardano.Ledger.Dijkstra.Scripts (DijkstraPlutusPurpose (..)) import Cardano.Ledger.Hashes ( ADDRHASH , SafeHash @@ -339,9 +342,8 @@ import Cardano.Ledger.Keys import Cardano.Ledger.Mary.Value (MultiAsset (..)) import Cardano.Ledger.Plutus.Data (Data (..), unData) import Cardano.Ledger.Plutus.Language (Language, Plutus, languageToText, plutusBinary) -import Cardano.Ledger.PoolParams (PoolMetadata (..), PoolParams (..), StakePoolRelay (..)) import Cardano.Ledger.Shelley.API - ( AccountState (..) + ( ChainAccountState (..) , GenDelegPair (..) , NewEpochState (..) , StakeReference (..) @@ -364,6 +366,7 @@ import Cardano.Ledger.Shelley.TxCert , ShelleyEraTxCert (..) , ShelleyTxCert (..) ) +import Cardano.Ledger.State (PoolMetadata (..), PoolParams (..), StakePoolRelay (..)) import Cardano.Ledger.TxIn (TxId (..), TxIn (..)) import Cardano.Protocol.Crypto (Crypto, StandardCrypto) import Cardano.Slotting.Slot (EpochNo (..)) diff --git a/cardano-api/src/Cardano/Api/LedgerState.hs b/cardano-api/src/Cardano/Api/LedgerState.hs index 382da1e351..18af7644a3 100644 --- a/cardano-api/src/Cardano/Api/LedgerState.hs +++ b/cardano-api/src/Cardano/Api/LedgerState.hs @@ -109,7 +109,7 @@ import Cardano.Api.Certificate.Internal import Cardano.Api.Consensus.Internal.Mode import Cardano.Api.Consensus.Internal.Mode qualified as Api import Cardano.Api.Era.Internal.Case -import Cardano.Api.Era.Internal.Core (CardanoEra, forEraMaybeEon) +import Cardano.Api.Era.Internal.Core (forEraMaybeEon) import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra import Cardano.Api.Error as Api import Cardano.Api.Genesis.Internal @@ -154,11 +154,20 @@ import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis (..)) import Cardano.Ledger.Api.Era qualified as Ledger import Cardano.Ledger.Api.Transition qualified as Ledger import Cardano.Ledger.BHeaderView qualified as Ledger -import Cardano.Ledger.BaseTypes (Globals (..), Nonce, ProtVer (..), natVersion, (⭒)) +import Cardano.Ledger.BaseTypes + ( Globals (..) + , Nonce + , ProtVer (..) + , boundRational + , knownNonZeroBounded + , natVersion + , (⭒) + ) import Cardano.Ledger.BaseTypes qualified as Ledger import Cardano.Ledger.Binary (DecoderError) import Cardano.Ledger.Coin qualified as SL import Cardano.Ledger.Conway.Genesis (ConwayGenesis (..)) +import Cardano.Ledger.Dijkstra.PParams qualified as Ledger import Cardano.Ledger.Keys qualified as SL import Cardano.Ledger.Shelley.API qualified as ShelleyAPI import Cardano.Ledger.Shelley.Core qualified as Core @@ -173,7 +182,7 @@ import Cardano.Slotting.EpochInfo.API qualified as Slot import Cardano.Slotting.Slot (WithOrigin (At, Origin)) import Cardano.Slotting.Slot qualified as Slot import Ouroboros.Consensus.Block.Abstract qualified as Consensus -import Ouroboros.Consensus.Block.Forging (BlockForging) +import Ouroboros.Consensus.Block.Forging (MkBlockForging (..)) import Ouroboros.Consensus.Byron.ByronHFC qualified as Consensus import Ouroboros.Consensus.Byron.Ledger qualified as Byron import Ouroboros.Consensus.Cardano qualified as Consensus @@ -193,6 +202,7 @@ import Ouroboros.Consensus.Ledger.Tables.Utils qualified as Ledger import Ouroboros.Consensus.Node.ProtocolInfo qualified as Consensus import Ouroboros.Consensus.Protocol.Abstract (ChainDepState, ConsensusProtocol (..)) import Ouroboros.Consensus.Protocol.Praos qualified as Praos +import Ouroboros.Consensus.Protocol.Praos.AgentClient import Ouroboros.Consensus.Protocol.Praos.Common qualified as Consensus import Ouroboros.Consensus.Protocol.Praos.VRF (mkInputVRF, vrfLeaderValue) import Ouroboros.Consensus.Protocol.TPraos qualified as TPraos @@ -214,6 +224,7 @@ import Control.Error.Util (note) import Control.Exception.Safe import Control.Monad import Control.Monad.State.Strict +import Control.Tracer qualified as Tracer import Data.Aeson as Aeson ( FromJSON (parseJSON) , Object @@ -222,6 +233,7 @@ import Data.Aeson as Aeson , (.:) , (.:?) ) +import Data.Aeson qualified as A import Data.Aeson.Types (Parser) import Data.Bifunctor import Data.ByteArray (ByteArrayAccess) @@ -347,7 +359,7 @@ initialLedgerState nodeConfigFile = do -- can remove the nodeConfigFile argument and much of the code in this -- module. config <- modifyError ILSEConfigFile (readNodeConfig nodeConfigFile) - genesisConfig <- modifyError ILSEGenesisFile (readCardanoGenesisConfig Nothing config) + genesisConfig <- modifyError ILSEGenesisFile (readCardanoGenesisConfig config) env <- modifyError ILSELedgerConsensusConfig (except (genesisConfigToEnv genesisConfig)) let ledgerState = initLedgerStateVar genesisConfig return (env, ledgerState) @@ -1147,7 +1159,7 @@ instance FromJSON NodeConfig where <*> parseAlonzoHardForkEpoch o <*> parseBabbageHardForkEpoch o <*> parseConwayHardForkEpoch o - + <*> pure Consensus.CardanoTriggerHardForkAtDefaultVersion -- TODO: Dijkstra parseShelleyHardForkEpoch :: Object -> Parser (Consensus.CardanoHardForkTrigger blk) parseShelleyHardForkEpoch o = asum @@ -1288,6 +1300,11 @@ getNewEpochState era x = do ConwayLedgerState conwayCurrent -> pure $ Shelley.shelleyLedgerState $ unFlip $ currentState conwayCurrent _ -> Left err + ShelleyBasedEraDijkstra -> + case tip of + DijkstraLedgerState dijkstraCurrent -> + pure $ Shelley.shelleyLedgerState $ unFlip $ currentState dijkstraCurrent + _ -> Left err {-# COMPLETE ShelleyLedgerState @@ -1358,12 +1375,22 @@ pattern ConwayLedgerState -> NS (Current (Flip Consensus.LedgerState mk)) (Consensus.CardanoEras Consensus.StandardCrypto) pattern ConwayLedgerState x = S (S (S (S (S (S (Z x)))))) +pattern DijkstraLedgerState + :: Current + (Flip Consensus.LedgerState mk) + ( Shelley.ShelleyBlock + (Praos.Praos Ledger.StandardCrypto) + Consensus.DijkstraEra + ) + -> NS (Current (Flip Consensus.LedgerState mk)) (Consensus.CardanoEras Consensus.StandardCrypto) +pattern DijkstraLedgerState x = S (S (S (S (S (S (S (Z x))))))) + encodeLedgerState :: LedgerState -> CBOR.Encoding encodeLedgerState (LedgerState hst@(HFC.HardForkLedgerState st) tbs) = mconcat [ CBOR.encodeListLen 2 , HFC.encodeTelescope - (byron :* shelley :* allegra :* mary :* alonzo :* babbage :* conway :* Nil) + (byron :* shelley :* allegra :* mary :* alonzo :* babbage :* conway :* dijkstra :* Nil) st , Ledger.valuesMKEncoder hst tbs ] @@ -1375,13 +1402,15 @@ encodeLedgerState (LedgerState hst@(HFC.HardForkLedgerState st) tbs) = alonzo = fn (K . Shelley.encodeShelleyLedgerState . unFlip) babbage = fn (K . Shelley.encodeShelleyLedgerState . unFlip) conway = fn (K . Shelley.encodeShelleyLedgerState . unFlip) + dijkstra = fn (K . Shelley.encodeShelleyLedgerState . unFlip) decodeLedgerState :: forall s. CBOR.Decoder s LedgerState decodeLedgerState = do 2 <- CBOR.decodeListLen hst <- HFC.HardForkLedgerState - <$> HFC.decodeTelescope (byron :* shelley :* allegra :* mary :* alonzo :* babbage :* conway :* Nil) + <$> HFC.decodeTelescope + (byron :* shelley :* allegra :* mary :* alonzo :* babbage :* conway :* dijkstra :* Nil) tbs <- Ledger.valuesMKDecoder hst pure (LedgerState hst tbs) where @@ -1392,6 +1421,7 @@ decodeLedgerState = do alonzo = Comp $ Flip <$> Shelley.decodeShelleyLedgerState babbage = Comp $ Flip <$> Shelley.decodeShelleyLedgerState conway = Comp $ Flip <$> Shelley.decodeShelleyLedgerState + dijkstra = Comp $ Flip <$> Shelley.decodeShelleyLedgerState type LedgerStateEvents = (LedgerState, [LedgerEvent]) @@ -1434,7 +1464,8 @@ mkProtocolInfoCardano :: GenesisConfig -> ( Consensus.ProtocolInfo (Consensus.CardanoBlock Consensus.StandardCrypto) - , IO [BlockForging IO (Consensus.CardanoBlock Consensus.StandardCrypto)] + , Tracer.Tracer IO KESAgentClientTrace + -> IO [MkBlockForging IO (Consensus.CardanoBlock Consensus.StandardCrypto)] ) mkProtocolInfoCardano (GenesisCardano dnc byronGenesis shelleyGenesisHash transCfg) = Consensus.protocolInfoCardano @@ -1467,19 +1498,30 @@ shelleyPraosNonce genesisHash = readCardanoGenesisConfig :: MonadIOTransError GenesisConfigError t m - => Maybe (CardanoEra era) - -- ^ Provide era witness to read Alonzo Genesis in an era-sensitive manner (see - -- 'Cardano.Api.Genesis.Internal.decodeAlonzGenesis' for more details) - -> NodeConfig + => NodeConfig -> t m GenesisConfig -readCardanoGenesisConfig mEra enc = do +readCardanoGenesisConfig enc = do byronGenesis <- readByronGenesisConfig enc ShelleyConfig shelleyGenesis shelleyGenesisHash <- readShelleyGenesisConfig enc - alonzoGenesis <- readAlonzoGenesisConfig mEra enc + alonzoGenesis <- readAlonzoGenesisConfig enc conwayGenesis <- readConwayGenesisConfig enc - let transCfg = Ledger.mkLatestTransitionConfig shelleyGenesis alonzoGenesis conwayGenesis + -- TODO: Build dummy dijkstra genesis value + let dijkstraGenesis = exampleDijkstraGenesis -- TODO: Dijkstra - add plumbing to read Dijkstra genesis + let transCfg = Ledger.mkLatestTransitionConfig shelleyGenesis alonzoGenesis conwayGenesis dijkstraGenesis pure $ GenesisCardano enc byronGenesis shelleyGenesisHash transCfg +exampleDijkstraGenesis :: Ledger.DijkstraGenesis +exampleDijkstraGenesis = + Ledger.DijkstraGenesis + { Ledger.dgUpgradePParams = + Ledger.UpgradeDijkstraPParams + { Ledger.udppMaxRefScriptSizePerBlock = 1024 * 1024 -- 1MiB + , Ledger.udppMaxRefScriptSizePerTx = 200 * 1024 -- 200KiB + , Ledger.udppRefScriptCostStride = knownNonZeroBounded @25600 -- 25 KiB + , Ledger.udppRefScriptCostMultiplier = fromJust $ boundRational 1.2 + } + } + data GenesisConfigError = NEError !Text | NEByronConfig !FilePath !Cardano.Chain.Genesis.ConfigurationError @@ -1553,15 +1595,12 @@ readShelleyGenesisConfig enc = do readAlonzoGenesisConfig :: MonadIOTransError GenesisConfigError t m - => Maybe (CardanoEra era) - -- ^ Provide era witness to read Alonzo Genesis in an era-sensitive manner (see - -- 'Cardano.Api.Genesis.Internal.decodeAlonzGenesis' for more details) - -> NodeConfig + => NodeConfig -> t m AlonzoGenesis -readAlonzoGenesisConfig mEra enc = do +readAlonzoGenesisConfig enc = do let file = ncAlonzoGenesisFile enc modifyError (NEAlonzoConfig (unFile file) . renderAlonzoGenesisError) $ - readAlonzoGenesis mEra file (ncAlonzoGenesisHash enc) + readAlonzoGenesis file (ncAlonzoGenesisHash enc) -- | If the conway genesis file does not exist we simply put in a default. readConwayGenesisConfig @@ -1634,21 +1673,18 @@ renderShelleyGenesisError sge = ] readAlonzoGenesis - :: forall m t era + :: forall m t . MonadIOTransError AlonzoGenesisError t m - => Maybe (CardanoEra era) - -- ^ Provide era witness to read Alonzo Genesis in an era-sensitive manner (see - -- 'Cardano.Api.Genesis.Internal.decodeAlonzGenesis' for more details) - -> File AlonzoGenesis 'In + => File AlonzoGenesis 'In -> GenesisHashAlonzo -> t m AlonzoGenesis -readAlonzoGenesis mEra (File file) expectedGenesisHash = do +readAlonzoGenesis (File file) expectedGenesisHash = do content <- modifyError id $ handleIOExceptT (AlonzoGenesisReadError file . textShow) $ LBS.readFile file let genesisHash = GenesisHashAlonzo . Cardano.Crypto.Hash.Class.hashWith id $ LBS.toStrict content checkExpectedGenesisHash genesisHash - modifyError (AlonzoGenesisDecodeError file . Text.pack) $ - decodeAlonzoGenesis mEra content + modifyError (AlonzoGenesisDecodeError file . Text.pack) . liftEither $ + A.eitherDecode content where checkExpectedGenesisHash :: GenesisHashAlonzo -> t m () checkExpectedGenesisHash actual = @@ -2261,6 +2297,7 @@ getLedgerTablesUTxOValues sbe tbs = ShelleyBasedEraAlonzo -> ejectTables (IS (IS (IS (IS IZ)))) ShelleyBasedEraBabbage -> ejectTables (IS (IS (IS (IS (IS IZ))))) ShelleyBasedEraConway -> ejectTables (IS (IS (IS (IS (IS (IS IZ)))))) + ShelleyBasedEraDijkstra -> ejectTables (IS (IS (IS (IS (IS (IS (IS IZ))))))) -- | Reconstructs the ledger's new epoch state and applies a supplied condition to it for every block. This -- function only terminates if the condition is met or we have reached the termination epoch. We need to diff --git a/cardano-api/src/Cardano/Api/LedgerState/Internal/LedgerEvent.hs b/cardano-api/src/Cardano/Api/LedgerState/Internal/LedgerEvent.hs index aba7ff0737..4e12859834 100644 --- a/cardano-api/src/Cardano/Api/LedgerState/Internal/LedgerEvent.hs +++ b/cardano-api/src/Cardano/Api/LedgerState/Internal/LedgerEvent.hs @@ -20,6 +20,7 @@ import Cardano.Api.Key.Internal (Hash (..), StakePoolKey) import Cardano.Ledger.Coin qualified as L import Cardano.Ledger.Coin qualified as Ledger +import Cardano.Ledger.Compactible qualified as Ledger import Cardano.Ledger.Conway.Governance qualified as Ledger import Cardano.Ledger.Core qualified as Ledger.Core import Cardano.Ledger.Credential qualified as Ledger @@ -110,8 +111,9 @@ data PoolReapDetails = PoolReapDetails convertRetiredPoolsMap :: Map Ledger.StakeCredential - (Map (Ledger.KeyHash Ledger.StakePool) Ledger.Coin) + (Map (Ledger.KeyHash Ledger.StakePool) (Ledger.CompactForm Ledger.Coin)) -> Map StakeCredential (Map (Hash StakePoolKey) L.Coin) convertRetiredPoolsMap = Map.mapKeys fromShelleyStakeCredential . fmap (Map.mapKeys StakePoolKeyHash) + . (fmap . fmap) Ledger.fromCompact diff --git a/cardano-api/src/Cardano/Api/Network/IPC.hs b/cardano-api/src/Cardano/Api/Network/IPC.hs index f896d2f2c1..1e05eeacef 100644 --- a/cardano-api/src/Cardano/Api/Network/IPC.hs +++ b/cardano-api/src/Cardano/Api/Network/IPC.hs @@ -219,6 +219,7 @@ module Cardano.Api.Network.IPC -- **** Query monad , LocalStateQueryExpr , executeLocalStateQueryExpr + , executeLocalStateQueryExprWithVersion , queryExpr -- *** Local tx monitoring diff --git a/cardano-api/src/Cardano/Api/Network/IPC/Internal.hs b/cardano-api/src/Cardano/Api/Network/IPC/Internal.hs index 1b095bb73a..bfd4945148 100644 --- a/cardano-api/src/Cardano/Api/Network/IPC/Internal.hs +++ b/cardano-api/src/Cardano/Api/Network/IPC/Internal.hs @@ -132,6 +132,7 @@ import Data.ByteString.Lazy qualified as LBS import Data.Void (Void) import GHC.Exts (IsList (..)) import Network.Mux qualified as Net +import Network.Mux.Trace (nullTracers) -- ---------------------------------------------------------------------------- -- The types for the client side of the node-to-client IPC protocols @@ -211,7 +212,7 @@ connectToLocalNodeWithVersion Net.connectTo (Net.localSnocket iomgr) Net.NetworkConnectTracers - { Net.nctMuxTracer = nullTracer + { Net.nctMuxTracers = nullTracers , Net.nctHandshakeTracer = nullTracer } versionedProtocls diff --git a/cardano-api/src/Cardano/Api/Network/IPC/Internal/Monad.hs b/cardano-api/src/Cardano/Api/Network/IPC/Internal/Monad.hs index b294a364d3..648dfabc8d 100644 --- a/cardano-api/src/Cardano/Api/Network/IPC/Internal/Monad.hs +++ b/cardano-api/src/Cardano/Api/Network/IPC/Internal/Monad.hs @@ -5,6 +5,7 @@ module Cardano.Api.Network.IPC.Internal.Monad ( LocalStateQueryExpr , executeLocalStateQueryExpr + , executeLocalStateQueryExprWithVersion , queryExpr ) where @@ -44,6 +45,31 @@ newtype LocalStateQueryExpr block point query r m a = LocalStateQueryExpr } deriving (Functor, Applicative, Monad, MonadReader NodeToClientVersion, MonadIO) +-- | Execute a local state query expression. +executeLocalStateQueryExprWithVersion + :: () + => LocalNodeConnectInfo + -> Net.Query.Target ChainPoint + -> (NodeToClientVersion -> LocalStateQueryExpr BlockInMode ChainPoint QueryInMode () IO a) + -> IO (Either AcquiringFailure a) +executeLocalStateQueryExprWithVersion connectInfo target f = do + tmvResultLocalState <- newEmptyTMVarIO + let waitResult = readTMVar tmvResultLocalState + + connectToLocalNodeWithVersion + connectInfo + ( \ntcVersion -> + LocalNodeClientProtocols + { localChainSyncClient = NoLocalChainSyncClient + , localStateQueryClient = + Just $ setupLocalStateQueryExpr waitResult target tmvResultLocalState ntcVersion (f ntcVersion) + , localTxSubmissionClient = Nothing + , localTxMonitoringClient = Nothing + } + ) + + atomically waitResult + -- | Execute a local state query expression. executeLocalStateQueryExpr :: () diff --git a/cardano-api/src/Cardano/Api/Plutus.hs b/cardano-api/src/Cardano/Api/Plutus.hs index 2c5a7fe96d..4b6674cc56 100644 --- a/cardano-api/src/Cardano/Api/Plutus.hs +++ b/cardano-api/src/Cardano/Api/Plutus.hs @@ -4,6 +4,7 @@ module Cardano.Api.Plutus , PlutusScriptV1 , PlutusScriptV2 , PlutusScriptV3 + , PlutusScriptV4 , ScriptLanguage (..) , PlutusScriptVersion (..) , AnyScriptLanguage (..) diff --git a/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs b/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs index c36abb2bbf..95784a49f2 100644 --- a/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs +++ b/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs @@ -24,6 +24,7 @@ module Cardano.Api.Plutus.Internal.Script , PlutusScriptV1 , PlutusScriptV2 , PlutusScriptV3 + , PlutusScriptV4 , ScriptLanguage (..) , PlutusScriptVersion (..) , AnyScriptLanguage (..) @@ -149,6 +150,7 @@ import Cardano.Ledger.BaseTypes (StrictMaybe (..)) import Cardano.Ledger.Binary qualified as Binary (decCBOR, decodeFullAnnotator) import Cardano.Ledger.Conway.Scripts qualified as Conway import Cardano.Ledger.Core qualified as Ledger +import Cardano.Ledger.Dijkstra.Scripts qualified as Dijkstra import Cardano.Ledger.Keys qualified as Shelley import Cardano.Ledger.Plutus.Language qualified as Plutus import Cardano.Ledger.Shelley.Scripts qualified as Shelley @@ -215,6 +217,8 @@ data PlutusScriptV2 data PlutusScriptV3 +data PlutusScriptV4 + instance HasTypeProxy SimpleScript' where data AsType SimpleScript' = AsSimpleScript proxyToAsType _ = AsSimpleScript @@ -232,6 +236,10 @@ instance HasTypeProxy PlutusScriptV3 where data AsType PlutusScriptV3 = AsPlutusScriptV3 proxyToAsType _ = AsPlutusScriptV3 +instance HasTypeProxy PlutusScriptV4 where + data AsType PlutusScriptV4 = AsPlutusScriptV4 + proxyToAsType _ = AsPlutusScriptV4 + -- ---------------------------------------------------------------------------- -- Value level representation for script languages -- @@ -255,6 +263,7 @@ data PlutusScriptVersion lang where PlutusScriptV1 :: PlutusScriptVersion PlutusScriptV1 PlutusScriptV2 :: PlutusScriptVersion PlutusScriptV2 PlutusScriptV3 :: PlutusScriptVersion PlutusScriptV3 + PlutusScriptV4 :: PlutusScriptVersion PlutusScriptV4 deriving instance (Eq (PlutusScriptVersion lang)) @@ -264,6 +273,7 @@ instance TestEquality PlutusScriptVersion where testEquality PlutusScriptV1 PlutusScriptV1 = Just Refl testEquality PlutusScriptV2 PlutusScriptV2 = Just Refl testEquality PlutusScriptV3 PlutusScriptV3 = Just Refl + testEquality PlutusScriptV4 PlutusScriptV4 = Just Refl testEquality _ _ = Nothing data AnyScriptLanguage where @@ -288,6 +298,7 @@ instance Enum AnyScriptLanguage where fromEnum (AnyScriptLanguage (PlutusScriptLanguage PlutusScriptV1)) = 1 fromEnum (AnyScriptLanguage (PlutusScriptLanguage PlutusScriptV2)) = 2 fromEnum (AnyScriptLanguage (PlutusScriptLanguage PlutusScriptV3)) = 3 + fromEnum (AnyScriptLanguage (PlutusScriptLanguage PlutusScriptV4)) = 4 instance Bounded AnyScriptLanguage where minBound = AnyScriptLanguage SimpleScriptLanguage @@ -316,6 +327,7 @@ instance Enum AnyPlutusScriptVersion where fromEnum (AnyPlutusScriptVersion PlutusScriptV1) = 0 fromEnum (AnyPlutusScriptVersion PlutusScriptV2) = 1 fromEnum (AnyPlutusScriptVersion PlutusScriptV3) = 2 + fromEnum (AnyPlutusScriptVersion PlutusScriptV4) = 3 instance Bounded AnyPlutusScriptVersion where minBound = AnyPlutusScriptVersion PlutusScriptV1 @@ -339,6 +351,8 @@ instance ToJSON AnyPlutusScriptVersion where Aeson.String "PlutusScriptV2" toJSON (AnyPlutusScriptVersion PlutusScriptV3) = Aeson.String "PlutusScriptV3" + toJSON (AnyPlutusScriptVersion PlutusScriptV4) = + Aeson.String "PlutusScriptV4" parsePlutusScriptVersion :: Text -> Aeson.Parser AnyPlutusScriptVersion parsePlutusScriptVersion t = @@ -361,16 +375,19 @@ instance Aeson.ToJSONKey AnyPlutusScriptVersion where toText (AnyPlutusScriptVersion PlutusScriptV1) = "PlutusScriptV1" toText (AnyPlutusScriptVersion PlutusScriptV2) = "PlutusScriptV2" toText (AnyPlutusScriptVersion PlutusScriptV3) = "PlutusScriptV3" + toText (AnyPlutusScriptVersion PlutusScriptV4) = "PlutusScriptV4" toAlonzoLanguage :: AnyPlutusScriptVersion -> Plutus.Language toAlonzoLanguage (AnyPlutusScriptVersion PlutusScriptV1) = Plutus.PlutusV1 toAlonzoLanguage (AnyPlutusScriptVersion PlutusScriptV2) = Plutus.PlutusV2 toAlonzoLanguage (AnyPlutusScriptVersion PlutusScriptV3) = Plutus.PlutusV3 +toAlonzoLanguage (AnyPlutusScriptVersion PlutusScriptV4) = Plutus.PlutusV4 fromAlonzoLanguage :: Plutus.Language -> AnyPlutusScriptVersion fromAlonzoLanguage Plutus.PlutusV1 = AnyPlutusScriptVersion PlutusScriptV1 fromAlonzoLanguage Plutus.PlutusV2 = AnyPlutusScriptVersion PlutusScriptV2 fromAlonzoLanguage Plutus.PlutusV3 = AnyPlutusScriptVersion PlutusScriptV3 +fromAlonzoLanguage Plutus.PlutusV4 = AnyPlutusScriptVersion PlutusScriptV3 class HasTypeProxy lang => IsScriptLanguage lang where scriptLanguage :: ScriptLanguage lang @@ -387,6 +404,9 @@ instance IsScriptLanguage PlutusScriptV2 where instance IsScriptLanguage PlutusScriptV3 where scriptLanguage = PlutusScriptLanguage PlutusScriptV3 +instance IsScriptLanguage PlutusScriptV4 where + scriptLanguage = PlutusScriptLanguage PlutusScriptV4 + class IsScriptLanguage lang => IsPlutusScriptLanguage lang where plutusScriptVersion :: PlutusScriptVersion lang @@ -399,6 +419,9 @@ instance IsPlutusScriptLanguage PlutusScriptV2 where instance IsPlutusScriptLanguage PlutusScriptV3 where plutusScriptVersion = PlutusScriptV3 +instance IsPlutusScriptLanguage PlutusScriptV4 where + plutusScriptVersion = PlutusScriptV4 + -- ---------------------------------------------------------------------------- -- Script type: covering all script languages -- @@ -440,6 +463,8 @@ instance IsScriptLanguage lang => SerialiseAsCBOR (Script lang) where SBS.fromShort s serialiseToCBOR (PlutusScript PlutusScriptV3 (PlutusScriptSerialised s)) = SBS.fromShort s + serialiseToCBOR (PlutusScript PlutusScriptV4 (PlutusScriptSerialised s)) = + SBS.fromShort s deserialiseFromCBOR _ bs = case scriptLanguage :: ScriptLanguage lang of @@ -456,6 +481,9 @@ instance IsScriptLanguage lang => SerialiseAsCBOR (Script lang) where PlutusScriptLanguage PlutusScriptV3 -> PlutusScript PlutusScriptV3 <$> deserialiseFromCBOR (AsPlutusScript AsPlutusScriptV3) bs + PlutusScriptLanguage PlutusScriptV4 -> + PlutusScript PlutusScriptV4 + <$> deserialiseFromCBOR (AsPlutusScript AsPlutusScriptV4) bs -- | Previously we were double encoding the plutus script -- bytes. This function removes a layer of encoding to return @@ -479,6 +507,7 @@ instance IsScriptLanguage lang => HasTextEnvelope (Script lang) where PlutusScriptLanguage PlutusScriptV1 -> "PlutusScriptV1" PlutusScriptLanguage PlutusScriptV2 -> "PlutusScriptV2" PlutusScriptLanguage PlutusScriptV3 -> "PlutusScriptV3" + PlutusScriptLanguage PlutusScriptV4 -> "PlutusScriptV4" -- ---------------------------------------------------------------------------- -- Scripts in any language @@ -524,6 +553,7 @@ instance ToJSON ScriptInAnyLang where obtainScriptLangConstraint (PlutusScriptLanguage PlutusScriptV1) f = f obtainScriptLangConstraint (PlutusScriptLanguage PlutusScriptV2) f = f obtainScriptLangConstraint (PlutusScriptLanguage PlutusScriptV3) f = f + obtainScriptLangConstraint (PlutusScriptLanguage PlutusScriptV4) f = f instance FromJSON ScriptInAnyLang where parseJSON = Aeson.withObject "ScriptInAnyLang" $ \o -> do @@ -577,12 +607,17 @@ data ScriptLanguageInEra lang era where SimpleScriptInAlonzo :: ScriptLanguageInEra SimpleScript' AlonzoEra SimpleScriptInBabbage :: ScriptLanguageInEra SimpleScript' BabbageEra SimpleScriptInConway :: ScriptLanguageInEra SimpleScript' ConwayEra + SimpleScriptInDijkstra :: ScriptLanguageInEra SimpleScript' DijkstraEra PlutusScriptV1InAlonzo :: ScriptLanguageInEra PlutusScriptV1 AlonzoEra PlutusScriptV1InBabbage :: ScriptLanguageInEra PlutusScriptV1 BabbageEra PlutusScriptV1InConway :: ScriptLanguageInEra PlutusScriptV1 ConwayEra + PlutusScriptV1InDijkstra :: ScriptLanguageInEra PlutusScriptV1 DijkstraEra PlutusScriptV2InBabbage :: ScriptLanguageInEra PlutusScriptV2 BabbageEra PlutusScriptV2InConway :: ScriptLanguageInEra PlutusScriptV2 ConwayEra + PlutusScriptV2InDijkstra :: ScriptLanguageInEra PlutusScriptV2 DijkstraEra PlutusScriptV3InConway :: ScriptLanguageInEra PlutusScriptV3 ConwayEra + PlutusScriptV3InDijkstra :: ScriptLanguageInEra PlutusScriptV3 DijkstraEra + PlutusScriptV4InDijkstra :: ScriptLanguageInEra PlutusScriptV4 DijkstraEra deriving instance Eq (ScriptLanguageInEra lang era) @@ -632,12 +667,17 @@ languageOfScriptLanguageInEra langInEra = SimpleScriptInAlonzo -> SimpleScriptLanguage SimpleScriptInBabbage -> SimpleScriptLanguage SimpleScriptInConway -> SimpleScriptLanguage + SimpleScriptInDijkstra -> SimpleScriptLanguage PlutusScriptV1InAlonzo -> PlutusScriptLanguage PlutusScriptV1 PlutusScriptV1InBabbage -> PlutusScriptLanguage PlutusScriptV1 PlutusScriptV1InConway -> PlutusScriptLanguage PlutusScriptV1 + PlutusScriptV1InDijkstra -> PlutusScriptLanguage PlutusScriptV1 PlutusScriptV2InBabbage -> PlutusScriptLanguage PlutusScriptV2 PlutusScriptV2InConway -> PlutusScriptLanguage PlutusScriptV2 + PlutusScriptV2InDijkstra -> PlutusScriptLanguage PlutusScriptV2 PlutusScriptV3InConway -> PlutusScriptLanguage PlutusScriptV3 + PlutusScriptV3InDijkstra -> PlutusScriptLanguage PlutusScriptV3 + PlutusScriptV4InDijkstra -> PlutusScriptLanguage PlutusScriptV4 sbeToSimpleScriptLanguageInEra :: ShelleyBasedEra era @@ -649,6 +689,7 @@ sbeToSimpleScriptLanguageInEra = \case ShelleyBasedEraAlonzo -> SimpleScriptInAlonzo ShelleyBasedEraBabbage -> SimpleScriptInBabbage ShelleyBasedEraConway -> SimpleScriptInConway + ShelleyBasedEraDijkstra -> SimpleScriptInDijkstra eraOfScriptLanguageInEra :: ScriptLanguageInEra lang era @@ -660,12 +701,17 @@ eraOfScriptLanguageInEra = \case SimpleScriptInAlonzo -> ShelleyBasedEraAlonzo SimpleScriptInBabbage -> ShelleyBasedEraBabbage SimpleScriptInConway -> ShelleyBasedEraConway + SimpleScriptInDijkstra -> ShelleyBasedEraDijkstra PlutusScriptV1InAlonzo -> ShelleyBasedEraAlonzo PlutusScriptV1InBabbage -> ShelleyBasedEraBabbage PlutusScriptV1InConway -> ShelleyBasedEraConway + PlutusScriptV1InDijkstra -> ShelleyBasedEraDijkstra PlutusScriptV2InBabbage -> ShelleyBasedEraBabbage PlutusScriptV2InConway -> ShelleyBasedEraConway + PlutusScriptV2InDijkstra -> ShelleyBasedEraDijkstra PlutusScriptV3InConway -> ShelleyBasedEraConway + PlutusScriptV3InDijkstra -> ShelleyBasedEraDijkstra + PlutusScriptV4InDijkstra -> ShelleyBasedEraDijkstra -- | 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'. @@ -1010,6 +1056,13 @@ hashScript (PlutusScript PlutusScriptV3 (PlutusScriptSerialised script)) = . Conway.ConwayPlutusV3 . Plutus.Plutus $ Plutus.PlutusBinary script +hashScript (PlutusScript PlutusScriptV4 (PlutusScriptSerialised script)) = + ScriptHash + . Ledger.hashScript @(ShelleyLedgerEra DijkstraEra) + . Alonzo.PlutusScript + . Dijkstra.DijkstraPlutusV4 + . Plutus.Plutus + $ Plutus.PlutusBinary script toShelleyScriptHash :: ScriptHash -> Ledger.ScriptHash toShelleyScriptHash (ScriptHash h) = h @@ -1069,6 +1122,7 @@ instance IsPlutusScriptLanguage lang => HasTextEnvelope (PlutusScript lang) wher PlutusScriptV1 -> "PlutusScriptV1" PlutusScriptV2 -> "PlutusScriptV2" PlutusScriptV3 -> "PlutusScriptV3" + PlutusScriptV4 -> "PlutusScriptV4" -- | Smart-constructor for 'ScriptLanguageInEra' to write functions -- manipulating scripts that do not commit to a particular era. @@ -1188,9 +1242,10 @@ toShelleyScript (ScriptInEra langInEra (SimpleScript script)) = SimpleScriptInShelley -> either (error . show) id (toShelleyMultiSig script) SimpleScriptInAllegra -> toAllegraTimelock script SimpleScriptInMary -> toAllegraTimelock script - SimpleScriptInAlonzo -> Alonzo.TimelockScript (toAllegraTimelock script) - SimpleScriptInBabbage -> Alonzo.TimelockScript (toAllegraTimelock script) - SimpleScriptInConway -> Alonzo.TimelockScript (toAllegraTimelock script) + SimpleScriptInAlonzo -> Alonzo.NativeScript (toAllegraTimelock script) + SimpleScriptInBabbage -> Alonzo.NativeScript (toAllegraTimelock script) + SimpleScriptInConway -> Alonzo.NativeScript (toAllegraTimelock script) + SimpleScriptInDijkstra -> Alonzo.NativeScript (toAllegraTimelock script) toShelleyScript ( ScriptInEra langInEra @@ -1206,6 +1261,9 @@ toShelleyScript Alonzo.PlutusScript . Babbage.BabbagePlutusV1 . Plutus.Plutus $ Plutus.PlutusBinary script PlutusScriptV1InConway -> Alonzo.PlutusScript . Conway.ConwayPlutusV1 . Plutus.Plutus $ Plutus.PlutusBinary script + PlutusScriptV1InDijkstra -> + Alonzo.PlutusScript . Dijkstra.DijkstraPlutusV1 . Plutus.Plutus $ + Plutus.PlutusBinary script toShelleyScript ( ScriptInEra langInEra @@ -1219,6 +1277,9 @@ toShelleyScript Alonzo.PlutusScript . Babbage.BabbagePlutusV2 . Plutus.Plutus $ Plutus.PlutusBinary script PlutusScriptV2InConway -> Alonzo.PlutusScript . Conway.ConwayPlutusV2 . Plutus.Plutus $ Plutus.PlutusBinary script + PlutusScriptV2InDijkstra -> + Alonzo.PlutusScript . Dijkstra.DijkstraPlutusV2 . Plutus.Plutus $ + Plutus.PlutusBinary script toShelleyScript ( ScriptInEra langInEra @@ -1230,6 +1291,25 @@ toShelleyScript case langInEra of PlutusScriptV3InConway -> Alonzo.PlutusScript . Conway.ConwayPlutusV3 . Plutus.Plutus $ Plutus.PlutusBinary script + PlutusScriptV3InDijkstra -> + Alonzo.PlutusScript . Dijkstra.DijkstraPlutusV3 . Plutus.Plutus $ + Plutus.PlutusBinary script +toShelleyScript + ( ScriptInEra + _langInEra + ( PlutusScript + PlutusScriptV4 + (PlutusScriptSerialised _script) + ) + ) = error "toShelleyScript: PlutusV4 not implemented yet." + +-- TODO: Ledger needs to introduce a plutusV4 constructor +-- case langInEra of +-- PlutusScriptV4InConway -> +-- Alonzo.PlutusScript . Conway.ConwayPlutusV3 . Plutus.Plutus $ Plutus.PlutusBinary script +-- PlutusScriptV4InDijkstra -> +-- Alonzo.PlutusScript . Dijkstra.MkDijkstraPlutusScript . Conway.ConwayPlutusV3 . Plutus.Plutus $ +-- Plutus.PlutusBinary script fromShelleyBasedScript :: ShelleyBasedEra era @@ -1255,7 +1335,7 @@ fromShelleyBasedScript sbe script = ScriptInEra PlutusScriptV1InAlonzo . PlutusScript PlutusScriptV1 $ PlutusScriptSerialised s - Alonzo.TimelockScript s -> + Alonzo.NativeScript s -> ScriptInEra SimpleScriptInAlonzo . SimpleScript $ fromAllegraTimelock s @@ -1271,7 +1351,7 @@ fromShelleyBasedScript sbe script = ScriptInEra PlutusScriptV2InBabbage . PlutusScript PlutusScriptV2 $ PlutusScriptSerialised s - Alonzo.TimelockScript s -> + Alonzo.NativeScript s -> ScriptInEra SimpleScriptInBabbage . SimpleScript $ fromAllegraTimelock s @@ -1291,10 +1371,35 @@ fromShelleyBasedScript sbe script = ScriptInEra PlutusScriptV3InConway . PlutusScript PlutusScriptV3 $ PlutusScriptSerialised s - Alonzo.TimelockScript s -> + Alonzo.NativeScript s -> ScriptInEra SimpleScriptInConway . SimpleScript $ fromAllegraTimelock s + ShelleyBasedEraDijkstra -> + case script of + (Alonzo.PlutusScript dijkstraScript) -> + case dijkstraScript of + Dijkstra.DijkstraPlutusV1 (PlutusScriptBinary s) -> + ScriptInEra PlutusScriptV1InDijkstra + . PlutusScript PlutusScriptV1 + $ PlutusScriptSerialised s + Dijkstra.DijkstraPlutusV2 (PlutusScriptBinary s) -> + ScriptInEra PlutusScriptV2InDijkstra + . PlutusScript PlutusScriptV2 + $ PlutusScriptSerialised s + Dijkstra.DijkstraPlutusV3 (PlutusScriptBinary s) -> + ScriptInEra PlutusScriptV3InDijkstra + . PlutusScript PlutusScriptV3 + $ PlutusScriptSerialised s + Dijkstra.DijkstraPlutusV4 (PlutusScriptBinary s) -> + ScriptInEra + PlutusScriptV3InDijkstra + . PlutusScript PlutusScriptV3 + $ PlutusScriptSerialised s + Alonzo.NativeScript s -> + ScriptInEra SimpleScriptInDijkstra + . SimpleScript + $ fromAllegraTimelock s data MultiSigError = MultiSigErrorTimelockNotsupported deriving Show @@ -1356,11 +1461,13 @@ fromAllegraTimelock = go go (Shelley.RequireAllOf s) = RequireAllOf (map go (toList s)) go (Shelley.RequireAnyOf s) = RequireAnyOf (map go (toList s)) go (Shelley.RequireMOf i s) = RequireMOf i (map go (toList s)) + go _ = error "dijkstra" type family ToLedgerPlutusLanguage lang where ToLedgerPlutusLanguage PlutusScriptV1 = Plutus.PlutusV1 ToLedgerPlutusLanguage PlutusScriptV2 = Plutus.PlutusV2 ToLedgerPlutusLanguage PlutusScriptV3 = Plutus.PlutusV3 + ToLedgerPlutusLanguage PlutusScriptV4 = Plutus.PlutusV4 data PlutusScriptInEra era lang where PlutusScriptInEra :: PlutusScript lang -> PlutusScriptInEra era lang diff --git a/cardano-api/src/Cardano/Api/ProtocolParameters.hs b/cardano-api/src/Cardano/Api/ProtocolParameters.hs index 12df9d4206..3acfa37fc1 100644 --- a/cardano-api/src/Cardano/Api/ProtocolParameters.hs +++ b/cardano-api/src/Cardano/Api/ProtocolParameters.hs @@ -1024,11 +1024,13 @@ toAlonzoScriptLanguage :: AnyPlutusScriptVersion -> Plutus.Language toAlonzoScriptLanguage (AnyPlutusScriptVersion PlutusScriptV1) = Plutus.PlutusV1 toAlonzoScriptLanguage (AnyPlutusScriptVersion PlutusScriptV2) = Plutus.PlutusV2 toAlonzoScriptLanguage (AnyPlutusScriptVersion PlutusScriptV3) = Plutus.PlutusV3 +toAlonzoScriptLanguage (AnyPlutusScriptVersion PlutusScriptV4) = Plutus.PlutusV4 fromAlonzoScriptLanguage :: Plutus.Language -> AnyPlutusScriptVersion fromAlonzoScriptLanguage Plutus.PlutusV1 = AnyPlutusScriptVersion PlutusScriptV1 fromAlonzoScriptLanguage Plutus.PlutusV2 = AnyPlutusScriptVersion PlutusScriptV2 fromAlonzoScriptLanguage Plutus.PlutusV3 = AnyPlutusScriptVersion PlutusScriptV3 +fromAlonzoScriptLanguage Plutus.PlutusV4 = AnyPlutusScriptVersion PlutusScriptV4 toAlonzoCostModel :: CostModel -> Plutus.Language -> Either ProtocolParametersConversionError Alonzo.CostModel @@ -1111,6 +1113,7 @@ toLedgerPParamsUpdate ShelleyBasedEraMary = toShelleyPParamsUpdate toLedgerPParamsUpdate ShelleyBasedEraAlonzo = toAlonzoPParamsUpdate toLedgerPParamsUpdate ShelleyBasedEraBabbage = toBabbagePParamsUpdate toLedgerPParamsUpdate ShelleyBasedEraConway = toConwayPParamsUpdate +toLedgerPParamsUpdate ShelleyBasedEraDijkstra = toConwayPParamsUpdate toShelleyCommonPParamsUpdate :: EraPParams ledgerera @@ -1154,9 +1157,9 @@ toShelleyCommonPParamsUpdate toShelleyPParamsUpdate :: ( EraPParams ledgerera - , Ledger.AtMostEra Ledger.MaryEra ledgerera - , Ledger.AtMostEra Ledger.AlonzoEra ledgerera - , Ledger.AtMostEra Ledger.BabbageEra ledgerera + , Ledger.AtMostEra "Mary" ledgerera + , Ledger.AtMostEra "Alonzo" ledgerera + , Ledger.AtMostEra "Babbage" ledgerera ) => ProtocolParametersUpdate -> Either ProtocolParametersConversionError (PParamsUpdate ledgerera) @@ -1310,6 +1313,7 @@ fromLedgerPParamsUpdate ShelleyBasedEraMary = fromShelleyPParamsUpdate fromLedgerPParamsUpdate ShelleyBasedEraAlonzo = fromAlonzoPParamsUpdate fromLedgerPParamsUpdate ShelleyBasedEraBabbage = fromBabbagePParamsUpdate fromLedgerPParamsUpdate ShelleyBasedEraConway = fromConwayPParamsUpdate +fromLedgerPParamsUpdate ShelleyBasedEraDijkstra = fromConwayPParamsUpdate fromShelleyCommonPParamsUpdate :: EraPParams ledgerera @@ -1346,9 +1350,9 @@ fromShelleyCommonPParamsUpdate ppu = fromShelleyPParamsUpdate :: ( EraPParams ledgerera - , Ledger.AtMostEra Ledger.MaryEra ledgerera - , Ledger.AtMostEra Ledger.AlonzoEra ledgerera - , Ledger.AtMostEra Ledger.BabbageEra ledgerera + , Ledger.AtMostEra "Mary" ledgerera + , Ledger.AtMostEra "Alonzo" ledgerera + , Ledger.AtMostEra "Babbage" ledgerera ) => PParamsUpdate ledgerera -> ProtocolParametersUpdate diff --git a/cardano-api/src/Cardano/Api/Query/Internal/Convenience.hs b/cardano-api/src/Cardano/Api/Query/Internal/Convenience.hs index b85c89e1f4..707df706ba 100644 --- a/cardano-api/src/Cardano/Api/Query/Internal/Convenience.hs +++ b/cardano-api/src/Cardano/Api/Query/Internal/Convenience.hs @@ -36,11 +36,10 @@ import Cardano.Api.Query.Internal.Type.QueryInMode import Cardano.Api.Tx.Internal.Body import Cardano.Api.UTxO (UTxO (..)) -import Cardano.Ledger.CertState (DRepState (..)) import Cardano.Ledger.Coin qualified as L +import Cardano.Ledger.Conway.State (ChainAccountState (..), DRepState (..)) import Cardano.Ledger.Credential qualified as L import Cardano.Ledger.Keys qualified as L -import Cardano.Ledger.Shelley.LedgerState qualified as L import Ouroboros.Consensus.HardFork.Combinator.AcrossEras (EraMismatch (..)) import Ouroboros.Network.Protocol.LocalStateQuery.Type (Target (..)) @@ -114,7 +113,7 @@ queryStateForBalancedTx , SystemStart , Set PoolId , Map StakeCredential L.Coin - , Map (L.Credential L.DRepRole) L.Coin + , Map (L.Credential L.DRepRole) (L.CompactForm L.Coin) , Maybe (Featured ConwayEraOnwards era TxCurrentTreasuryValue) ) ) @@ -168,11 +167,11 @@ queryStateForBalancedTx era allTxIns certs = runExceptT $ do caseShelleyToBabbageOrConwayEraOnwards (const $ pure Nothing) ( \cOnwards -> do - L.AccountState{L.asTreasury} <- + ChainAccountState{casTreasury} <- lift (queryAccountState cOnwards) & onLeft (left . QceUnsupportedNtcVersion) & onLeft (left . QueryEraMismatch) - let txCurrentTreasuryValue = TxCurrentTreasuryValue asTreasury + let txCurrentTreasuryValue = TxCurrentTreasuryValue casTreasury return $ Just $ Featured cOnwards txCurrentTreasuryValue ) sbe diff --git a/cardano-api/src/Cardano/Api/Query/Internal/Expr.hs b/cardano-api/src/Cardano/Api/Query/Internal/Expr.hs index 46f0b305dd..e33e0de3e1 100644 --- a/cardano-api/src/Cardano/Api/Query/Internal/Expr.hs +++ b/cardano-api/src/Cardano/Api/Query/Internal/Expr.hs @@ -59,12 +59,11 @@ import Cardano.Api.UTxO import Cardano.Ledger.Api qualified as L import Cardano.Ledger.Api.State.Query qualified as L -import Cardano.Ledger.CertState qualified as L import Cardano.Ledger.Coin qualified as L +import Cardano.Ledger.Conway.State qualified as L import Cardano.Ledger.Credential qualified as L import Cardano.Ledger.Hashes hiding (Hash) import Cardano.Ledger.Keys qualified as L -import Cardano.Ledger.Shelley.LedgerState qualified as L import Cardano.Slotting.Slot import Ouroboros.Consensus.Cardano.Block qualified as Consensus import Ouroboros.Consensus.HardFork.Combinator.AcrossEras as Consensus @@ -204,7 +203,7 @@ queryPoolState QueryInMode r IO - (Either UnsupportedNtcVersionError (Either EraMismatch (SerialisedPoolState era))) + (Either UnsupportedNtcVersionError (Either EraMismatch SerialisedPoolState)) queryPoolState eon = querySbe eon . QueryPoolState queryProtocolParameters @@ -484,7 +483,7 @@ queryAccountState QueryInMode r IO - (Either UnsupportedNtcVersionError (Either EraMismatch L.AccountState)) + (Either UnsupportedNtcVersionError (Either EraMismatch L.ChainAccountState)) queryAccountState eon = querySbe eon QueryAccountState queryProposals diff --git a/cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs b/cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs index e9b7913450..a4811a65b6 100644 --- a/cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs +++ b/cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs @@ -72,6 +72,7 @@ import Cardano.Api.Certificate.Internal import Cardano.Api.Consensus.Internal.Mode import Cardano.Api.Era.Internal.Case import Cardano.Api.Era.Internal.Core +import Cardano.Api.Era.Internal.Eon.ConwayEraOnwards import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra import Cardano.Api.Genesis.Internal.Parameters import Cardano.Api.HasTypeProxy (HasTypeProxy (..), Proxy) @@ -93,12 +94,11 @@ import Cardano.Ledger.Api qualified as L import Cardano.Ledger.Api.State.Query qualified as L import Cardano.Ledger.Binary import Cardano.Ledger.Binary.Plain qualified as Plain -import Cardano.Ledger.CertState qualified as L import Cardano.Ledger.Coin qualified as L +import Cardano.Ledger.Conway.State qualified as L import Cardano.Ledger.Credential qualified as Shelley import Cardano.Ledger.Shelley.API qualified as Shelley import Cardano.Ledger.Shelley.Core qualified as Core -import Cardano.Ledger.Shelley.LedgerState qualified as L import Cardano.Slotting.EpochInfo (hoistEpochInfo) import Cardano.Slotting.Slot (WithOrigin (..)) import Cardano.Slotting.Time (SystemStart (..)) @@ -116,9 +116,8 @@ import Ouroboros.Consensus.Ledger.Query qualified as Consensus import Ouroboros.Consensus.Protocol.Abstract qualified as Consensus import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus import Ouroboros.Consensus.Shelley.Ledger.Query.Types qualified as Consensus -import Ouroboros.Consensus.Shelley.Protocol.Abstract (ProtoCrypto) import Ouroboros.Network.Block (Serialised (..)) -import Ouroboros.Network.PeerSelection.LedgerPeers.Type (LedgerPeerSnapshot) +import Ouroboros.Network.PeerSelection.LedgerPeers.Type import Ouroboros.Network.Protocol.LocalStateQuery.Client (Some (..)) import Codec.Serialise qualified as CBOR @@ -275,7 +274,7 @@ data QueryInShelleyBasedEra era result where :: QueryInShelleyBasedEra era (SerialisedCurrentEpochState era) QueryPoolState :: Maybe (Set PoolId) - -> QueryInShelleyBasedEra era (SerialisedPoolState era) + -> QueryInShelleyBasedEra era SerialisedPoolState QueryPoolDistribution :: Maybe (Set PoolId) -> QueryInShelleyBasedEra era (SerialisedPoolDistribution era) @@ -286,7 +285,7 @@ data QueryInShelleyBasedEra era result where :: Set StakeCredential -> QueryInShelleyBasedEra era (Map StakeCredential L.Coin) QueryAccountState - :: QueryInShelleyBasedEra era L.AccountState + :: QueryInShelleyBasedEra era L.ChainAccountState QueryConstitution :: QueryInShelleyBasedEra era (L.Constitution (ShelleyLedgerEra era)) QueryGovState @@ -389,24 +388,23 @@ decodeCurrentEpochState decodeCurrentEpochState sbe (SerialisedCurrentEpochState (Serialised ls)) = shelleyBasedEraConstraints sbe $ CurrentEpochState <$> Plain.decodeFull ls -newtype SerialisedPoolState era - = SerialisedPoolState (Serialised (Shelley.PState (ShelleyLedgerEra era))) +newtype SerialisedPoolState + = SerialisedPoolState (Serialised L.QueryPoolStateResult) -newtype PoolState era = PoolState (Shelley.PState (ShelleyLedgerEra era)) +newtype PoolState era = PoolState L.QueryPoolStateResult decodePoolState :: forall era - . () - => Core.Era (ShelleyLedgerEra era) - => DecCBOR (Shelley.PState (ShelleyLedgerEra era)) - => SerialisedPoolState era + . ShelleyBasedEra era + -> SerialisedPoolState -> Either DecoderError (PoolState era) -decodePoolState (SerialisedPoolState (Serialised ls)) = - PoolState <$> decodeFull (Core.eraProtVerLow @(ShelleyLedgerEra era)) ls +decodePoolState sbe (SerialisedPoolState (Serialised ls)) = + shelleyBasedEraConstraints sbe $ + PoolState <$> decodeFull (Core.eraProtVerLow @(ShelleyLedgerEra era)) ls newtype SerialisedPoolDistribution era = SerialisedPoolDistribution - (Serialised (Consensus.PoolDistr StandardCrypto)) + (Serialised Shelley.PoolDistr) newtype PoolDistribution era = PoolDistribution { unPoolDistr :: Consensus.PoolDistr StandardCrypto @@ -433,9 +431,16 @@ decodeStakeSnapshot decodeStakeSnapshot (SerialisedStakeSnapshots (Serialised ls)) = StakeSnapshot <$> Plain.decodeFull ls decodeBigLedgerPeerSnapshot - :: Serialised LedgerPeerSnapshot + :: Consensus.ShelleyNodeToClientVersion + -> Serialised LedgerPeerSnapshot -> Either (LBS.ByteString, DecoderError) LedgerPeerSnapshot -decodeBigLedgerPeerSnapshot (Serialised lps) = first (lps,) (Plain.decodeFull lps) +decodeBigLedgerPeerSnapshot ntcV (Serialised lps) = + first + (lps,) + $ Plain.decodeFullDecoder + "LedgerPeerSnapshot" + (decodeLedgerPeerSnapshot $ Consensus.ledgerPeerSnapshotSupportsSRV ntcV) + lps toShelleyAddrSet :: CardanoEra era @@ -477,15 +482,15 @@ fromLedgerUTxO sbe (Shelley.UTxO utxo) = $ utxo fromShelleyPoolDistr - :: Consensus.PoolDistr StandardCrypto + :: L.PoolDistr -> Map (Hash StakePoolKey) Rational fromShelleyPoolDistr = -- TODO: write an appropriate property to show it is safe to use -- Map.fromListAsc or to use Map.mapKeysMonotonic fromList - . map (bimap StakePoolKeyHash Consensus.individualPoolStake) + . map (bimap StakePoolKeyHash Shelley.individualPoolStake) . toList - . Consensus.unPoolDistr + . Shelley.unPoolDistr fromShelleyDelegations :: Map @@ -564,7 +569,7 @@ toConsensusQueryShelleyBased sbe = \case QueryProtocolParameters -> Some (consensusQueryInEraInMode era Consensus.GetCurrentPParams) QueryStakeDistribution -> - Some (consensusQueryInEraInMode era Consensus.GetStakeDistribution) + Some (consensusQueryInEraInMode era Consensus.GetStakeDistribution2) QueryUTxO QueryUTxOWhole -> Some (consensusQueryInEraInMode era Consensus.GetUTxOWhole) QueryUTxO (QueryUTxOByAddress addrs) -> @@ -613,7 +618,7 @@ toConsensusQueryShelleyBased sbe = \case ) QueryPoolDistribution poolIds -> Some - (consensusQueryInEraInMode era (Consensus.GetCBOR (Consensus.GetPoolDistr (getPoolIds <$> poolIds)))) + (consensusQueryInEraInMode era (Consensus.GetCBOR (Consensus.GetPoolDistr2 (getPoolIds <$> poolIds)))) where getPoolIds :: Set PoolId -> Set (Shelley.KeyHash Shelley.StakePool) getPoolIds = Set.map (\(StakePoolKeyHash kh) -> kh) @@ -640,7 +645,9 @@ toConsensusQueryShelleyBased sbe = \case QueryDRepState creds -> caseShelleyToBabbageOrConwayEraOnwards (const $ error "toConsensusQueryShelleyBased: QueryDRepState is only available in the Conway era") - (const $ Some (consensusQueryInEraInMode era (Consensus.GetDRepState creds))) + ( \w -> + Some (consensusQueryInEraInMode era (conwayEraOnwardsConstraints w $ Consensus.GetDRepState creds)) + ) sbe QueryDRepStakeDistr dreps -> caseShelleyToBabbageOrConwayEraOnwards @@ -727,6 +734,7 @@ consensusQueryInEraInMode erainmode b = AlonzoEra -> Consensus.QueryIfCurrentAlonzo b BabbageEra -> Consensus.QueryIfCurrentBabbage b ConwayEra -> Consensus.QueryIfCurrentConway b + DijkstraEra -> Consensus.QueryIfCurrentDijkstra b -- ---------------------------------------------------------------------------- -- Conversions of query results from the consensus types. @@ -849,6 +857,18 @@ fromConsensusQueryResult (QueryInEra (QueryInShelleyBasedEra ShelleyBasedEraConw ) r' _ -> fromConsensusQueryResultMismatch +fromConsensusQueryResult (QueryInEra (QueryInShelleyBasedEra ShelleyBasedEraDijkstra q)) q' r' = + case q' of + Consensus.BlockQuery (Consensus.QueryIfCurrentDijkstra q'') -> + bimap + fromConsensusEraMismatch + ( fromConsensusQueryResultShelleyBased + ShelleyBasedEraDijkstra + q + q'' + ) + r' + _ -> fromConsensusQueryResultMismatch -- This function is written like this so that we have exhaustive pattern checking -- on the @QueryInShelleyBasedEra era result@ value. Don't change the top-level @@ -858,7 +878,6 @@ fromConsensusQueryResultShelleyBased . HasCallStack => ShelleyLedgerEra era ~ ledgerera => ConsensusProtocol era ~ protocol - => ProtoCrypto protocol ~ StandardCrypto => ShelleyBasedEra era -> QueryInShelleyBasedEra era result -> Consensus.BlockQuery (Consensus.ShelleyBlock protocol ledgerera) fp result' @@ -884,7 +903,7 @@ fromConsensusQueryResultShelleyBased sbe sbeQuery q' r' = _ -> fromConsensusQueryResultMismatch QueryStakeDistribution -> case q' of - Consensus.GetStakeDistribution -> fromShelleyPoolDistr r' + Consensus.GetStakeDistribution2 -> fromShelleyPoolDistr r' _ -> fromConsensusQueryResultMismatch QueryUTxO QueryUTxOWhole -> case q' of @@ -913,9 +932,8 @@ fromConsensusQueryResultShelleyBased sbe sbeQuery q' r' = QueryStakePoolParameters{} -> case q' of Consensus.GetStakePoolParams{} -> - Map.map fromShelleyPoolParams - . Map.mapKeysMonotonic StakePoolKeyHash - $ r' + Map.mapKeysMonotonic StakePoolKeyHash $ + Map.map fromShelleyPoolParams r' _ -> fromConsensusQueryResultMismatch QueryDebugLedgerState{} -> case q' of @@ -939,7 +957,7 @@ fromConsensusQueryResultShelleyBased sbe sbeQuery q' r' = _ -> fromConsensusQueryResultMismatch QueryPoolDistribution{} -> case q' of - Consensus.GetCBOR Consensus.GetPoolDistr{} -> + Consensus.GetCBOR Consensus.GetPoolDistr2{} -> SerialisedPoolDistribution r' _ -> fromConsensusQueryResultMismatch QueryStakeSnapshot{} -> diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Body.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Body.hs index 1c8cb37d92..63c1320db0 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Body.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/Body.hs @@ -278,7 +278,8 @@ import Cardano.Crypto.Hashing qualified as Byron import Cardano.Ledger.Allegra.Core qualified as L import Cardano.Ledger.Alonzo.Core qualified as L import Cardano.Ledger.Alonzo.Scripts qualified as Alonzo -import Cardano.Ledger.Alonzo.Tx qualified as Alonzo (hashScriptIntegrity) +import Cardano.Ledger.Alonzo.Tx qualified as L +-- import Cardano.Ledger.Alonzo.Tx qualified as Alonzo (hashScriptIntegrity) import Cardano.Ledger.Alonzo.TxWits qualified as Alonzo import Cardano.Ledger.Api qualified as L import Cardano.Ledger.Babbage.UTxO qualified as L @@ -286,10 +287,10 @@ import Cardano.Ledger.BaseTypes (StrictMaybe (..)) import Cardano.Ledger.Binary (Annotated (..)) import Cardano.Ledger.Binary qualified as CBOR import Cardano.Ledger.Coin qualified as L -import Cardano.Ledger.Conway.Core qualified as L import Cardano.Ledger.Core () import Cardano.Ledger.Core qualified as Ledger import Cardano.Ledger.Credential qualified as Shelley +import Cardano.Ledger.Dijkstra.Scripts qualified as L import Cardano.Ledger.Hashes qualified as SafeHash import Cardano.Ledger.Keys qualified as Shelley import Cardano.Ledger.Mary.Value as L (MaryValue (..), MultiAsset) @@ -1424,6 +1425,13 @@ validateTxBodyContent validateMetadata txMetadata validateTxInsCollateral txInsCollateral languages validateProtocolParameters txProtocolParams languages + ShelleyBasedEraDijkstra -> do + validateTxIns txIns + first TxBodyOutputError $ + validateTxOuts sbe txOuts + validateMetadata txMetadata + validateTxInsCollateral txInsCollateral languages + validateProtocolParameters txProtocolParams languages validateMetadata :: TxMetadataInEra era -> Either TxBodyError () validateMetadata txMetadata = @@ -1588,6 +1596,7 @@ fromLedgerTxIns sbe body = inputs_ ShelleyBasedEraAlonzo = view L.inputsTxBodyL inputs_ ShelleyBasedEraBabbage = view L.inputsTxBodyL inputs_ ShelleyBasedEraConway = view L.inputsTxBodyL + inputs_ ShelleyBasedEraDijkstra = view L.inputsTxBodyL fromLedgerTxInsCollateral :: forall era @@ -1694,6 +1703,11 @@ fromLedgerAuxiliaryData ShelleyBasedEraConway txAuxData = , fromShelleyBasedScript ShelleyBasedEraConway <$> toList (L.getAlonzoTxAuxDataScripts txAuxData) ) +fromLedgerAuxiliaryData ShelleyBasedEraDijkstra txAuxData = + ( fromShelleyMetadata (L.atadMetadata txAuxData) + , fromShelleyBasedScript ShelleyBasedEraDijkstra + <$> toList (L.getAlonzoTxAuxDataScripts txAuxData) + ) fromLedgerTxAuxiliaryData :: ShelleyBasedEra era @@ -1725,14 +1739,14 @@ fromLedgerTxExtraKeyWitnesses sbe body = caseShelleyToMaryOrAlonzoEraOnwards (const TxExtraKeyWitnessesNone) ( \w -> - let keyhashes = body ^. L.reqSignerHashesTxBodyL + let keyhashes = body ^. L.reqSignerHashesTxBodyG in if Set.null keyhashes then TxExtraKeyWitnessesNone else TxExtraKeyWitnesses w [ PaymentKeyHash (Shelley.coerceKeyRole keyhash) - | keyhash <- toList $ body ^. L.reqSignerHashesTxBodyL + | keyhash <- toList $ body ^. L.reqSignerHashesTxBodyG ] ) sbe @@ -1972,7 +1986,8 @@ convPParamsToScriptIntegrityHash w (BuildTxWith mTxProtocolParams) redeemers dat case mTxProtocolParams of Nothing -> SNothing Just (LedgerProtocolParameters pp) -> - Alonzo.hashScriptIntegrity (Set.map (L.getLanguageView pp) languages) redeemers datums + let scriptIntegrity = L.ScriptIntegrity redeemers datums (Set.map (L.getLanguageView pp) languages) + in SJust $ L.hashScriptIntegrity scriptIntegrity convLanguages :: [(ScriptWitnessIndex, AnyScriptWitness era)] -> Set Plutus.Language convLanguages witnesses = @@ -2031,7 +2046,10 @@ mkCommonTxBody sbe txIns txOuts txFee txWithdrawals txAuxData = & L.auxDataHashTxBodyL .~ maybe SNothing (SJust . Ledger.hashTxAuxData) txAuxData -{-# DEPRECATED makeShelleyTransactionBody "Use 'createTransactionBody' instead." #-} +{-# DEPRECATED + makeShelleyTransactionBody + "Use 'createTransactionBody' instead. 'makeShelleyTransactionBody' will be removed after 11.0.0.0 release" + #-} makeShelleyTransactionBody :: forall era . () @@ -2591,6 +2609,7 @@ makeShelleyTransactionBody txAuxData :: Maybe (L.TxAuxData E.ConwayEra) txAuxData = toAuxiliaryData sbe txMetadata txAuxScripts +makeShelleyTransactionBody ShelleyBasedEraDijkstra _ = error "makeShelleyTransactionBody: Dijkstra is not supported" -- ---------------------------------------------------------------------------- -- Script witnesses within the tx body @@ -2695,6 +2714,7 @@ fromScriptWitnessIndex aOnwards widx = AlonzoEraOnwardsAlonzo -> fromScriptWitnessIndexAlonzo widx AlonzoEraOnwardsBabbage -> fromScriptWitnessIndexBabbage widx AlonzoEraOnwardsConway -> fromScriptWitnessIndexConway widx + AlonzoEraOnwardsDijkstra -> fromScriptWitnessIndexDijkstra widx fromScriptWitnessIndexAlonzo :: ScriptWitnessIndex -> Maybe (L.PlutusPurpose L.AsIx (ShelleyLedgerEra AlonzoEra)) @@ -2727,6 +2747,17 @@ fromScriptWitnessIndexConway i = ScriptWitnessIndexVoting n -> Just $ L.ConwayVoting (L.AsIx n) ScriptWitnessIndexProposing n -> Just $ L.ConwayProposing (L.AsIx n) +fromScriptWitnessIndexDijkstra + :: ScriptWitnessIndex -> Maybe (L.PlutusPurpose L.AsIx (ShelleyLedgerEra DijkstraEra)) +fromScriptWitnessIndexDijkstra i = + case i of + ScriptWitnessIndexTxIn n -> Just $ L.DijkstraSpending (L.AsIx n) + ScriptWitnessIndexMint n -> Just $ L.DijkstraMinting (L.AsIx n) + ScriptWitnessIndexCertificate n -> Just $ L.DijkstraCertifying (L.AsIx n) + ScriptWitnessIndexWithdrawal n -> Just $ L.DijkstraRewarding (L.AsIx n) + ScriptWitnessIndexVoting n -> Just $ L.DijkstraVoting (L.AsIx n) + ScriptWitnessIndexProposing n -> Just $ L.DijkstraProposing (L.AsIx n) + toScriptIndex :: AlonzoEraOnwards era -> L.PlutusPurpose L.AsIx (ShelleyLedgerEra era) @@ -2736,6 +2767,7 @@ toScriptIndex sbe scriptPurposeIndex = AlonzoEraOnwardsAlonzo -> toScriptIndexAlonzo scriptPurposeIndex AlonzoEraOnwardsBabbage -> toScriptIndexAlonzo scriptPurposeIndex AlonzoEraOnwardsConway -> toScriptIndexConway scriptPurposeIndex + AlonzoEraOnwardsDijkstra -> toScriptIndexDijkstra scriptPurposeIndex toScriptIndexAlonzo :: L.AlonzoPlutusPurpose L.AsIx (ShelleyLedgerEra era) @@ -2759,6 +2791,19 @@ toScriptIndexConway scriptPurposeIndex = L.ConwayVoting (L.AsIx i) -> ScriptWitnessIndexVoting i L.ConwayProposing (L.AsIx i) -> ScriptWitnessIndexProposing i +toScriptIndexDijkstra + :: L.DijkstraPlutusPurpose L.AsIx (ShelleyLedgerEra era) + -> ScriptWitnessIndex +toScriptIndexDijkstra scriptPurposeIndex = + case scriptPurposeIndex of + L.DijkstraSpending (L.AsIx i) -> ScriptWitnessIndexTxIn i + L.DijkstraMinting (L.AsIx i) -> ScriptWitnessIndexMint i + L.DijkstraCertifying (L.AsIx i) -> ScriptWitnessIndexCertificate i + L.DijkstraRewarding (L.AsIx i) -> ScriptWitnessIndexWithdrawal i + L.DijkstraVoting (L.AsIx i) -> ScriptWitnessIndexVoting i + L.DijkstraProposing (L.AsIx i) -> ScriptWitnessIndexProposing i + L.DijkstraGuarding (L.AsIx i) -> error $ "toScriptIndexDijkstra: unexpected DijkstraGuarding at index " <> show i + collectTxBodyScriptWitnesses :: forall era . ShelleyBasedEra era @@ -3006,18 +3051,18 @@ extractWitnessableVotes :: ConwayEraOnwards era -> Maybe (Featured eon era (TxVotingProcedures BuildTx era)) -> [(Witnessable VoterItem (ShelleyLedgerEra era), BuildTxWith BuildTx (Witness WitCtxStake era))] +extractWitnessableVotes ConwayEraOnwardsDijkstra _ = error "extractWitnessableVotes: Dijkstra era not supported" extractWitnessableVotes e@ConwayEraOnwardsConway txVotingProcedures = List.nub - [ (WitVote vote, BuildTxWith wit) - | (vote, wit) <- getVotes e $ maybe TxVotingProceduresNone unFeatured txVotingProcedures + [ (conwayEraOnwardsConstraints e $ WitVote vote, BuildTxWith wit) + | (vote, wit) <- getVotes $ maybe TxVotingProceduresNone unFeatured txVotingProcedures ] where getVotes - :: ConwayEraOnwards era - -> TxVotingProcedures BuildTx era + :: TxVotingProcedures BuildTx era -> [(L.Voter, Witness WitCtxStake era)] - getVotes ConwayEraOnwardsConway TxVotingProceduresNone = [] - getVotes ConwayEraOnwardsConway (TxVotingProcedures allVotingProcedures (BuildTxWith scriptWitnessedVotes)) = + getVotes TxVotingProceduresNone = [] + getVotes (TxVotingProcedures allVotingProcedures (BuildTxWith scriptWitnessedVotes)) = [ (voter, wit) | (voter, _) <- toList $ L.unVotingProcedures allVotingProcedures , let wit = case Map.lookup voter scriptWitnessedVotes of @@ -3030,9 +3075,9 @@ extractWitnessableProposals -> Maybe (Featured eon era (TxProposalProcedures BuildTx era)) -> [(Witnessable ProposalItem (ShelleyLedgerEra era), BuildTxWith BuildTx (Witness WitCtxStake era))] -extractWitnessableProposals e@ConwayEraOnwardsConway txProposalProcedures = +extractWitnessableProposals e txProposalProcedures = List.nub - [ (WitProposal prop, BuildTxWith wit) + [ (conwayEraOnwardsConstraints e $ WitProposal prop, BuildTxWith wit) | (Proposal prop, wit) <- getProposals e $ maybe TxProposalProceduresNone unFeatured txProposalProcedures ] @@ -3041,9 +3086,9 @@ extractWitnessableProposals e@ConwayEraOnwardsConway txProposalProcedures = :: ConwayEraOnwards era -> TxProposalProcedures BuildTx era -> [(Proposal era, Witness WitCtxStake era)] - getProposals ConwayEraOnwardsConway TxProposalProceduresNone = [] - getProposals ConwayEraOnwardsConway (TxProposalProcedures txps) = - [ (Proposal p, wit) + getProposals _ TxProposalProceduresNone = [] + getProposals w (TxProposalProcedures txps) = + [ (conwayEraOnwardsConstraints w $ Proposal p, wit) | (p, BuildTxWith mScriptWit) <- toList txps , let wit = case mScriptWit of Just sWit -> ScriptWitness ScriptWitnessForStakeAddr sWit @@ -3094,6 +3139,8 @@ toAuxiliaryData sbe txMetadata txAuxScripts = guard (not (Map.null ms && null ss)) $> L.mkAlonzoTxAuxData ms ss ShelleyBasedEraConway -> guard (not (Map.null ms && null ss)) $> L.mkAlonzoTxAuxData ms ss + ShelleyBasedEraDijkstra -> + guard (not (Map.null ms && null ss)) $> L.mkAlonzoTxAuxData ms ss -- ---------------------------------------------------------------------------- -- Other utilities helpful with making transaction bodies diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Body/Lens.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Body/Lens.hs index 3565f8f272..0f4ab8ae43 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Body/Lens.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/Body/Lens.hs @@ -1,8 +1,11 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {- HLINT ignore "Eta reduce" -} +-- TODO: Deprecate all the lenses that use eons. Explore parameterizing them on `Era era` instead. + module Cardano.Api.Tx.Internal.Body.Lens ( -- * Types LedgerTxBody (..) @@ -58,7 +61,6 @@ import Cardano.Ledger.Alonzo.Core qualified as L import Cardano.Ledger.Api qualified as L import Cardano.Ledger.BaseTypes (SlotNo, StrictMaybe (..)) import Cardano.Ledger.Coin qualified as L -import Cardano.Ledger.Conway.Core qualified as L import Cardano.Ledger.Mary.Value qualified as L import Cardano.Ledger.Shelley.PParams qualified as L import Cardano.Ledger.TxIn qualified as L @@ -164,7 +166,10 @@ collateralInputsTxBodyL w = alonzoEraOnwardsConstraints w $ txBodyL . L.collater reqSignerHashesTxBodyL :: AlonzoEraOnwards era -> Lens' (LedgerTxBody era) (Set (L.KeyHash L.Witness)) -reqSignerHashesTxBodyL w = alonzoEraOnwardsConstraints w $ txBodyL . L.reqSignerHashesTxBodyL +reqSignerHashesTxBodyL w@AlonzoEraOnwardsAlonzo = alonzoEraOnwardsConstraints w $ txBodyL . L.reqSignerHashesTxBodyL +reqSignerHashesTxBodyL w@AlonzoEraOnwardsBabbage = alonzoEraOnwardsConstraints w $ txBodyL . L.reqSignerHashesTxBodyL +reqSignerHashesTxBodyL w@AlonzoEraOnwardsConway = alonzoEraOnwardsConstraints w $ txBodyL . L.reqSignerHashesTxBodyL +reqSignerHashesTxBodyL AlonzoEraOnwardsDijkstra = error "reqSignerHashesTxBodyL: DijkstraEra not supported yet" referenceInputsTxBodyL :: BabbageEraOnwards era -> Lens' (LedgerTxBody era) (Set L.TxIn) diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Output.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Output.hs index c000b7dead..f09fbd76dc 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Output.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/Output.hs @@ -60,6 +60,7 @@ import Cardano.Api.Era.Internal.Core import Cardano.Api.Era.Internal.Eon.AlonzoEraOnwards import Cardano.Api.Era.Internal.Eon.BabbageEraOnwards import Cardano.Api.Era.Internal.Eon.Convert +import Cardano.Api.Era.Internal.Eon.ConwayEraOnwards import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra import Cardano.Api.Error (Error (..), displayError) import Cardano.Api.Hash @@ -209,6 +210,14 @@ fromLedgerTxOuts sbe body scriptdata = | let txdatums = selectTxDatums scriptdata , txouts <- toList (body ^. L.outputsTxBodyL) ] + ShelleyBasedEraDijkstra -> + [ fromBabbageTxOut + BabbageEraOnwardsDijkstra + txdatums + txouts + | let txdatums = selectTxDatums scriptdata + , txouts <- toList (body ^. L.outputsTxBodyL) + ] validateTxOuts :: ShelleyBasedEra era -> [TxOut CtxTx era] -> Either TxOutputError () validateTxOuts sbe txOuts = do @@ -349,6 +358,16 @@ txOutToJsonValue era (TxOut addr val dat refScript) = , "inlineDatumRaw" .= inlineDatumRawJsonCbor dat , "referenceScript" .= refScriptJsonVal refScript ] + DijkstraEra -> + object + [ "address" .= addr + , "value" .= val + , datHashJsonVal dat + , "datum" .= datJsonVal dat + , "inlineDatum" .= inlineDatumJsonVal dat + , "inlineDatumRaw" .= inlineDatumRawJsonCbor dat + , "referenceScript" .= refScriptJsonVal refScript + ] where datHashJsonVal :: TxOutDatum ctx era -> Aeson.Pair datHashJsonVal d = @@ -466,7 +485,31 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxTx era) where mReferenceScript <- o .:? "referenceScript" - reconcileConway alonzoTxOutInConway mInlineDatum mReferenceScript + reconcileConway ConwayEraOnwardsConway alonzoTxOutInConway mInlineDatum mReferenceScript + ShelleyBasedEraDijkstra -> do + alonzoTxOutInConway <- alonzoTxOutParser AlonzoEraOnwardsDijkstra 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 BabbageEraOnwardsDijkstra 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 ConwayEraOnwardsDijkstra alonzoTxOutInConway mInlineDatum mReferenceScript where reconcileBabbage :: TxOut CtxTx BabbageEra @@ -496,13 +539,14 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxTx era) where return $ TxOut addr v finalDat finalRefScript reconcileConway - :: TxOut CtxTx ConwayEra + :: ConwayEraOnwards era + -> TxOut CtxTx era -- \^ Alonzo era datum in Conway era - -> TxOutDatum CtxTx ConwayEra + -> TxOutDatum CtxTx era -- \^ Babbage inline datum -> Maybe ScriptInAnyLang - -> Aeson.Parser (TxOut CtxTx ConwayEra) - reconcileConway top@(TxOut addr v dat r) babbageDatum mBabRefScript = do + -> Aeson.Parser (TxOut CtxTx era) + reconcileConway w top@(TxOut addr v dat r) babbageDatum mBabRefScript = do -- We check for conflicting datums finalDat <- case (dat, babbageDatum) of (TxOutDatumNone, bDatum) -> return bDatum @@ -519,7 +563,7 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxTx era) where finalRefScript <- case mBabRefScript of Nothing -> return r Just anyScript -> - return $ ReferenceScript BabbageEraOnwardsConway anyScript + return $ ReferenceScript (convert w) anyScript return $ TxOut addr v finalDat finalRefScript alonzoTxOutParser @@ -622,7 +666,32 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxUTxO era) where -- We check for a reference script mReferenceScript <- o .:? "referenceScript" - reconcileConway alonzoTxOutInConway mInlineDatum mReferenceScript + reconcileConway ConwayEraOnwardsConway alonzoTxOutInConway mInlineDatum mReferenceScript + ShelleyBasedEraDijkstra -> do + alonzoTxOutInConway <- alonzoTxOutParser AlonzoEraOnwardsDijkstra 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 BabbageEraOnwardsDijkstra 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 ConwayEraOnwardsDijkstra alonzoTxOutInConway mInlineDatum mReferenceScript where reconcileBabbage :: TxOut CtxUTxO BabbageEra @@ -645,13 +714,14 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxUTxO era) where return $ TxOut addr v finalDat finalRefScript reconcileConway - :: TxOut CtxUTxO ConwayEra + :: ConwayEraOnwards era + -> TxOut CtxUTxO era -- \^ Alonzo era datum in Conway era - -> TxOutDatum CtxUTxO ConwayEra + -> TxOutDatum CtxUTxO era -- \^ Babbage inline datum -> Maybe ScriptInAnyLang - -> Aeson.Parser (TxOut CtxUTxO ConwayEra) - reconcileConway (TxOut addr v dat r) babbageDatum mBabRefScript = do + -> Aeson.Parser (TxOut CtxUTxO era) + reconcileConway w (TxOut addr v dat r) babbageDatum mBabRefScript = do -- We check for conflicting datums finalDat <- case (dat, babbageDatum) of (TxOutDatumNone, bDatum) -> return bDatum @@ -660,7 +730,7 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxUTxO era) where finalRefScript <- case mBabRefScript of Nothing -> return r Just anyScript -> - return $ ReferenceScript BabbageEraOnwardsConway anyScript + return $ ReferenceScript (convert w) anyScript return $ TxOut addr v finalDat finalRefScript @@ -723,6 +793,12 @@ toShelleyTxOut sbe = shelleyBasedEraConstraints sbe $ \case .~ toBabbageTxOutDatumUTxO txoutdata & L.referenceScriptTxOutL .~ refScriptToShelleyScript sbe refScript + AlonzoEraOnwardsDijkstra -> + L.mkBasicTxOut (toShelleyAddr addr) value + & L.datumTxOutL + .~ toBabbageTxOutDatumUTxO txoutdata + & L.referenceScriptTxOutL + .~ refScriptToShelleyScript sbe refScript ) sbe @@ -757,6 +833,12 @@ toShelleyTxOutAny sbe = shelleyBasedEraConstraints sbe $ \case .~ toBabbageTxOutDatum txoutdata & L.referenceScriptTxOutL .~ refScriptToShelleyScript sbe refScript + AlonzoEraOnwardsDijkstra -> + L.mkBasicTxOut (toShelleyAddr addr) value + & L.datumTxOutL + .~ toBabbageTxOutDatum txoutdata + & L.referenceScriptTxOutL + .~ refScriptToShelleyScript sbe refScript ) sbe @@ -819,6 +901,23 @@ fromShelleyTxOut sbe ledgerTxOut = shelleyBasedEraConstraints sbe $ do where datum = ledgerTxOut ^. L.datumTxOutL mRefScript = ledgerTxOut ^. L.referenceScriptTxOutL + ShelleyBasedEraDijkstra -> + TxOut + addressInEra + txOutValue + ( fromBabbageTxOutDatum + AlonzoEraOnwardsDijkstra + BabbageEraOnwardsDijkstra + datum + ) + ( case mRefScript of + SNothing -> ReferenceScriptNone + SJust refScript -> + fromShelleyScriptToReferenceScript ShelleyBasedEraDijkstra refScript + ) + where + datum = ledgerTxOut ^. L.datumTxOutL + mRefScript = ledgerTxOut ^. L.referenceScriptTxOutL -- ---------------------------------------------------------------------------- -- Transaction output values (era-dependent) @@ -1026,6 +1125,8 @@ binaryDataToScriptData BabbageEraOnwardsBabbage d = fromAlonzoData $ L.binaryDataToData d binaryDataToScriptData BabbageEraOnwardsConway d = fromAlonzoData $ L.binaryDataToData d +binaryDataToScriptData BabbageEraOnwardsDijkstra d = + fromAlonzoData $ L.binaryDataToData d data TxOutputError = TxOutputNegative !Quantity !TxOutInAnyEra diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Sign.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Sign.hs index 1edd36f891..7d31f70059 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Sign.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/Sign.hs @@ -184,6 +184,10 @@ instance Show (Tx era) where showParen (p >= 11) $ showString "ShelleyTx ShelleyBasedEraConway " . showsPrec 11 tx + showsPrec p (ShelleyTx ShelleyBasedEraDijkstra tx) = + showParen (p >= 11) $ + showString "ShelleyTx ShelleyBasedEraDijkstra " + . showsPrec 11 tx instance HasTypeProxy era => HasTypeProxy (Tx era) where data AsType (Tx era) = AsTx (AsType era) @@ -282,6 +286,7 @@ instance IsShelleyBasedEra era => HasTextEnvelope (Tx era) where ShelleyBasedEraAlonzo -> "Tx AlonzoEra" ShelleyBasedEraBabbage -> "Tx BabbageEra" ShelleyBasedEraConway -> "Tx ConwayEra" + ShelleyBasedEraDijkstra -> "Tx DijkstraEra" -- ---------------------------------------------------------------------------- -- Transaction bodies @@ -477,6 +482,29 @@ instance Show (TxBody era) where . showChar ' ' . showsPrec 11 scriptValidity ) + showsPrec + p + ( ShelleyTxBody + ShelleyBasedEraDijkstra + txbody + txscripts + redeemers + txmetadata + scriptValidity + ) = + showParen + (p >= 11) + ( showString "ShelleyTxBody ShelleyBasedEraDijkstra " + . 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 data AsType (TxBody era) = AsTxBody (AsType era) @@ -518,6 +546,7 @@ instance IsShelleyBasedEra era => HasTextEnvelope (TxBody era) where ShelleyBasedEraAlonzo -> "TxBodyAlonzo" ShelleyBasedEraBabbage -> "TxBodyBabbage" ShelleyBasedEraConway -> "TxBodyConway" + ShelleyBasedEraDijkstra -> "TxBodyDijkstra" data TxBodyScriptData era where TxBodyNoScriptData :: TxBodyScriptData era @@ -536,7 +565,7 @@ selectTxDatums :: TxBodyScriptData era -> Map L.DataHash (L.Data (ShelleyLedgerEra era)) selectTxDatums TxBodyNoScriptData = Map.empty -selectTxDatums (TxBodyScriptData _ (Alonzo.TxDats' datums) _) = datums +selectTxDatums (TxBodyScriptData _ (Alonzo.TxDats datums) _) = datums -- | Indicates whether a script is expected to fail or pass validation. data ScriptValidity @@ -647,6 +676,10 @@ instance Show (KeyWitness era) where showParen (p >= 11) $ showString "ShelleyBootstrapWitness ShelleyBasedEraConway " . showsPrec 11 tx + showsPrec p (ShelleyBootstrapWitness ShelleyBasedEraDijkstra tx) = + showParen (p >= 11) $ + showString "ShelleyBootstrapWitness ShelleyBasedEraDijkstra " + . showsPrec 11 tx showsPrec p (ShelleyKeyWitness ShelleyBasedEraShelley tx) = showParen (p >= 11) $ showString "ShelleyKeyWitness ShelleyBasedEraShelley " @@ -671,6 +704,10 @@ instance Show (KeyWitness era) where showParen (p >= 11) $ showString "ShelleyKeyWitness ShelleyBasedEraConway " . showsPrec 11 tx + showsPrec p (ShelleyKeyWitness ShelleyBasedEraDijkstra tx) = + showParen (p >= 11) $ + showString "ShelleyKeyWitness ShelleyBasedEraDijkstra " + . showsPrec 11 tx instance HasTypeProxy era => HasTypeProxy (KeyWitness era) where data AsType (KeyWitness era) = AsKeyWitness (AsType era) @@ -707,6 +744,7 @@ instance IsCardanoEra era => SerialiseAsCBOR (KeyWitness era) where AlonzoEra -> decodeShelleyBasedWitness ShelleyBasedEraAlonzo bs BabbageEra -> decodeShelleyBasedWitness ShelleyBasedEraBabbage bs ConwayEra -> decodeShelleyBasedWitness ShelleyBasedEraConway bs + DijkstraEra -> decodeShelleyBasedWitness ShelleyBasedEraDijkstra bs -- | We no longer use the non-compliant CDDL legacy encoding. -- Instead of depending on a tag to differentiate which key witness @@ -795,6 +833,7 @@ instance IsCardanoEra era => HasTextEnvelope (KeyWitness era) where AlonzoEra -> "TxWitness AlonzoEra" BabbageEra -> "TxWitness BabbageEra" ConwayEra -> "TxWitness ConwayEra" + DijkstraEra -> "TxWitness DijkstraEra" getTxBodyAndWitnesses :: Tx era -> (TxBody era, [KeyWitness era]) getTxBodyAndWitnesses tx = (getTxBody tx, getTxWitnesses tx) @@ -948,6 +987,7 @@ makeSignedTransaction ShelleyBasedEraAlonzo -> alonzoSignedTransaction ShelleyBasedEraBabbage -> alonzoSignedTransaction ShelleyBasedEraConway -> alonzoSignedTransaction + ShelleyBasedEraDijkstra -> alonzoSignedTransaction where txCommon :: forall ledgerera @@ -1068,7 +1108,7 @@ makeShelleyBasedBootstrapWitness sbe nwOrAddr txbody (ByronSigningKey sk) = -- Byron era witnesses were weird. This reveals all that weirdness. Shelley.BootstrapWitness { Shelley.bwKey = vk - , Shelley.bwSig = signature + , Shelley.bwSignature = signature , Shelley.bwChainCode = chainCode , Shelley.bwAttributes = attributes } diff --git a/cardano-api/test/cardano-api-golden/files/errors/Cardano.Api.Tx.Internal.Fee.ScriptExecutionError/ScriptErrorEvaluationFailed.txt b/cardano-api/test/cardano-api-golden/files/errors/Cardano.Api.Tx.Internal.Fee.ScriptExecutionError/ScriptErrorEvaluationFailed.txt index 30e7153241..6d48eb5b1d 100644 --- a/cardano-api/test/cardano-api-golden/files/errors/Cardano.Api.Tx.Internal.Fee.ScriptExecutionError/ScriptErrorEvaluationFailed.txt +++ b/cardano-api/test/cardano-api-golden/files/errors/Cardano.Api.Tx.Internal.Fee.ScriptExecutionError/ScriptErrorEvaluationFailed.txt @@ -31,7 +31,7 @@ Script arguments: with referenceScript ] Fee: 0 - Value minted: UnsafeMintValue (Map {unMap = [(c61bfa1c138524b69f378bc69504322f39289ce554d549db4d1e2b50,Map {unMap = [("MillarCoin",5)]})]}) + Value minted: UnsafeMintValue {unMintValue = Map {unMap = [(c61bfa1c138524b69f378bc69504322f39289ce554d549db4d1e2b50,Map {unMap = [("MillarCoin",5)]})]}} TxCerts: [ TxCertRegStaking (ScriptCredential c61bfa1c138524b69f378bc69504322f39289ce554d549db4d1e2b50) (Just 400000) ] Wdrl: [] Valid range: (-∞ , +∞) diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/CBOR.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/CBOR.hs index 1c1208e957..63187c436c 100644 --- a/cardano-api/test/cardano-api-test/Test/Cardano/Api/CBOR.hs +++ b/cardano-api/test/cardano-api-test/Test/Cardano/Api/CBOR.hs @@ -79,6 +79,7 @@ prop_txbody_backwards_compatibility = H.property $ do ShelleyBasedEraAlonzo -> "Tx AlonzoEra" ShelleyBasedEraBabbage -> "Tx BabbageEra" ShelleyBasedEraConway -> "Tx ConwayEra" + ShelleyBasedEraDijkstra -> "Tx DijkstraEra" prop_text_envelope_roundtrip_txbody_CBOR :: Property prop_text_envelope_roundtrip_txbody_CBOR = H.property $ do @@ -92,8 +93,8 @@ prop_text_envelope_roundtrip_txbody_CBOR = H.property $ do deserialiseFromTextEnvelope ) -prop_text_envelope_roundtrip_tx_CBOR :: Property -prop_text_envelope_roundtrip_tx_CBOR = H.property $ do +_prop_text_envelope_roundtrip_tx_CBOR :: Property +_prop_text_envelope_roundtrip_tx_CBOR = H.property $ do AnyShelleyBasedEra era <- H.noteShowM . H.forAll $ Gen.element [minBound .. maxBound] x <- H.forAll $ genTx era shelleyBasedEraConstraints @@ -428,8 +429,8 @@ tests = [ testProperty "test canonicalisation of CBOR" prop_canonicalise_cbor , testProperty "rountrip txbody text envelope" prop_text_envelope_roundtrip_txbody_CBOR , testProperty "txbody backwards compatibility" prop_txbody_backwards_compatibility - , testProperty "rountrip tx text envelope" prop_text_envelope_roundtrip_tx_CBOR - , testProperty "roundtrip witness CBOR" prop_roundtrip_witness_CBOR + , -- , testProperty "rountrip tx text envelope" prop_text_envelope_roundtrip_tx_CBOR + testProperty "roundtrip witness CBOR" prop_roundtrip_witness_CBOR , testProperty "roundtrip legacy key witness CBOR" prop_roundtrip_legacy_key_witness_CBOR , testProperty "roundtrip operational certificate CBOR" diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Genesis.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Genesis.hs index 546ef88a38..ff3424a5a4 100644 --- a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Genesis.hs +++ b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Genesis.hs @@ -9,19 +9,19 @@ module Test.Cardano.Api.Genesis where import Cardano.Api +import Cardano.Api.Experimental.Era (Some (..)) import Cardano.Api.Ledger qualified as L import Cardano.Binary qualified as CB import Cardano.Ledger.Alonzo.Genesis qualified as L import Cardano.Ledger.Binary qualified as L import Cardano.Ledger.Plutus qualified as L -import PlutusLedgerApi.V2 qualified as V2 import Codec.CBOR.Decoding qualified as CBOR import Codec.CBOR.Encoding qualified as CBOR import Codec.CBOR.Write qualified as CBOR +import Control.Monad import Data.ByteString.Lazy qualified as LBS -import Data.Either import Data.Int (Int64) import Data.Map.Strict qualified as M import Data.Maybe @@ -33,121 +33,90 @@ import Test.Tasty (TestTree, testGroup) import Test.Tasty.Hedgehog (testProperty) -- | Test reading and decoding of AlonzoGenesis with cost models - era dependent test -prop_reading_plutus_v2_era_sensitive_costmodel +prop_reading_plutus_v2_costmodel_cbor_roundtrip_era_sensitive :: forall era - . IsCardanoEra era - => CardanoEra era + . CardanoEra era -- ^ An era in which we read the cost model -> PlutusV2CostModelFormat -- ^ cost model in genesis variant -> Property -prop_reading_plutus_v2_era_sensitive_costmodel era cmf = H.propertyOnce $ do +prop_reading_plutus_v2_costmodel_cbor_roundtrip_era_sensitive era cmf = H.propertyOnce $ do H.noteShow_ $ "Era: " <> pshow era H.noteShow_ $ "Cost model type: " <> show cmf (allCostModels, v2costModelValues) <- - H.leftFailM $ loadPlutusV2CostModelFromGenesis (Just era) (getGenesisFile cmf) + H.leftFailM $ loadPlutusV2CostModelFromGenesis (getGenesisFile cmf) H.noteShow_ v2costModelValues - let isConwayOnwards = isJust $ maybeEon @ConwayEraOnwards @era - last10CostModelValues = reverse . take 10 $ reverse v2costModelValues - -- values from @perturbing - last10CostModelCorrectValues = [1292075, 24469, 74, 0, 1, 936157, 49601, 237, 0, 1] - - if isConwayOnwards - then do - length v2costModelValues === 185 - if getCostModelFileParamCount cmf < 185 - then last10CostModelValues === replicate 10 maxBound - else last10CostModelValues === last10CostModelCorrectValues - else length v2costModelValues === 175 + -- the V2 params count is expected to be 175 + -- vide https://github.com/IntersectMBO/cardano-ledger/pull/5241/files + -- will allways succeed + length v2costModelValues === 175 -- Make sure that our just read genesis is CBOR encoding roundtripping - aeo <- H.nothingFail $ maybeEon @AlonzoEraOnwards @era + -- because after protocol version >= 9 the CBOR decoder is failing on errors + aeo <- H.nothingFail $ forEraMaybeEon @AlonzoEraOnwards era let allCostModelsBs = encodeCborInEraCostModels aeo allCostModels allCostModels' <- H.leftFail $ decodeCborInEraCostModels aeo allCostModelsBs H.note_ "Check that read genesis is CBOR encoding roundtripping" allCostModels' === allCostModels - -- Yeah, let's check the default one if it's roundtripping as well - let defaultCostModels = L.agCostModels $ alonzoGenesisDefaults era - defaultCostModelsBs = encodeCborInEraCostModels aeo defaultCostModels - defaultCostModels' <- H.leftFail $ decodeCborInEraCostModels aeo defaultCostModelsBs - H.note_ "Check that the default genesis is CBOR encoding roundtripping" - defaultCostModels' === defaultCostModels - -- | Test reading and decoding of AlonzoGenesis with cost models - an era independent test -prop_reading_plutus_v2_costmodel +prop_reading_plutus_v2_costmodel_json :: PlutusV2CostModelFormat -> Property -prop_reading_plutus_v2_costmodel cmf = H.propertyOnce $ do +prop_reading_plutus_v2_costmodel_json cmf = H.propertyOnce $ do H.noteShow_ $ "Cost model type: " <> show cmf - mCostModelValues <- fmap snd <$> loadPlutusV2CostModelFromGenesis Nothing (getGenesisFile cmf) + mCostModelValues <- fmap snd <$> loadPlutusV2CostModelFromGenesis (getGenesisFile cmf) H.noteShow_ mCostModelValues - if cmf == Map175 - then do - -- reading a map with 175 params should fail - H.assertWith mCostModelValues isLeft - else do - costModelValues <- H.leftFail mCostModelValues - length costModelValues === getCostModelFileParamCount cmf - -prop_verify_plutus_v2_costmodel :: Property -prop_verify_plutus_v2_costmodel = H.propertyOnce $ do - let lastParamName = maxBound - last10Params = (toEnum . subtract 9 $ fromEnum lastParamName) `enumFromTo` lastParamName :: [V2.ParamName] - H.note_ "Check that last 10 params of PlutusV2 cost models are exactly the ones we expect" - -- The conditional logic of trimming conway parameters in babbage relies on the fact that last 10 V2 params - -- are those below - last10Params - === [ V2.IntegerToByteString'cpu'arguments'c0 - , V2.IntegerToByteString'cpu'arguments'c1 - , V2.IntegerToByteString'cpu'arguments'c2 - , V2.IntegerToByteString'memory'arguments'intercept - , V2.IntegerToByteString'memory'arguments'slope - , V2.ByteStringToInteger'cpu'arguments'c0 - , V2.ByteStringToInteger'cpu'arguments'c1 - , V2.ByteStringToInteger'cpu'arguments'c2 - , V2.ByteStringToInteger'memory'arguments'intercept - , V2.ByteStringToInteger'memory'arguments'slope - ] + costModelValues <- H.leftFail mCostModelValues + length costModelValues === getCostModelFileParamCount cmf + +prop_check_default_alonzo_genesis_roundtrips :: Property +prop_check_default_alonzo_genesis_roundtrips = H.propertyOnce $ do + let eras = + catMaybes + [ Some <$> forEraMaybeEon @AlonzoEraOnwards era + | AnyCardanoEra era <- [(AnyCardanoEra AlonzoEra) .. maxBound] + ] + + forM_ eras $ \(Some aeo) -> do + let defaultCostModels = L.agCostModels alonzoGenesisDefaults + defaultCostModelsBs = encodeCborInEraCostModels aeo defaultCostModels + H.note_ $ "Decode alonzo genesis for era " <> show aeo + defaultCostModels' <- H.leftFail $ decodeCborInEraCostModels aeo defaultCostModelsBs + H.note_ $ "Check that the default genesis is CBOR encoding roundtripping for era " <> show aeo + defaultCostModels' === defaultCostModels -- * Utilities data PlutusV2CostModelFormat = Map175 - | Map185 | Array175 - | Array185 deriving (Eq, Show) getGenesisFile :: PlutusV2CostModelFormat -> FilePath getGenesisFile = ("./test/cardano-api-test/files/input/genesis/spec.alonzo-v2-cost-model-" <>) . \case Map175 -> "map-175.json" - Map185 -> "map-185.json" Array175 -> "array-175.json" - Array185 -> "array-185.json" getCostModelFileParamCount :: PlutusV2CostModelFormat -> Int getCostModelFileParamCount = \case Map175 -> 175 - Map185 -> 185 Array175 -> 175 - Array185 -> 185 loadPlutusV2CostModelFromGenesis :: HasCallStack => MonadIO m => MonadTest m - => Maybe (CardanoEra era) - -> FilePath + => FilePath -> m (Either String (L.CostModels, [Int64])) -loadPlutusV2CostModelFromGenesis mEra filePath = withFrozenCallStack . runExceptT $ do - genesisBs <- H.lbsReadFile filePath - costModels <- modifyError show $ L.agCostModels <$> decodeAlonzoGenesis mEra genesisBs +loadPlutusV2CostModelFromGenesis filePath = withFrozenCallStack . runExceptT $ do + genesis <- H.readJsonFileOk filePath + let costModels = L.agCostModels genesis liftEither . fmap ((costModels,) . L.getCostModelParams) . maybe (Left "No PlutusV2 model found") Right @@ -180,31 +149,17 @@ tests :: TestTree tests = testGroup "Test.Cardano.Api.Genesis" - [ testProperty "Read Alonzo genesis with PlutusV2 cost model map with 175 params - Babbage" $ - prop_reading_plutus_v2_era_sensitive_costmodel BabbageEra Map175 + [ testProperty "Default Alonzo Genesis roundtrips CBOR" prop_check_default_alonzo_genesis_roundtrips + , testProperty "Read Alonzo genesis with PlutusV2 cost model map with 175 params - Babbage" $ + prop_reading_plutus_v2_costmodel_cbor_roundtrip_era_sensitive BabbageEra Map175 , testProperty "Read Alonzo genesis with PlutusV2 cost model map with 175 params - Conway" $ - prop_reading_plutus_v2_era_sensitive_costmodel ConwayEra Map175 + prop_reading_plutus_v2_costmodel_cbor_roundtrip_era_sensitive ConwayEra Map175 , testProperty "Read Alonzo genesis with PlutusV2 cost model map with 175 params - era insensitive" $ - prop_reading_plutus_v2_costmodel Map175 - , testProperty "Read Alonzo genesis with PlutusV2 cost model map with 185 params - Babbage" $ - prop_reading_plutus_v2_era_sensitive_costmodel BabbageEra Map185 - , testProperty "Read Alonzo genesis with PlutusV2 cost model map with 185 params - Conway" $ - prop_reading_plutus_v2_era_sensitive_costmodel ConwayEra Map185 - , testProperty "Read Alonzo genesis with PlutusV2 cost model map with 185 params - era insensitive" $ - prop_reading_plutus_v2_costmodel Map185 + prop_reading_plutus_v2_costmodel_json Map175 , testProperty "Read Alonzo genesis with PlutusV2 cost model array with 175 params - Babbage" $ - prop_reading_plutus_v2_era_sensitive_costmodel BabbageEra Array175 + prop_reading_plutus_v2_costmodel_cbor_roundtrip_era_sensitive BabbageEra Array175 , testProperty "Read Alonzo genesis with PlutusV2 cost model array with 175 params - Conway" $ - prop_reading_plutus_v2_era_sensitive_costmodel ConwayEra Array175 + prop_reading_plutus_v2_costmodel_cbor_roundtrip_era_sensitive ConwayEra Array175 , testProperty "Read Alonzo genesis with PlutusV2 cost model array with 175 params - era insensitive" $ - prop_reading_plutus_v2_costmodel Array175 - , testProperty "Read Alonzo genesis with PlutusV2 cost model array with 185 params - Babbage" $ - prop_reading_plutus_v2_era_sensitive_costmodel BabbageEra Array185 - , testProperty "Read Alonzo genesis with PlutusV2 cost model array with 185 params - Conway" $ - prop_reading_plutus_v2_era_sensitive_costmodel ConwayEra Array185 - , testProperty "Read Alonzo genesis with PlutusV2 cost model array with 185 params - era insensitive" $ - prop_reading_plutus_v2_costmodel Array185 - , testProperty - "Make sure that last 10 PlutusV2 cost model parameters are the ones we expect" - prop_verify_plutus_v2_costmodel + prop_reading_plutus_v2_costmodel_json Array175 ] diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Metadata.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Metadata.hs index b45c002e1f..f8cd9f0b52 100644 --- a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Metadata.hs +++ b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Metadata.hs @@ -18,7 +18,7 @@ import Data.Maybe (mapMaybe) import Data.Word (Word64) import GHC.Exts (IsList (..)) import GHC.Stack -import Text.InterpolatedString.Perl6 +import Text.RawString.QQ import Test.Gen.Cardano.Api.Metadata @@ -38,42 +38,42 @@ prop_golden_1 :: Property prop_golden_1 = matchMetadata TxMetadataJsonNoSchema - [q|{"0": 1}|] + [r|{"0": 1}|] (TxMetadata (fromList [(0, TxMetaNumber 1)])) prop_golden_2 :: Property prop_golden_2 = matchMetadata TxMetadataJsonNoSchema - [q|{"0": "deadbeef"}|] + [r|{"0": "deadbeef"}|] (txMetadataSingleton 0 (TxMetaText "deadbeef")) prop_golden_3 :: Property prop_golden_3 = matchMetadata TxMetadataJsonNoSchema - [q|{"0": "0xDEADBEEF"}|] + [r|{"0": "0xDEADBEEF"}|] (txMetadataSingleton 0 (TxMetaText "0xDEADBEEF")) prop_golden_4 :: Property prop_golden_4 = matchMetadata TxMetadataJsonNoSchema - [q|{"0": "0xdeadbeef"}|] + [r|{"0": "0xdeadbeef"}|] (txMetadataSingleton 0 (TxMetaBytes "\xde\xad\xbe\xef")) prop_golden_5 :: Property prop_golden_5 = matchMetadata TxMetadataJsonNoSchema - [q|{"0": [] }|] + [r|{"0": [] }|] (txMetadataSingleton 0 (TxMetaList [])) prop_golden_6 :: Property prop_golden_6 = matchMetadata TxMetadataJsonNoSchema - [q|{"0": [1, "a", "0x42"] }|] + [r|{"0": [1, "a", "0x42"] }|] ( txMetadataSingleton 0 ( TxMetaList @@ -88,14 +88,14 @@ prop_golden_7 :: Property prop_golden_7 = matchMetadata TxMetadataJsonNoSchema - [q|{"0": {} }|] + [r|{"0": {} }|] (txMetadataSingleton 0 (TxMetaMap [])) prop_golden_8 :: Property prop_golden_8 = matchMetadata TxMetadataJsonNoSchema - [q|{"0": { + [r|{"0": { "0x41": "0x42", "0x154041": "0x44", "0x104041": "0x43", @@ -159,7 +159,7 @@ prop_golden_9 :: Property prop_golden_9 = matchMetadata TxMetadataJsonDetailedSchema - [q|{"0": + [r|{"0": {"map": [ { "k": {"string": "aaa"} , "v": {"string": "b4"} diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Autobalance.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Autobalance.hs index 7fb9c0f70d..25c71b1e39 100644 --- a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Autobalance.hs +++ b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Autobalance.hs @@ -162,7 +162,7 @@ prop_make_transaction_body_autobalance_no_change = H.propertyOnce $ do LedgerProtocolParameters <$> H.readJsonFileOk "test/cardano-api-test/files/input/protocol-parameters/conway.json" - let expectedFee = 170_077 + let expectedFee = 171_617 utxoValue = 5_000_000 let address = @@ -394,7 +394,7 @@ prop_make_transaction_body_autobalance_when_deregistering_certs = H.propertyOnce H.note_ "Sanity check: inputs == outputs" mconcat [deregDeposit, txInputsTotalCoin] === mconcat [txOutCoin, fee, changeCoin] - 180_901 === fee + 182_441 === fee prop_make_transaction_body_autobalance_multi_asset_collateral :: Property prop_make_transaction_body_autobalance_multi_asset_collateral = H.propertyOnce $ do @@ -651,6 +651,7 @@ loadPlutusWitness ceo = do H.leftFail $ deserialiseFromTextEnvelopeAnyOf textEnvTypes envelope let scriptLangInEra = case ceo of ConwayEraOnwardsConway -> PlutusScriptV3InConway + ConwayEraOnwardsDijkstra -> PlutusScriptV3InDijkstra pure ( hashScript s , PlutusScriptWitness diff --git a/cardano-api/test/cardano-api-test/files/input/genesis/spec.alonzo-v2-cost-model-array-185.json b/cardano-api/test/cardano-api-test/files/input/genesis/spec.alonzo-v2-cost-model-array-185.json deleted file mode 100644 index 2b5ae7754a..0000000000 --- a/cardano-api/test/cardano-api-test/files/input/genesis/spec.alonzo-v2-cost-model-array-185.json +++ /dev/null @@ -1,375 +0,0 @@ -{ - "collateralPercentage": 150, - "costModels": { - "PlutusV1": [ - 205665, - 812, - 1, - 1, - 1000, - 571, - 0, - 1, - 1000, - 24177, - 4, - 1, - 1000, - 32, - 117366, - 10475, - 4, - 23000, - 100, - 23000, - 100, - 23000, - 100, - 23000, - 100, - 23000, - 100, - 23000, - 100, - 100, - 100, - 23000, - 100, - 19537, - 32, - 175354, - 32, - 46417, - 4, - 221973, - 511, - 0, - 1, - 89141, - 32, - 497525, - 14068, - 4, - 2, - 196500, - 453240, - 220, - 0, - 1, - 1, - 1000, - 28662, - 4, - 2, - 245000, - 216773, - 62, - 1, - 1060367, - 12586, - 1, - 208512, - 421, - 1, - 187000, - 1000, - 52998, - 1, - 80436, - 32, - 43249, - 32, - 1000, - 32, - 80556, - 1, - 57667, - 4, - 1000, - 10, - 197145, - 156, - 1, - 197145, - 156, - 1, - 204924, - 473, - 1, - 208896, - 511, - 1, - 52467, - 32, - 64832, - 32, - 65493, - 32, - 22558, - 32, - 16563, - 32, - 76511, - 32, - 196500, - 453240, - 220, - 0, - 1, - 1, - 69522, - 11687, - 0, - 1, - 60091, - 32, - 196500, - 453240, - 220, - 0, - 1, - 1, - 196500, - 453240, - 220, - 0, - 1, - 1, - 806990, - 30482, - 4, - 1927926, - 82523, - 4, - 265318, - 0, - 4, - 0, - 85931, - 32, - 205665, - 812, - 1, - 1, - 41182, - 32, - 212342, - 32, - 31220, - 32, - 32696, - 32, - 43357, - 32, - 32247, - 32, - 38314, - 32, - 9462713, - 1021, - 10 - ], - "PlutusV2": [ - 205665, - 812, - 1, - 1, - 1000, - 571, - 0, - 1, - 1000, - 24177, - 4, - 1, - 1000, - 32, - 117366, - 10475, - 4, - 23000, - 100, - 23000, - 100, - 23000, - 100, - 23000, - 100, - 23000, - 100, - 23000, - 100, - 100, - 100, - 23000, - 100, - 19537, - 32, - 175354, - 32, - 46417, - 4, - 221973, - 511, - 0, - 1, - 89141, - 32, - 497525, - 14068, - 4, - 2, - 196500, - 453240, - 220, - 0, - 1, - 1, - 1000, - 28662, - 4, - 2, - 245000, - 216773, - 62, - 1, - 1060367, - 12586, - 1, - 208512, - 421, - 1, - 187000, - 1000, - 52998, - 1, - 80436, - 32, - 43249, - 32, - 1000, - 32, - 80556, - 1, - 57667, - 4, - 1000, - 10, - 197145, - 156, - 1, - 197145, - 156, - 1, - 204924, - 473, - 1, - 208896, - 511, - 1, - 52467, - 32, - 64832, - 32, - 65493, - 32, - 22558, - 32, - 16563, - 32, - 76511, - 32, - 196500, - 453240, - 220, - 0, - 1, - 1, - 69522, - 11687, - 0, - 1, - 60091, - 32, - 196500, - 453240, - 220, - 0, - 1, - 1, - 196500, - 453240, - 220, - 0, - 1, - 1, - 1159724, - 392670, - 0, - 2, - 806990, - 30482, - 4, - 1927926, - 82523, - 4, - 265318, - 0, - 4, - 0, - 85931, - 32, - 205665, - 812, - 1, - 1, - 41182, - 32, - 212342, - 32, - 31220, - 32, - 32696, - 32, - 43357, - 32, - 32247, - 32, - 38314, - 32, - 35892428, - 10, - 9462713, - 1021, - 10, - 38887044, - 32947, - 10, - 1292075, - 24469, - 74, - 0, - 1, - 936157, - 49601, - 237, - 0, - 1 - ] - }, - "executionPrices": { - "prMem": 0.0577, - "prSteps": 7.21e-05 - }, - "lovelacePerUTxOWord": 34482, - "maxBlockExUnits": { - "exUnitsMem": 62000000, - "exUnitsSteps": 40000000000 - }, - "maxCollateralInputs": 3, - "maxTxExUnits": { - "exUnitsMem": 14000000, - "exUnitsSteps": 10000000000 - }, - "maxValueSize": 5000 -} diff --git a/cardano-api/test/cardano-api-test/files/input/genesis/spec.alonzo-v2-cost-model-map-175.json b/cardano-api/test/cardano-api-test/files/input/genesis/spec.alonzo-v2-cost-model-map-175.json index 92b58b19d0..3d0d6ba16d 100644 --- a/cardano-api/test/cardano-api-test/files/input/genesis/spec.alonzo-v2-cost-model-map-175.json +++ b/cardano-api/test/cardano-api-test/files/input/genesis/spec.alonzo-v2-cost-model-map-175.json @@ -166,9 +166,6 @@ "unListData-memory-arguments": 32, "unMapData-cpu-arguments": 38314, "unMapData-memory-arguments": 32, - "verifyEd25519Signature-cpu-arguments-intercept": 9462713, - "verifyEd25519Signature-cpu-arguments-slope": 1021, - "verifyEd25519Signature-memory-arguments": 10, "verifySignature-cpu-arguments-intercept": 3345831, "verifySignature-cpu-arguments-slope": 1, "verifySignature-memory-arguments": 1 diff --git a/cardano-api/test/cardano-api-test/files/input/genesis/spec.alonzo-v2-cost-model-map-185.json b/cardano-api/test/cardano-api-test/files/input/genesis/spec.alonzo-v2-cost-model-map-185.json deleted file mode 100644 index 201172e460..0000000000 --- a/cardano-api/test/cardano-api-test/files/input/genesis/spec.alonzo-v2-cost-model-map-185.json +++ /dev/null @@ -1,385 +0,0 @@ -{ - "coinsPerUTxOByte": 4310, - "collateralPercentage": 150, - "costModels": { - "PlutusV1": { - "addInteger-cpu-arguments-intercept": 205665, - "addInteger-cpu-arguments-slope": 812, - "addInteger-memory-arguments-intercept": 1, - "addInteger-memory-arguments-slope": 1, - "appendByteString-cpu-arguments-intercept": 1000, - "appendByteString-cpu-arguments-slope": 571, - "appendByteString-memory-arguments-intercept": 0, - "appendByteString-memory-arguments-slope": 1, - "appendString-cpu-arguments-intercept": 1000, - "appendString-cpu-arguments-slope": 24177, - "appendString-memory-arguments-intercept": 4, - "appendString-memory-arguments-slope": 1, - "bData-cpu-arguments": 1000, - "bData-memory-arguments": 32, - "blake2b-cpu-arguments-intercept": 117366, - "blake2b-cpu-arguments-slope": 10475, - "blake2b-memory-arguments": 4, - "cekApplyCost-exBudgetCPU": 23000, - "cekApplyCost-exBudgetMemory": 100, - "cekBuiltinCost-exBudgetCPU": 23000, - "cekBuiltinCost-exBudgetMemory": 100, - "cekConstCost-exBudgetCPU": 23000, - "cekConstCost-exBudgetMemory": 100, - "cekDelayCost-exBudgetCPU": 23000, - "cekDelayCost-exBudgetMemory": 100, - "cekForceCost-exBudgetCPU": 23000, - "cekForceCost-exBudgetMemory": 100, - "cekLamCost-exBudgetCPU": 23000, - "cekLamCost-exBudgetMemory": 100, - "cekStartupCost-exBudgetCPU": 100, - "cekStartupCost-exBudgetMemory": 100, - "cekVarCost-exBudgetCPU": 23000, - "cekVarCost-exBudgetMemory": 100, - "chooseData-cpu-arguments": 19537, - "chooseData-memory-arguments": 32, - "chooseList-cpu-arguments": 175354, - "chooseList-memory-arguments": 32, - "chooseUnit-cpu-arguments": 46417, - "chooseUnit-memory-arguments": 4, - "consByteString-cpu-arguments-intercept": 221973, - "consByteString-cpu-arguments-slope": 511, - "consByteString-memory-arguments-intercept": 0, - "consByteString-memory-arguments-slope": 1, - "constrData-cpu-arguments": 89141, - "constrData-memory-arguments": 32, - "decodeUtf8-cpu-arguments-intercept": 497525, - "decodeUtf8-cpu-arguments-slope": 14068, - "decodeUtf8-memory-arguments-intercept": 4, - "decodeUtf8-memory-arguments-slope": 2, - "divideInteger-cpu-arguments-constant": 196500, - "divideInteger-cpu-arguments-model-arguments-intercept": 453240, - "divideInteger-cpu-arguments-model-arguments-slope": 220, - "divideInteger-memory-arguments-intercept": 0, - "divideInteger-memory-arguments-minimum": 1, - "divideInteger-memory-arguments-slope": 1, - "encodeUtf8-cpu-arguments-intercept": 1000, - "encodeUtf8-cpu-arguments-slope": 28662, - "encodeUtf8-memory-arguments-intercept": 4, - "encodeUtf8-memory-arguments-slope": 2, - "equalsByteString-cpu-arguments-constant": 245000, - "equalsByteString-cpu-arguments-intercept": 216773, - "equalsByteString-cpu-arguments-slope": 62, - "equalsByteString-memory-arguments": 1, - "equalsData-cpu-arguments-intercept": 1060367, - "equalsData-cpu-arguments-slope": 12586, - "equalsData-memory-arguments": 1, - "equalsInteger-cpu-arguments-intercept": 208512, - "equalsInteger-cpu-arguments-slope": 421, - "equalsInteger-memory-arguments": 1, - "equalsString-cpu-arguments-constant": 187000, - "equalsString-cpu-arguments-intercept": 1000, - "equalsString-cpu-arguments-slope": 52998, - "equalsString-memory-arguments": 1, - "fstPair-cpu-arguments": 80436, - "fstPair-memory-arguments": 32, - "headList-cpu-arguments": 43249, - "headList-memory-arguments": 32, - "iData-cpu-arguments": 1000, - "iData-memory-arguments": 32, - "ifThenElse-cpu-arguments": 80556, - "ifThenElse-memory-arguments": 1, - "indexByteString-cpu-arguments": 57667, - "indexByteString-memory-arguments": 4, - "lengthOfByteString-cpu-arguments": 1000, - "lengthOfByteString-memory-arguments": 10, - "lessThanByteString-cpu-arguments-intercept": 197145, - "lessThanByteString-cpu-arguments-slope": 156, - "lessThanByteString-memory-arguments": 1, - "lessThanEqualsByteString-cpu-arguments-intercept": 197145, - "lessThanEqualsByteString-cpu-arguments-slope": 156, - "lessThanEqualsByteString-memory-arguments": 1, - "lessThanEqualsInteger-cpu-arguments-intercept": 204924, - "lessThanEqualsInteger-cpu-arguments-slope": 473, - "lessThanEqualsInteger-memory-arguments": 1, - "lessThanInteger-cpu-arguments-intercept": 208896, - "lessThanInteger-cpu-arguments-slope": 511, - "lessThanInteger-memory-arguments": 1, - "listData-cpu-arguments": 52467, - "listData-memory-arguments": 32, - "mapData-cpu-arguments": 64832, - "mapData-memory-arguments": 32, - "mkCons-cpu-arguments": 65493, - "mkCons-memory-arguments": 32, - "mkNilData-cpu-arguments": 22558, - "mkNilData-memory-arguments": 32, - "mkNilPairData-cpu-arguments": 16563, - "mkNilPairData-memory-arguments": 32, - "mkPairData-cpu-arguments": 76511, - "mkPairData-memory-arguments": 32, - "modInteger-cpu-arguments-constant": 196500, - "modInteger-cpu-arguments-model-arguments-intercept": 453240, - "modInteger-cpu-arguments-model-arguments-slope": 220, - "modInteger-memory-arguments-intercept": 0, - "modInteger-memory-arguments-minimum": 1, - "modInteger-memory-arguments-slope": 1, - "multiplyInteger-cpu-arguments-intercept": 69522, - "multiplyInteger-cpu-arguments-slope": 11687, - "multiplyInteger-memory-arguments-intercept": 0, - "multiplyInteger-memory-arguments-slope": 1, - "nullList-cpu-arguments": 60091, - "nullList-memory-arguments": 32, - "quotientInteger-cpu-arguments-constant": 196500, - "quotientInteger-cpu-arguments-model-arguments-intercept": 453240, - "quotientInteger-cpu-arguments-model-arguments-slope": 220, - "quotientInteger-memory-arguments-intercept": 0, - "quotientInteger-memory-arguments-minimum": 1, - "quotientInteger-memory-arguments-slope": 1, - "remainderInteger-cpu-arguments-constant": 196500, - "remainderInteger-cpu-arguments-model-arguments-intercept": 453240, - "remainderInteger-cpu-arguments-model-arguments-slope": 220, - "remainderInteger-memory-arguments-intercept": 0, - "remainderInteger-memory-arguments-minimum": 1, - "remainderInteger-memory-arguments-slope": 1, - "sha2_256-cpu-arguments-intercept": 806990, - "sha2_256-cpu-arguments-slope": 30482, - "sha2_256-memory-arguments": 4, - "sha3_256-cpu-arguments-intercept": 1927926, - "sha3_256-cpu-arguments-slope": 82523, - "sha3_256-memory-arguments": 4, - "sliceByteString-cpu-arguments-intercept": 265318, - "sliceByteString-cpu-arguments-slope": 0, - "sliceByteString-memory-arguments-intercept": 4, - "sliceByteString-memory-arguments-slope": 0, - "sndPair-cpu-arguments": 85931, - "sndPair-memory-arguments": 32, - "subtractInteger-cpu-arguments-intercept": 205665, - "subtractInteger-cpu-arguments-slope": 812, - "subtractInteger-memory-arguments-intercept": 1, - "subtractInteger-memory-arguments-slope": 1, - "tailList-cpu-arguments": 41182, - "tailList-memory-arguments": 32, - "trace-cpu-arguments": 212342, - "trace-memory-arguments": 32, - "unBData-cpu-arguments": 31220, - "unBData-memory-arguments": 32, - "unConstrData-cpu-arguments": 32696, - "unConstrData-memory-arguments": 32, - "unIData-cpu-arguments": 43357, - "unIData-memory-arguments": 32, - "unListData-cpu-arguments": 32247, - "unListData-memory-arguments": 32, - "unMapData-cpu-arguments": 38314, - "unMapData-memory-arguments": 32, - "verifyEd25519Signature-cpu-arguments-intercept": 9462713, - "verifyEd25519Signature-cpu-arguments-slope": 1021, - "verifyEd25519Signature-memory-arguments": 10, - "verifySignature-cpu-arguments-intercept": 3345831, - "verifySignature-cpu-arguments-slope": 1, - "verifySignature-memory-arguments": 1 - }, - "PlutusV2": { - "addInteger-cpu-arguments-intercept": 205665, - "addInteger-cpu-arguments-slope": 812, - "addInteger-memory-arguments-intercept": 1, - "addInteger-memory-arguments-slope": 1, - "appendByteString-cpu-arguments-intercept": 1000, - "appendByteString-cpu-arguments-slope": 571, - "appendByteString-memory-arguments-intercept": 0, - "appendByteString-memory-arguments-slope": 1, - "appendString-cpu-arguments-intercept": 1000, - "appendString-cpu-arguments-slope": 24177, - "appendString-memory-arguments-intercept": 4, - "appendString-memory-arguments-slope": 1, - "bData-cpu-arguments": 1000, - "bData-memory-arguments": 32, - "blake2b_256-cpu-arguments-intercept": 117366, - "blake2b_256-cpu-arguments-slope": 10475, - "blake2b_256-memory-arguments": 4, - "cekApplyCost-exBudgetCPU": 23000, - "cekApplyCost-exBudgetMemory": 100, - "cekBuiltinCost-exBudgetCPU": 23000, - "cekBuiltinCost-exBudgetMemory": 100, - "cekConstCost-exBudgetCPU": 23000, - "cekConstCost-exBudgetMemory": 100, - "cekDelayCost-exBudgetCPU": 23000, - "cekDelayCost-exBudgetMemory": 100, - "cekForceCost-exBudgetCPU": 23000, - "cekForceCost-exBudgetMemory": 100, - "cekLamCost-exBudgetCPU": 23000, - "cekLamCost-exBudgetMemory": 100, - "cekStartupCost-exBudgetCPU": 100, - "cekStartupCost-exBudgetMemory": 100, - "cekVarCost-exBudgetCPU": 23000, - "cekVarCost-exBudgetMemory": 100, - "chooseData-cpu-arguments": 19537, - "chooseData-memory-arguments": 32, - "chooseList-cpu-arguments": 175354, - "chooseList-memory-arguments": 32, - "chooseUnit-cpu-arguments": 46417, - "chooseUnit-memory-arguments": 4, - "consByteString-cpu-arguments-intercept": 221973, - "consByteString-cpu-arguments-slope": 511, - "consByteString-memory-arguments-intercept": 0, - "consByteString-memory-arguments-slope": 1, - "constrData-cpu-arguments": 89141, - "constrData-memory-arguments": 32, - "decodeUtf8-cpu-arguments-intercept": 497525, - "decodeUtf8-cpu-arguments-slope": 14068, - "decodeUtf8-memory-arguments-intercept": 4, - "decodeUtf8-memory-arguments-slope": 2, - "divideInteger-cpu-arguments-constant": 196500, - "divideInteger-cpu-arguments-model-arguments-intercept": 453240, - "divideInteger-cpu-arguments-model-arguments-slope": 220, - "divideInteger-memory-arguments-intercept": 0, - "divideInteger-memory-arguments-minimum": 1, - "divideInteger-memory-arguments-slope": 1, - "encodeUtf8-cpu-arguments-intercept": 1000, - "encodeUtf8-cpu-arguments-slope": 28662, - "encodeUtf8-memory-arguments-intercept": 4, - "encodeUtf8-memory-arguments-slope": 2, - "equalsByteString-cpu-arguments-constant": 245000, - "equalsByteString-cpu-arguments-intercept": 216773, - "equalsByteString-cpu-arguments-slope": 62, - "equalsByteString-memory-arguments": 1, - "equalsData-cpu-arguments-intercept": 1060367, - "equalsData-cpu-arguments-slope": 12586, - "equalsData-memory-arguments": 1, - "equalsInteger-cpu-arguments-intercept": 208512, - "equalsInteger-cpu-arguments-slope": 421, - "equalsInteger-memory-arguments": 1, - "equalsString-cpu-arguments-constant": 187000, - "equalsString-cpu-arguments-intercept": 1000, - "equalsString-cpu-arguments-slope": 52998, - "equalsString-memory-arguments": 1, - "fstPair-cpu-arguments": 80436, - "fstPair-memory-arguments": 32, - "headList-cpu-arguments": 43249, - "headList-memory-arguments": 32, - "iData-cpu-arguments": 1000, - "iData-memory-arguments": 32, - "ifThenElse-cpu-arguments": 80556, - "ifThenElse-memory-arguments": 1, - "indexByteString-cpu-arguments": 57667, - "indexByteString-memory-arguments": 4, - "lengthOfByteString-cpu-arguments": 1000, - "lengthOfByteString-memory-arguments": 10, - "lessThanByteString-cpu-arguments-intercept": 197145, - "lessThanByteString-cpu-arguments-slope": 156, - "lessThanByteString-memory-arguments": 1, - "lessThanEqualsByteString-cpu-arguments-intercept": 197145, - "lessThanEqualsByteString-cpu-arguments-slope": 156, - "lessThanEqualsByteString-memory-arguments": 1, - "lessThanEqualsInteger-cpu-arguments-intercept": 204924, - "lessThanEqualsInteger-cpu-arguments-slope": 473, - "lessThanEqualsInteger-memory-arguments": 1, - "lessThanInteger-cpu-arguments-intercept": 208896, - "lessThanInteger-cpu-arguments-slope": 511, - "lessThanInteger-memory-arguments": 1, - "listData-cpu-arguments": 52467, - "listData-memory-arguments": 32, - "mapData-cpu-arguments": 64832, - "mapData-memory-arguments": 32, - "mkCons-cpu-arguments": 65493, - "mkCons-memory-arguments": 32, - "mkNilData-cpu-arguments": 22558, - "mkNilData-memory-arguments": 32, - "mkNilPairData-cpu-arguments": 16563, - "mkNilPairData-memory-arguments": 32, - "mkPairData-cpu-arguments": 76511, - "mkPairData-memory-arguments": 32, - "modInteger-cpu-arguments-constant": 196500, - "modInteger-cpu-arguments-model-arguments-intercept": 453240, - "modInteger-cpu-arguments-model-arguments-slope": 220, - "modInteger-memory-arguments-intercept": 0, - "modInteger-memory-arguments-minimum": 1, - "modInteger-memory-arguments-slope": 1, - "multiplyInteger-cpu-arguments-intercept": 69522, - "multiplyInteger-cpu-arguments-slope": 11687, - "multiplyInteger-memory-arguments-intercept": 0, - "multiplyInteger-memory-arguments-slope": 1, - "nullList-cpu-arguments": 60091, - "nullList-memory-arguments": 32, - "quotientInteger-cpu-arguments-constant": 196500, - "quotientInteger-cpu-arguments-model-arguments-intercept": 453240, - "quotientInteger-cpu-arguments-model-arguments-slope": 220, - "quotientInteger-memory-arguments-intercept": 0, - "quotientInteger-memory-arguments-minimum": 1, - "quotientInteger-memory-arguments-slope": 1, - "remainderInteger-cpu-arguments-constant": 196500, - "remainderInteger-cpu-arguments-model-arguments-intercept": 453240, - "remainderInteger-cpu-arguments-model-arguments-slope": 220, - "remainderInteger-memory-arguments-intercept": 0, - "remainderInteger-memory-arguments-minimum": 1, - "remainderInteger-memory-arguments-slope": 1, - "serialiseData-cpu-arguments-intercept": 1159724, - "serialiseData-cpu-arguments-slope": 392670, - "serialiseData-memory-arguments-intercept": 0, - "serialiseData-memory-arguments-slope": 2, - "sha2_256-cpu-arguments-intercept": 806990, - "sha2_256-cpu-arguments-slope": 30482, - "sha2_256-memory-arguments": 4, - "sha3_256-cpu-arguments-intercept": 1927926, - "sha3_256-cpu-arguments-slope": 82523, - "sha3_256-memory-arguments": 4, - "sliceByteString-cpu-arguments-intercept": 265318, - "sliceByteString-cpu-arguments-slope": 0, - "sliceByteString-memory-arguments-intercept": 4, - "sliceByteString-memory-arguments-slope": 0, - "sndPair-cpu-arguments": 85931, - "sndPair-memory-arguments": 32, - "subtractInteger-cpu-arguments-intercept": 205665, - "subtractInteger-cpu-arguments-slope": 812, - "subtractInteger-memory-arguments-intercept": 1, - "subtractInteger-memory-arguments-slope": 1, - "tailList-cpu-arguments": 41182, - "tailList-memory-arguments": 32, - "trace-cpu-arguments": 212342, - "trace-memory-arguments": 32, - "unBData-cpu-arguments": 31220, - "unBData-memory-arguments": 32, - "unConstrData-cpu-arguments": 32696, - "unConstrData-memory-arguments": 32, - "unIData-cpu-arguments": 43357, - "unIData-memory-arguments": 32, - "unListData-cpu-arguments": 32247, - "unListData-memory-arguments": 32, - "unMapData-cpu-arguments": 38314, - "unMapData-memory-arguments": 32, - "verifyEcdsaSecp256k1Signature-cpu-arguments": 35892428, - "verifyEcdsaSecp256k1Signature-memory-arguments": 10, - "verifyEd25519Signature-cpu-arguments-intercept": 57996947, - "verifyEd25519Signature-cpu-arguments-slope": 18975, - "verifyEd25519Signature-memory-arguments": 10, - "verifySchnorrSecp256k1Signature-cpu-arguments-intercept": 38887044, - "verifySchnorrSecp256k1Signature-cpu-arguments-slope": 32947, - "verifySchnorrSecp256k1Signature-memory-arguments": 10, - "integerToByteString-cpu-arguments-c0": 1292075, - "integerToByteString-cpu-arguments-c1": 24469, - "integerToByteString-cpu-arguments-c2": 74, - "integerToByteString-memory-arguments-intercept": 0, - "integerToByteString-memory-arguments-slope": 1, - "byteStringToInteger-cpu-arguments-c0": 936157, - "byteStringToInteger-cpu-arguments-c1": 49601, - "byteStringToInteger-cpu-arguments-c2": 237, - "byteStringToInteger-memory-arguments-intercept": 0, - "byteStringToInteger-memory-arguments-slope": 1 - } - }, - "executionPrices": { - "prMem": { - "denominator": 10000, - "numerator": 577 - }, - "prSteps": { - "denominator": 10000000, - "numerator": 721 - } - }, - "lovelacePerUTxOWord": 4310, - "maxBlockExUnits": { - "exUnitsMem": 62000000, - "exUnitsSteps": 40000000000 - }, - "maxCollateralInputs": 3, - "maxTxExUnits": { - "exUnitsMem": 14000000, - "exUnitsSteps": 10000000000 - }, - "maxValueSize": 5000 -} diff --git a/cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto b/cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto index d893bc72f0..2d71d28d3d 100644 --- a/cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto +++ b/cardano-rpc/proto/utxorpc/v1alpha/cardano/cardano.proto @@ -38,13 +38,14 @@ message MultiAsset { } // Represents a script in Cardano. -// TODO u5c: removed native script representation +// TODO u5c: removed native script representation, added plutus_v4 message Script { oneof script { bytes native = 1; // Native script. bytes plutus_v1 = 2; // Plutus V1 script. bytes plutus_v2 = 3; // Plutus V2 script. bytes plutus_v3 = 4; // Plutus V3 script. + bytes plutus_v4 = 5; // Plutus V4 script. } } @@ -81,6 +82,7 @@ message CostModels { CostModel plutus_v1 = 1; CostModel plutus_v2 = 2; CostModel plutus_v3 = 3; + CostModel plutus_v4 = 4; } message VotingThresholds { diff --git a/cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs b/cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs index efde50a6be..3f727afd26 100644 --- a/cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs +++ b/cardano-rpc/src/Cardano/Rpc/Server/Internal/Orphans.hs @@ -86,6 +86,8 @@ instance Inject (ReferenceScript era) (Proto UtxoRpc.Script) where defMessage & #plutusV2 .~ serialiseToRawBytes ps PlutusScript PlutusScriptV3 ps -> defMessage & #plutusV3 .~ serialiseToRawBytes ps + PlutusScript PlutusScriptV4 ps -> + defMessage & #plutusV4 .~ serialiseToRawBytes ps instance IsCardanoEra era => Inject (UTxO era) [Proto UtxoRpc.AnyUtxoData] where inject utxo = @@ -161,6 +163,7 @@ instance L.ConwayEraPParams lera => Inject (L.PParams lera) (Proto UtxoRpc.PPara & #costModels . #plutusV1 . #values .~ (join . maybeToList) (M.lookup L.PlutusV1 pparamsCostModels) & #costModels . #plutusV2 . #values .~ (join . maybeToList) (M.lookup L.PlutusV2 pparamsCostModels) & #costModels . #plutusV3 . #values .~ (join . maybeToList) (M.lookup L.PlutusV3 pparamsCostModels) + & #costModels . #plutusV4 . #values .~ (join . maybeToList) (M.lookup L.PlutusV4 pparamsCostModels) & #prices . #steps .~ pparams ^. L.ppPricesL . to L.prSteps . to L.unboundRational . to inject & #prices . #memory .~ pparams ^. L.ppPricesL . to L.prMem . to L.unboundRational . to inject & #maxExecutionUnitsPerTransaction .~ pparams ^. L.ppMaxTxExUnitsL . to inject diff --git a/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Type.hs b/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Type.hs index 4cc5d56939..9a4e8f9f82 100644 --- a/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Type.hs +++ b/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Type.hs @@ -83,9 +83,10 @@ utxoRpcPParamsToProtocolParams era pp = conwayEraOnwardsConstraints (convert era cm1 <- L.mkCostModel L.PlutusV1 $ pp ^. #costModels . #plutusV1 . #values cm2 <- L.mkCostModel L.PlutusV2 $ pp ^. #costModels . #plutusV2 . #values cm3 <- L.mkCostModel L.PlutusV3 $ pp ^. #costModels . #plutusV3 . #values + cm4 <- L.mkCostModel L.PlutusV4 $ pp ^. #costModels . #plutusV4 . #values -- do not add empty cost models let nonEmptyCostModels = - fromList . flip mapMaybe [cm1, cm2, cm3] $ \cm -> + fromList . flip mapMaybe [cm1, cm2, cm3, cm4] $ \cm -> if not (null $ L.getCostModelParams cm) then Just (L.getCostModelLanguage cm, cm) else Nothing diff --git a/cardano-rpc/test/cardano-rpc-test/Test/Cardano/Rpc/ProtocolParameters.hs b/cardano-rpc/test/cardano-rpc-test/Test/Cardano/Rpc/ProtocolParameters.hs index 3564e5f88f..16efc7fd8b 100644 --- a/cardano-rpc/test/cardano-rpc-test/Test/Cardano/Rpc/ProtocolParameters.hs +++ b/cardano-rpc/test/cardano-rpc-test/Test/Cardano/Rpc/ProtocolParameters.hs @@ -35,7 +35,6 @@ hprop_roundtrip_protocol_parameters = H.property $ do pp <- fmap unLedgerProtocolParameters . H.forAll $ genValidProtocolParameters (convert era) let costModels = L.costModelsValid $ pp ^. L.ppCostModelsL mCms = map (`M.lookup` costModels) [minBound .. maxBound] - nonEmptyCostModels = fromList . flip mapMaybe mCms $ \mCm -> mCm >>= \cm -> diff --git a/cardano-wasm/cardano-wasm.cabal b/cardano-wasm/cardano-wasm.cabal index 78a26de2b0..6cbe7091a0 100644 --- a/cardano-wasm/cardano-wasm.cabal +++ b/cardano-wasm/cardano-wasm.cabal @@ -85,7 +85,7 @@ test-suite cardano-wasm-golden build-depends: filepath, hedgehog >=1.1, - hedgehog-extras ^>=0.8, + hedgehog-extras ^>=0.10, tasty, tasty-hedgehog, diff --git a/flake.lock b/flake.lock index 3b72672e95..397251a756 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1750412109, - "narHash": "sha256-v5AlraKLH2Rgl3HRJb/DciXIkOlF5pD/RewHB6nDlrM=", + "lastModified": 1758547838, + "narHash": "sha256-QvqwgT4yN+52SWxQWQ3cS5V64C1rQrQKaLCYRZH7bC4=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "25868b1d259155d46b8c0089f12076f1c7f94cab", + "rev": "6174af87848e7b5e652bb19035f658e10f094299", "type": "github" }, "original": { @@ -187,23 +187,6 @@ "type": "github" } }, - "ghc-8.6.5-iohk": { - "flake": false, - "locked": { - "lastModified": 1600920045, - "narHash": "sha256-DO6kxJz248djebZLpSzTGD6s8WRpNI9BTwUeOf5RwY8=", - "owner": "input-output-hk", - "repo": "ghc", - "rev": "95713a6ecce4551240da7c96b6176f980af75cae", - "type": "github" - }, - "original": { - "owner": "input-output-hk", - "ref": "release/8.6.5-iohk", - "repo": "ghc", - "type": "github" - } - }, "ghc-wasm-meta": { "inputs": { "flake-utils": "flake-utils_2", @@ -228,11 +211,11 @@ "hackage-for-stackage": { "flake": false, "locked": { - "lastModified": 1751588803, - "narHash": "sha256-GrqmoainT75ubT2LzxpBwErE+bVkqKdYDTaNOneJRVI=", + "lastModified": 1757550345, + "narHash": "sha256-rfiHjwOQiDdHuHhZh8vY0EdZ4ZCFHzp5ZsLLvoWEwoM=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "19d76124eeff6de252bf1ceb1c6c0d9d1dc65ab7", + "rev": "78cf5476bbc1ab5c0333aaa1effab40f082d3910", "type": "github" }, "original": { @@ -261,11 +244,11 @@ "hackageNix": { "flake": false, "locked": { - "lastModified": 1750624265, - "narHash": "sha256-6G+1a6WS1Y2CLWz+5MpUAvJs03pGMhpIZBaUAH3wQ1Y=", + "lastModified": 1757556832, + "narHash": "sha256-wYDrrdoMjh0Zgmshm5YpM3b/n3U5I9cCw1790g9gKPM=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "275b94a4dffdd33b33fd734e01066715da4d7f9c", + "rev": "42d89c223129ae35497ed4b4f3882071ccf8bef7", "type": "github" }, "original": { @@ -282,7 +265,6 @@ "cabal-36": "cabal-36", "cardano-shell": "cardano-shell", "flake-compat": "flake-compat_2", - "ghc-8.6.5-iohk": "ghc-8.6.5-iohk", "hackage": [ "hackageNix" ], @@ -316,11 +298,11 @@ "stackage": "stackage" }, "locked": { - "lastModified": 1751590330, - "narHash": "sha256-tTVU0e/Cw34cXcWFxpJqY26N0hACMY6DynEWmNjUjBc=", + "lastModified": 1757551920, + "narHash": "sha256-ILLNxwMUvKuThErkBypvtYh+FnUl3W/KIKu9N1DAGEw=", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "d5fba239c93e25dd5c6addc433e2955d793bc0dd", + "rev": "8e968400bed3102911524dc3fb27e775d0eb5536", "type": "github" }, "original": { @@ -607,11 +589,11 @@ "iserv-proxy": { "flake": false, "locked": { - "lastModified": 1750543273, - "narHash": "sha256-WaswH0Y+Fmupvv8AkIlQBlUy/IdD3Inx9PDuE+5iRYY=", + "lastModified": 1755243078, + "narHash": "sha256-GLbl1YaohKdpzZVJFRdcI1O1oE3F3uBer4lFv3Yy0l8=", "owner": "stable-haskell", "repo": "iserv-proxy", - "rev": "a53c57c9a8d22a66a2f0c4c969e806da03f08c28", + "rev": "150605195cb7183a6fb7bed82f23fedf37c6f52a", "type": "github" }, "original": { @@ -718,11 +700,11 @@ }, "nixpkgs-2505": { "locked": { - "lastModified": 1748852332, - "narHash": "sha256-r/wVJWmLYEqvrJKnL48r90Wn9HWX9SHFt6s4LhuTh7k=", + "lastModified": 1754477006, + "narHash": "sha256-suIgZZHXdb4ca9nN4MIcmdjeN+ZWsTwCtYAG4HExqAo=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "a8167f3cc2f991dd4d0055746df53dae5fd0c953", + "rev": "4896699973299bffae27d0d9828226983544d9e9", "type": "github" }, "original": { @@ -734,11 +716,11 @@ }, "nixpkgs-unstable": { "locked": { - "lastModified": 1748856973, - "narHash": "sha256-RlTsJUvvr8ErjPBsiwrGbbHYW8XbB/oek0Gi78XdWKg=", + "lastModified": 1754393734, + "narHash": "sha256-fbnmAwTQkuXHKBlcL5Nq1sMAzd3GFqCOQgEQw6Hy0Ak=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "e4b09e47ace7d87de083786b404bf232eb6c89d8", + "rev": "a683adc19ff5228af548c6539dbc3440509bfed3", "type": "github" }, "original": { @@ -851,11 +833,11 @@ "stackage": { "flake": false, "locked": { - "lastModified": 1751588014, - "narHash": "sha256-+SODZgQefGx163qP1IhIILVZctM4bxACn5B66JCznug=", + "lastModified": 1757549552, + "narHash": "sha256-Sh12IsULNNwE77gcmJ44yzum+wlMMYsB318TUQVsuVE=", "owner": "input-output-hk", "repo": "stackage.nix", - "rev": "64ef5b96e967d3bc2cc0b90f698e41a1575534d1", + "rev": "d9e033a8d702b5362f0c6c0e01f33c73a6fd30fc", "type": "github" }, "original": { diff --git a/flake.nix b/flake.nix index dac37ce105..cac25bffc1 100644 --- a/flake.nix +++ b/flake.nix @@ -123,11 +123,10 @@ cabal-gild = "1.3.1.2"; fourmolu = "0.18.0.0"; haskell-language-server = "latest"; - # This index-state makes it work for GHC 9.8.2 (it will need to tbe removed for 9.8.4) hlint = "3.10"; }; # and from nixpkgs or other inputs - shell.nativeBuildInputs = with nixpkgs; [gh jq yq-go actionlint shellcheck snappy protobuf]; + shell.nativeBuildInputs = with nixpkgs; [gh git jq yq-go actionlint shellcheck snappy protobuf]; # disable Hoogle until someone request it shell.withHoogle = false; # Skip cross compilers for the shell @@ -172,10 +171,11 @@ substituteInPlace crypton-x509-system.cabal --replace 'Crypt32' 'crypt32' ''; } - ({pkgs, ...}: { - packages.proto-lens-protobuf-types.components.library.build-tools = [pkgs.buildPackages.protobuf]; - packages.cardano-rpc.components.library.build-tools = [pkgs.buildPackages.protobuf]; - }) + # TODO uncomment when reenabling cardano-rpc + # ({pkgs, ...}: { + # packages.proto-lens-protobuf-types.components.library.build-tools = [pkgs.buildPackages.protobuf]; + # packages.cardano-rpc.components.library.build-tools = [pkgs.buildPackages.protobuf]; + # }) ]; }); # ... and construct a flake from the cabal project