From e8dc71fcbedae36d9387cb07b4bd344d7d716b89 Mon Sep 17 00:00:00 2001 From: teodanciu Date: Wed, 18 Oct 2023 14:01:40 +0100 Subject: [PATCH 01/14] Update ledger and consensus versions for 8.6 --- cabal.project | 2 +- cardano-api/cardano-api.cabal | 49 +++++++++++++++++------------------ flake.lock | 6 ++--- 3 files changed, 28 insertions(+), 29 deletions(-) diff --git a/cabal.project b/cabal.project index 4f6e955f92..89dcd648d3 100644 --- a/cabal.project +++ b/cabal.project @@ -14,7 +14,7 @@ repository cardano-haskell-packages -- you need to run if you change them index-state: , hackage.haskell.org 2023-08-06T23:58:58Z - , cardano-haskell-packages 2023-10-23T08:59:58Z + , cardano-haskell-packages 2023-10-26T16:30:55Z packages: cardano-api diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 0f2ca0f360..ae60786bec 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -149,17 +149,17 @@ library internal , cardano-crypto-class ^>= 2.1.2 , cardano-crypto-wrapper ^>= 1.5 , cardano-data >= 1.0 - , cardano-ledger-alonzo >= 1.3.1.1 - , cardano-ledger-allegra >= 1.2.0.2 - , cardano-ledger-api >= 1.3 - , cardano-ledger-babbage >= 1.4.0.1 + , cardano-ledger-alonzo >= 1.5.0 + , cardano-ledger-allegra >= 1.2.3.1 + , cardano-ledger-api ^>= 1.7 + , cardano-ledger-babbage >= 1.5.0 , cardano-ledger-binary , cardano-ledger-byron >= 1.0.0.2 - , cardano-ledger-conway >= 1.5 - , cardano-ledger-core >= 1.4 + , cardano-ledger-conway >= 1.10.0 + , cardano-ledger-core >= 1.8.0 , cardano-ledger-mary >= 1.3.0.2 - , cardano-ledger-shelley >= 1.4.1.0 - , cardano-protocol-tpraos >= 1.0.3.3 + , cardano-ledger-shelley >= 1.7.0 + , cardano-protocol-tpraos >= 1.0.3.6 , cardano-slotting >= 0.1 , cardano-strict-containers >= 0.1 , cborg @@ -177,18 +177,18 @@ library internal , mtl , network , optparse-applicative-fork - , ouroboros-consensus ^>= 0.12 - , ouroboros-consensus-cardano ^>= 0.10 - , ouroboros-consensus-diffusion ^>= 0.8.0.1 - , ouroboros-consensus-protocol ^>= 0.5.0.7 + , ouroboros-consensus ^>= 0.13 + , ouroboros-consensus-cardano ^>= 0.11 + , ouroboros-consensus-diffusion ^>= 0.8.0.2 + , ouroboros-consensus-protocol ^>= 0.6 , ouroboros-network , ouroboros-network-api , ouroboros-network-framework , ouroboros-network-protocols , parsec - , plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib} ^>= 1.11 + , plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib} ^>= 1.15 , prettyprinter - , prettyprinter-configurable ^>= 1.11 + , prettyprinter-configurable ^>= 1.15 , random , scientific , serialise @@ -261,12 +261,11 @@ library gen , cardano-binary >= 1.6 && < 1.8 , cardano-crypto-class ^>= 2.1.2 , cardano-crypto-test ^>= 1.5 - , cardano-ledger-alonzo >= 1.3.1.1 - , cardano-ledger-alonzo-test + , cardano-ledger-alonzo:{cardano-ledger-alonzo, testlib} >= 1.5.0 , cardano-ledger-byron-test >= 1.5 - , cardano-ledger-core:{cardano-ledger-core, testlib} >= 1.4 - , cardano-ledger-shelley >= 1.4.1.0 - , cardano-ledger-conway:testlib >= 1.5 + , cardano-ledger-core:{cardano-ledger-core, testlib} >= 1.8.0 + , cardano-ledger-shelley >= 1.7.0 + , cardano-ledger-conway:testlib >= 1.10.0 , containers , filepath , hedgehog >= 1.1 @@ -292,8 +291,8 @@ test-suite cardano-api-test , cardano-crypto-class ^>= 2.1.2 , cardano-crypto-test ^>= 1.5 , cardano-crypto-tests ^>= 2.1 - , cardano-ledger-api >= 1.3 - , cardano-ledger-core:{cardano-ledger-core, testlib} >= 1.4 + , cardano-ledger-api ^>= 1.7 + , cardano-ledger-core:{cardano-ledger-core, testlib} >= 1.8 , containers , directory , hedgehog >= 1.1 @@ -341,8 +340,8 @@ test-suite cardano-api-golden , cardano-crypto-class ^>= 2.1.2 , cardano-data >= 1.0 , cardano-ledger-alonzo - , cardano-ledger-api >= 1.3 - , cardano-ledger-core:{cardano-ledger-core, testlib} >= 1.4 + , cardano-ledger-api ^>= 1.7 + , cardano-ledger-core:{cardano-ledger-core, testlib} >= 1.8 , cardano-ledger-shelley , cardano-ledger-shelley-test >= 1.2.0.1 , cardano-slotting ^>= 0.1 @@ -352,8 +351,8 @@ test-suite cardano-api-golden , hedgehog >= 1.1 , hedgehog-extras ^>= 0.4.7.0 , microlens - , plutus-core ^>= 1.11 - , plutus-ledger-api ^>= 1.11 + , plutus-core ^>= 1.15 + , plutus-ledger-api ^>= 1.15 , tasty , tasty-hedgehog , time diff --git a/flake.lock b/flake.lock index bda01323c8..6c2865269a 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1698052958, - "narHash": "sha256-n77qAwa5ys02NOaLsexr3Vzk/9zBX2fbXRNyIUajY4c=", + "lastModified": 1698336823, + "narHash": "sha256-95zD20Y5ZB+hx0cZPHlOflo42I3BvM5+XotTYu9Vicg=", "owner": "input-output-hk", "repo": "cardano-haskell-packages", - "rev": "91265f62467228f8a8e58bfdfe3a683f5a24cee9", + "rev": "0d96c2242746dbda8ddef481f3627c5aec21682f", "type": "github" }, "original": { From 4e9cd6ec2aad4ea40ea7e3e32025a3aec863b76d Mon Sep 17 00:00:00 2001 From: teodanciu Date: Wed, 18 Oct 2023 14:02:38 +0100 Subject: [PATCH 02/14] Fix imports of renamed modules --- cardano-api/internal/Cardano/Api/Convenience/Query.hs | 2 +- cardano-api/internal/Cardano/Api/ReexposeLedger.hs | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/Convenience/Query.hs b/cardano-api/internal/Cardano/Api/Convenience/Query.hs index a19231c62e..d77f122930 100644 --- a/cardano-api/internal/Cardano/Api/Convenience/Query.hs +++ b/cardano-api/internal/Cardano/Api/Convenience/Query.hs @@ -34,8 +34,8 @@ import Cardano.Api.Utils import Cardano.Api.Value import qualified Cardano.Ledger.Api as L +import Cardano.Ledger.CertState (DRepState (..)) import qualified Cardano.Ledger.Credential as L -import Cardano.Ledger.DRepDistr (DRepState (..)) import qualified Cardano.Ledger.Keys as L import Ouroboros.Consensus.HardFork.Combinator.AcrossEras (EraMismatch (..)) diff --git a/cardano-api/internal/Cardano/Api/ReexposeLedger.hs b/cardano-api/internal/Cardano/Api/ReexposeLedger.hs index a2dea782d8..c1f040dcb3 100644 --- a/cardano-api/internal/Cardano/Api/ReexposeLedger.hs +++ b/cardano-api/internal/Cardano/Api/ReexposeLedger.hs @@ -115,7 +115,7 @@ import Cardano.Ledger.Babbage.Core (CoinPerByte (..)) import Cardano.Ledger.BaseTypes (DnsName, Network (..), StrictMaybe (..), Url, boundRational, dnsToText, maybeToStrictMaybe, portToWord16, strictMaybeToMaybe, textToDns, textToUrl, unboundRational, urlToText) -import Cardano.Ledger.CertState (csCommitteeCredsL) +import Cardano.Ledger.CertState (DRepState, csCommitteeCredsL) import Cardano.Ledger.Coin (Coin (..), addDeltaCoin, toDeltaCoin) import Cardano.Ledger.Conway.Core (DRepVotingThresholds (..), PoolVotingThresholds (..), dvtPPEconomicGroupL, dvtPPGovGroupL, dvtPPNetworkGroupL, dvtPPTechnicalGroupL, @@ -124,11 +124,11 @@ import Cardano.Ledger.Conway.Governance (Anchor (..), GovActionId (..) Vote (..), Voter (..), VotingProcedure (..)) import Cardano.Ledger.Conway.TxCert (ConwayDelegCert (..), ConwayEraTxCert (..), ConwayGovCert (..), ConwayTxCert (..), Delegatee (..), pattern UpdateDRepTxCert) -import Cardano.Ledger.Core (DRep (..), EraCrypto, PParams (..), PoolCert (..), - fromEraCBOR, toEraCBOR) +import Cardano.Ledger.Core (EraCrypto, PParams (..), PoolCert (..), fromEraCBOR, + toEraCBOR) import Cardano.Ledger.Credential (Credential (..)) import Cardano.Ledger.Crypto (Crypto, StandardCrypto) -import Cardano.Ledger.DRepDistr (DRepState, drepAnchorL, drepDepositL, drepExpiryL) +import Cardano.Ledger.DRep (DRep (..), drepAnchorL, drepDepositL, drepExpiryL) import Cardano.Ledger.Keys (HasKeyRole (..), KeyHash (..), KeyRole (..)) import Cardano.Ledger.PoolParams (PoolMetadata (..), PoolParams (..), StakePoolRelay (..)) import Cardano.Ledger.Shelley.TxCert (EraTxCert (..), GenesisDelegCert (..), MIRCert (..), From 4f68e4ffaf1ed372ea8c5c61c71662919bc85e2f Mon Sep 17 00:00:00 2001 From: teodanciu Date: Wed, 18 Oct 2023 14:02:47 +0100 Subject: [PATCH 03/14] Adapt to new type `HKDNoUpdate f ProtVer` of `cppProtocolVersion` which is reflecting the fact that in Conway, protocol version cannot be changed via PParamsUpdate. --- cardano-api/internal/Cardano/Api/Orphans.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/cardano-api/internal/Cardano/Api/Orphans.hs b/cardano-api/internal/Cardano/Api/Orphans.hs index 5fff888259..351ba6b3e3 100644 --- a/cardano-api/internal/Cardano/Api/Orphans.hs +++ b/cardano-api/internal/Cardano/Api/Orphans.hs @@ -24,6 +24,7 @@ import qualified Cardano.Ledger.Conway.PParams as Ledger import Cardano.Ledger.Crypto (StandardCrypto) import qualified Cardano.Ledger.Crypto as CC (Crypto) import qualified Cardano.Ledger.Crypto as Crypto +import Cardano.Ledger.HKD (NoUpdate (..)) import qualified Cardano.Ledger.Shelley.PParams as Ledger import qualified Cardano.Protocol.TPraos.API as Ledger import Cardano.Protocol.TPraos.BHeader (HashHeader (..)) @@ -313,7 +314,7 @@ instance Semigroup (Ledger.ConwayPParams StrictMaybe era) where , Ledger.cppA0 = lastMappendWith Ledger.cppA0 p1 p2 , Ledger.cppRho = lastMappendWith Ledger.cppRho p1 p2 , Ledger.cppTau = lastMappendWith Ledger.cppTau p1 p2 - , Ledger.cppProtocolVersion = lastMappendWith Ledger.cppProtocolVersion p1 p2 + , Ledger.cppProtocolVersion = NoUpdate -- For conway, protocol version cannot be changed via `PParamsUpdate` , Ledger.cppMinPoolCost = lastMappendWith Ledger.cppMinPoolCost p1 p2 , Ledger.cppCoinsPerUTxOByte = lastMappendWith Ledger.cppCoinsPerUTxOByte p1 p2 , Ledger.cppCostModels = lastMappendWith Ledger.cppCostModels p1 p2 From 2e5662104ec32c85689170f80cf83514a31cc493 Mon Sep 17 00:00:00 2001 From: teodanciu Date: Tue, 17 Oct 2023 13:45:19 +0100 Subject: [PATCH 04/14] Adapt `createEraBasedProtocolParamUpdate` to >=8 constraint --- .../Cardano/Api/ProtocolParameters.hs | 29 +++++++++++++++---- 1 file changed, 23 insertions(+), 6 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/ProtocolParameters.hs b/cardano-api/internal/Cardano/Api/ProtocolParameters.hs index c6a2145769..199176ca3c 100644 --- a/cardano-api/internal/Cardano/Api/ProtocolParameters.hs +++ b/cardano-api/internal/Cardano/Api/ProtocolParameters.hs @@ -268,33 +268,38 @@ createEraBasedProtocolParamUpdate sbe eraPParamsUpdate = case eraPParamsUpdate of ShelleyEraBasedProtocolParametersUpdate c depAfterMary depAfterAlonzo -> let Ledger.PParamsUpdate common = createCommonPParamsUpdate c + Ledger.PParamsUpdate withProtVer = createPreConwayProtocolVersionUpdate c Ledger.PParamsUpdate depAfterMary' = createDeprecatedAfterMaryPParams sbe depAfterMary Ledger.PParamsUpdate depAfterAlonzo' = createDeprecatedAfterAlonzoPParams sbe depAfterAlonzo - in Ledger.PParamsUpdate $ common <> depAfterMary' <> depAfterAlonzo' + in Ledger.PParamsUpdate $ common <> withProtVer <> depAfterMary' <> depAfterAlonzo' AllegraEraBasedProtocolParametersUpdate c depAfterMary depAfterAlonzo -> let Ledger.PParamsUpdate common = createCommonPParamsUpdate c + Ledger.PParamsUpdate withProtVer = createPreConwayProtocolVersionUpdate c Ledger.PParamsUpdate depAfterMary' = createDeprecatedAfterMaryPParams sbe depAfterMary Ledger.PParamsUpdate depAfterAlonzo' = createDeprecatedAfterAlonzoPParams sbe depAfterAlonzo - in Ledger.PParamsUpdate $ common <> depAfterMary' <> depAfterAlonzo' + in Ledger.PParamsUpdate $ common <> withProtVer <> depAfterMary' <> depAfterAlonzo' MaryEraBasedProtocolParametersUpdate c depAfterMary depAfterAlonzo -> let Ledger.PParamsUpdate common = createCommonPParamsUpdate c + Ledger.PParamsUpdate withProtVer = createPreConwayProtocolVersionUpdate c Ledger.PParamsUpdate depAfterMary' = createDeprecatedAfterMaryPParams sbe depAfterMary Ledger.PParamsUpdate depAfterAlonzo' = createDeprecatedAfterAlonzoPParams sbe depAfterAlonzo - in Ledger.PParamsUpdate $ common <> depAfterMary' <> depAfterAlonzo' + in Ledger.PParamsUpdate $ common <> withProtVer <> depAfterMary' <> depAfterAlonzo' AlonzoEraBasedProtocolParametersUpdate c depAfterAlonzoA introInAlon -> let Ledger.PParamsUpdate common = createCommonPParamsUpdate c + Ledger.PParamsUpdate withProtVer = createPreConwayProtocolVersionUpdate c Ledger.PParamsUpdate preAl' = createPParamsUpdateIntroducedInAlonzo AlonzoEraOnwardsAlonzo introInAlon Ledger.PParamsUpdate depAfterAlonzoA' = createDeprecatedAfterAlonzoPParams sbe depAfterAlonzoA - in Ledger.PParamsUpdate $ common <> preAl' <> depAfterAlonzoA' + in Ledger.PParamsUpdate $ common <> withProtVer <> preAl' <> depAfterAlonzoA' BabbageEraBasedProtocolParametersUpdate c introInAlonzo introInBabbage -> let Ledger.PParamsUpdate common = createCommonPParamsUpdate c + Ledger.PParamsUpdate withProtVer = createPreConwayProtocolVersionUpdate c Ledger.PParamsUpdate inAlonzoPParams = createPParamsUpdateIntroducedInAlonzo AlonzoEraOnwardsBabbage introInAlonzo Ledger.PParamsUpdate inBAb = createIntroducedInBabbagePParams BabbageEraOnwardsBabbage introInBabbage - in Ledger.PParamsUpdate $ common <> inAlonzoPParams <> inBAb + in Ledger.PParamsUpdate $ common <> withProtVer <> inAlonzoPParams <> inBAb ConwayEraBasedProtocolParametersUpdate c introInAlonzo introInBabbage introInConway -> let Ledger.PParamsUpdate common = createCommonPParamsUpdate c @@ -341,9 +346,21 @@ createCommonPParamsUpdate CommonProtocolParametersUpdate{..} = & Ledger.ppuA0L .~ cppPoolPledgeInfluence & Ledger.ppuTauL .~ cppTreasuryExpansion & Ledger.ppuRhoL .~ cppMonetaryExpansion - & Ledger.ppuProtocolVersionL .~ cppProtocolVersion & Ledger.ppuMinPoolCostL .~ cppMinPoolCost +-- | Updating protocol version with PParamUpdate is being prevented in Conway +-- (via the `ProtVerAtMost era 8` constraint in `ppuProtocolVersionL`). +-- As a consequence, ppuProtocolVersionL cannot be used in `createCommonPParamsUpdate`, +-- as was the case pre-Conway. +-- Here we isolate the usage of the lens, so that it can be used in each pre-conway era +-- when creating `Ledger.PParamsUpdate` within `createEraBasedProtocolParamUpdate`. +createPreConwayProtocolVersionUpdate + :: (EraPParams ledgerera, Ledger.ProtVerAtMost ledgerera 8) + => CommonProtocolParametersUpdate + -> Ledger.PParamsUpdate ledgerera +createPreConwayProtocolVersionUpdate CommonProtocolParametersUpdate {cppProtocolVersion} = + Ledger.emptyPParamsUpdate & Ledger.ppuProtocolVersionL .~ cppProtocolVersion + newtype DeprecatedAfterMaryPParams ledgerera = DeprecatedAfterMaryPParams (StrictMaybe Ledger.Coin) -- Minimum UTxO value deriving Show From d32d06fa6d719ae389320adf31a57ae61b66f7c3 Mon Sep 17 00:00:00 2001 From: teodanciu Date: Tue, 17 Oct 2023 14:48:56 +0100 Subject: [PATCH 05/14] Adapt `toLedgerPParamsUpdate` to >=8 constraint in `ppuProtocolVersionL` --- .../Cardano/Api/ProtocolParameters.hs | 41 +++++++++++++------ 1 file changed, 29 insertions(+), 12 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/ProtocolParameters.hs b/cardano-api/internal/Cardano/Api/ProtocolParameters.hs index 199176ca3c..cb92300de8 100644 --- a/cardano-api/internal/Cardano/Api/ProtocolParameters.hs +++ b/cardano-api/internal/Cardano/Api/ProtocolParameters.hs @@ -1194,8 +1194,7 @@ toShelleyCommonPParamsUpdate :: EraPParams ledgerera -> Either ProtocolParametersConversionError (PParamsUpdate ledgerera) toShelleyCommonPParamsUpdate ProtocolParametersUpdate { - protocolUpdateProtocolVersion - , protocolUpdateMaxBlockHeaderSize + protocolUpdateMaxBlockHeaderSize , protocolUpdateMaxBlockBodySize , protocolUpdateMaxTxSize , protocolUpdateTxFeeFixed @@ -1212,7 +1211,6 @@ toShelleyCommonPParamsUpdate a0 <- mapM (boundRationalEither "A0") protocolUpdatePoolPledgeInfluence rho <- mapM (boundRationalEither "Rho") protocolUpdateMonetaryExpansion tau <- mapM (boundRationalEither "Tau") protocolUpdateTreasuryCut - protVer <- mapM mkProtVer protocolUpdateProtocolVersion let ppuCommon = emptyPParamsUpdate & ppuMinFeeAL .~ @@ -1232,7 +1230,6 @@ toShelleyCommonPParamsUpdate & ppuRhoL .~ noInlineMaybeToStrictMaybe rho & ppuTauL .~ noInlineMaybeToStrictMaybe tau - & ppuProtocolVersionL .~ noInlineMaybeToStrictMaybe protVer & ppuMinPoolCostL .~ (toShelleyLovelace <$> noInlineMaybeToStrictMaybe protocolUpdateMinPoolCost) pure ppuCommon @@ -1240,17 +1237,20 @@ toShelleyCommonPParamsUpdate toShelleyPParamsUpdate :: ( EraPParams ledgerera , Ledger.AtMostEra Ledger.MaryEra ledgerera , Ledger.AtMostEra Ledger.AlonzoEra ledgerera + , Ledger.AtMostEra Ledger.BabbageEra ledgerera ) => ProtocolParametersUpdate -> Either ProtocolParametersConversionError (PParamsUpdate ledgerera) toShelleyPParamsUpdate protocolParametersUpdate@ProtocolParametersUpdate { - protocolUpdateDecentralization + protocolUpdateProtocolVersion + , protocolUpdateDecentralization , protocolUpdateExtraPraosEntropy , protocolUpdateMinUTxOValue } = do ppuCommon <- toShelleyCommonPParamsUpdate protocolParametersUpdate d <- mapM (boundRationalEither "D") protocolUpdateDecentralization + protVer <- mapM mkProtVer protocolUpdateProtocolVersion let ppuShelley = ppuCommon & ppuDL .~ noInlineMaybeToStrictMaybe d @@ -1258,6 +1258,7 @@ toShelleyPParamsUpdate (toLedgerNonce <$> noInlineMaybeToStrictMaybe protocolUpdateExtraPraosEntropy) & ppuMinUTxOValueL .~ (toShelleyLovelace <$> noInlineMaybeToStrictMaybe protocolUpdateMinUTxOValue) + & ppuProtocolVersionL .~ noInlineMaybeToStrictMaybe protVer pure ppuShelley @@ -1299,20 +1300,22 @@ toAlonzoPParamsUpdate :: Ledger.Crypto crypto -> Either ProtocolParametersConversionError (PParamsUpdate (Ledger.AlonzoEra crypto)) toAlonzoPParamsUpdate protocolParametersUpdate@ProtocolParametersUpdate { - protocolUpdateDecentralization + protocolUpdateProtocolVersion + , protocolUpdateDecentralization } = do ppuAlonzoCommon <- toAlonzoCommonPParamsUpdate protocolParametersUpdate d <- mapM (boundRationalEither "D") protocolUpdateDecentralization + protVer <- mapM mkProtVer protocolUpdateProtocolVersion let ppuAlonzo = ppuAlonzoCommon & ppuDL .~ noInlineMaybeToStrictMaybe d + & ppuProtocolVersionL .~ noInlineMaybeToStrictMaybe protVer pure ppuAlonzo - -toBabbagePParamsUpdate :: BabbageEraPParams ledgerera - => ProtocolParametersUpdate - -> Either ProtocolParametersConversionError (PParamsUpdate ledgerera) -toBabbagePParamsUpdate +toBabbageCommonPParamsUpdate :: BabbageEraPParams ledgerera + => ProtocolParametersUpdate + -> Either ProtocolParametersConversionError (Ledger.PParamsUpdate ledgerera) +toBabbageCommonPParamsUpdate protocolParametersUpdate@ProtocolParametersUpdate { protocolUpdateUTxOCostPerByte } = do @@ -1324,6 +1327,20 @@ toBabbagePParamsUpdate noInlineMaybeToStrictMaybe protocolUpdateUTxOCostPerByte) pure ppuBabbage +toBabbagePParamsUpdate :: Ledger.Crypto crypto + => ProtocolParametersUpdate + -> Either ProtocolParametersConversionError (Ledger.PParamsUpdate (Ledger.BabbageEra crypto)) +toBabbagePParamsUpdate + protocolParametersUpdate@ProtocolParametersUpdate { + protocolUpdateProtocolVersion + } = do + ppuBabbageCommon <- toBabbageCommonPParamsUpdate protocolParametersUpdate + protVer <- mapM mkProtVer protocolUpdateProtocolVersion + let ppuBabbage = + ppuBabbageCommon + & ppuProtocolVersionL .~ noInlineMaybeToStrictMaybe protVer + pure ppuBabbage + requireParam :: String -> (a -> Either ProtocolParametersConversionError b) -> Maybe a -> Either ProtocolParametersConversionError b requireParam paramName = maybe (Left $ PpceMissingParameter paramName) @@ -1341,7 +1358,7 @@ boundRationalEither name r = maybeToRight (PpceOutOfBounds name r) $ Ledger.boun toConwayPParamsUpdate :: BabbageEraPParams ledgerera => ProtocolParametersUpdate -> Either ProtocolParametersConversionError (PParamsUpdate ledgerera) -toConwayPParamsUpdate = toBabbagePParamsUpdate +toConwayPParamsUpdate = toBabbageCommonPParamsUpdate -- ---------------------------------------------------------------------------- -- Conversion functions: updates from ledger types From ad0cf86016233c8b9c3c294d771743f8a371033d Mon Sep 17 00:00:00 2001 From: teodanciu Date: Tue, 17 Oct 2023 15:08:06 +0100 Subject: [PATCH 06/14] Adapt `fromLedgerPParamsUpdate` to >=8 constraint in ppuProtocolVersionL --- .../Cardano/Api/ProtocolParameters.hs | 43 ++++++++++++++----- 1 file changed, 32 insertions(+), 11 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/ProtocolParameters.hs b/cardano-api/internal/Cardano/Api/ProtocolParameters.hs index cb92300de8..9b9931ac2c 100644 --- a/cardano-api/internal/Cardano/Api/ProtocolParameters.hs +++ b/cardano-api/internal/Cardano/Api/ProtocolParameters.hs @@ -1403,8 +1403,7 @@ fromShelleyCommonPParamsUpdate :: EraPParams ledgerera -> ProtocolParametersUpdate fromShelleyCommonPParamsUpdate ppu = ProtocolParametersUpdate { - protocolUpdateProtocolVersion = (\(Ledger.ProtVer a b) -> (Ledger.getVersion a,b)) <$> - strictMaybeToMaybe (ppu ^. ppuProtocolVersionL) + protocolUpdateProtocolVersion = Nothing , protocolUpdateMaxBlockHeaderSize = strictMaybeToMaybe (ppu ^. ppuMaxBHSizeL) , protocolUpdateMaxBlockBodySize = strictMaybeToMaybe (ppu ^. ppuMaxBBSizeL) , protocolUpdateMaxTxSize = strictMaybeToMaybe (ppu ^. ppuMaxTxSizeL) @@ -1442,12 +1441,15 @@ fromShelleyCommonPParamsUpdate ppu = fromShelleyPParamsUpdate :: ( EraPParams ledgerera , Ledger.AtMostEra Ledger.MaryEra ledgerera , Ledger.AtMostEra Ledger.AlonzoEra ledgerera + , Ledger.AtMostEra Ledger.BabbageEra ledgerera ) => PParamsUpdate ledgerera -> ProtocolParametersUpdate fromShelleyPParamsUpdate ppu = (fromShelleyCommonPParamsUpdate ppu) { - protocolUpdateDecentralization = Ledger.unboundRational <$> + protocolUpdateProtocolVersion = (\(Ledger.ProtVer a b) -> (Ledger.getVersion a,b)) <$> + strictMaybeToMaybe (ppu ^. ppuProtocolVersionL) + , protocolUpdateDecentralization = Ledger.unboundRational <$> strictMaybeToMaybe (ppu ^. ppuDL) , protocolUpdateExtraPraosEntropy = fromLedgerNonce <$> strictMaybeToMaybe (ppu ^. ppuExtraEntropyL) @@ -1455,10 +1457,10 @@ fromShelleyPParamsUpdate ppu = strictMaybeToMaybe (ppu ^. ppuMinUTxOValueL) } -fromAlonzoPParamsUpdate :: AlonzoEraPParams ledgerera +fromAlonzoCommonPParamsUpdate :: AlonzoEraPParams ledgerera => PParamsUpdate ledgerera -> ProtocolParametersUpdate -fromAlonzoPParamsUpdate ppu = +fromAlonzoCommonPParamsUpdate ppu = (fromShelleyCommonPParamsUpdate ppu) { protocolUpdateCostModels = maybe mempty fromAlonzoCostModels (strictMaybeToMaybe (ppu ^. ppuCostModelsL)) @@ -1474,19 +1476,38 @@ fromAlonzoPParamsUpdate ppu = , protocolUpdateUTxOCostPerByte = Nothing } -fromBabbagePParamsUpdate :: BabbageEraPParams ledgerera - => PParamsUpdate ledgerera + +fromAlonzoPParamsUpdate :: Ledger.Crypto crypto + => PParamsUpdate (Ledger.AlonzoEra crypto) + -> ProtocolParametersUpdate +fromAlonzoPParamsUpdate ppu = + (fromAlonzoCommonPParamsUpdate ppu) { + protocolUpdateProtocolVersion = (\(Ledger.ProtVer a b) -> (Ledger.getVersion a,b)) <$> + strictMaybeToMaybe (ppu ^. ppuProtocolVersionL) + } + +fromBabbageCommonPParamsUpdate :: BabbageEraPParams ledgerera + => PParamsUpdate ledgerera + -> ProtocolParametersUpdate +fromBabbageCommonPParamsUpdate ppu = + (fromAlonzoCommonPParamsUpdate ppu) { + protocolUpdateUTxOCostPerByte = fromShelleyLovelace . unCoinPerByte <$> + strictMaybeToMaybe (ppu ^. ppuCoinsPerUTxOByteL) + } + +fromBabbagePParamsUpdate :: Ledger.Crypto crypto + => PParamsUpdate (Ledger.BabbageEra crypto) -> ProtocolParametersUpdate fromBabbagePParamsUpdate ppu = - (fromAlonzoPParamsUpdate ppu) { - protocolUpdateUTxOCostPerByte = fromShelleyLovelace . unCoinPerByte <$> - strictMaybeToMaybe (ppu ^. ppuCoinsPerUTxOByteL) + (fromBabbageCommonPParamsUpdate ppu) { + protocolUpdateProtocolVersion = (\(Ledger.ProtVer a b) -> (Ledger.getVersion a,b)) <$> + strictMaybeToMaybe (ppu ^. ppuProtocolVersionL) } fromConwayPParamsUpdate :: BabbageEraPParams ledgerera => PParamsUpdate ledgerera -> ProtocolParametersUpdate -fromConwayPParamsUpdate = fromBabbagePParamsUpdate +fromConwayPParamsUpdate = fromBabbageCommonPParamsUpdate -- ---------------------------------------------------------------------------- From bf668d405d1236b0482c8acafe917315ff7aaafc Mon Sep 17 00:00:00 2001 From: teodanciu Date: Tue, 17 Oct 2023 15:42:17 +0100 Subject: [PATCH 07/14] Replace `queryCommitteState` with new `queryCommitteeMembersState` --- cardano-api/internal/Cardano/Api/Query.hs | 24 +++++++++++-------- .../internal/Cardano/Api/Query/Expr.hs | 17 ++++++++----- cardano-api/src/Cardano/Api.hs | 2 +- 3 files changed, 26 insertions(+), 17 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/Query.hs b/cardano-api/internal/Cardano/Api/Query.hs index 5947134d33..8e8fae2051 100644 --- a/cardano-api/internal/Cardano/Api/Query.hs +++ b/cardano-api/internal/Cardano/Api/Query.hs @@ -96,6 +96,7 @@ import Cardano.Api.Value import qualified Cardano.Chain.Update.Validation.Interface as Byron.Update import qualified Cardano.Ledger.Api as L +import qualified Cardano.Ledger.Api.State.Query as L import Cardano.Ledger.Binary import qualified Cardano.Ledger.Binary.Plain as Plain import qualified Cardano.Ledger.CertState as L @@ -308,11 +309,14 @@ data QueryInShelleyBasedEra era result where -> QueryInShelleyBasedEra era (Map (Shelley.Credential Shelley.DRepRole StandardCrypto) (L.DRepState StandardCrypto)) QueryDRepStakeDistr - :: Set (Core.DRep StandardCrypto) - -> QueryInShelleyBasedEra era (Map (Core.DRep StandardCrypto) Lovelace) + :: Set (Ledger.DRep StandardCrypto) + -> QueryInShelleyBasedEra era (Map (Ledger.DRep StandardCrypto) Lovelace) - QueryCommitteeState - :: QueryInShelleyBasedEra era (L.CommitteeState (ShelleyLedgerEra era)) + QueryCommitteeMembersState + :: Set (Shelley.Credential Shelley.ColdCommitteeRole StandardCrypto) + -> Set (Shelley.Credential Shelley.HotCommitteeRole StandardCrypto) + -> Set L.MemberStatus + -> QueryInShelleyBasedEra era (L.CommitteeMembersState StandardCrypto) instance NodeToClientVersionOf (QueryInShelleyBasedEra era result) where @@ -336,7 +340,7 @@ instance NodeToClientVersionOf (QueryInShelleyBasedEra era result) where nodeToClientVersionOf QueryGovState = NodeToClientV_16 nodeToClientVersionOf QueryDRepState{} = NodeToClientV_16 nodeToClientVersionOf QueryDRepStakeDistr{} = NodeToClientV_16 - nodeToClientVersionOf QueryCommitteeState = NodeToClientV_16 + nodeToClientVersionOf QueryCommitteeMembersState{} = NodeToClientV_16 deriving instance Show (QueryInShelleyBasedEra era result) @@ -680,8 +684,8 @@ toConsensusQueryShelleyBased erainmode (QueryDRepState creds) = toConsensusQueryShelleyBased erainmode (QueryDRepStakeDistr dreps) = Some (consensusQueryInEraInMode erainmode (Consensus.GetDRepStakeDistr dreps)) -toConsensusQueryShelleyBased erainmode QueryCommitteeState = - Some (consensusQueryInEraInMode erainmode Consensus.GetCommitteeState) +toConsensusQueryShelleyBased erainmode (QueryCommitteeMembersState coldCreds hotCreds statuses) = + Some (consensusQueryInEraInMode erainmode (Consensus.GetCommitteeMembersState coldCreds hotCreds statuses)) consensusQueryInEraInMode :: forall era mode erablock modeblock result result' xs. @@ -969,10 +973,10 @@ fromConsensusQueryResultShelleyBased _ QueryDRepStakeDistr{} q' stakeDistr' = Consensus.GetDRepStakeDistr{} -> Map.map fromShelleyLovelace stakeDistr' _ -> fromConsensusQueryResultMismatch -fromConsensusQueryResultShelleyBased _ QueryCommitteeState{} q' committeeState' = +fromConsensusQueryResultShelleyBased _ QueryCommitteeMembersState{} q' committeeMembersState' = case q' of - Consensus.GetCommitteeState{} -> committeeState' - _ -> fromConsensusQueryResultMismatch + Consensus.GetCommitteeMembersState{} -> committeeMembersState' + _ -> fromConsensusQueryResultMismatch -- | This should /only/ happen if we messed up the mapping in 'toConsensusQuery' -- and 'fromConsensusQueryResult' so they are inconsistent with each other. diff --git a/cardano-api/internal/Cardano/Api/Query/Expr.hs b/cardano-api/internal/Cardano/Api/Query/Expr.hs index 8a806c8659..5db245dad3 100644 --- a/cardano-api/internal/Cardano/Api/Query/Expr.hs +++ b/cardano-api/internal/Cardano/Api/Query/Expr.hs @@ -26,7 +26,7 @@ module Cardano.Api.Query.Expr , querySystemStart , queryUtxo , determineEraExpr - , queryCommitteeState + , queryCommitteeMembersState , queryDRepStakeDistribution , queryDRepState , queryGovState @@ -49,12 +49,12 @@ import qualified Cardano.Api.ReexposeLedger as Ledger import Cardano.Api.Value import qualified Cardano.Ledger.Api as L +import qualified Cardano.Ledger.Api.State.Query as L import qualified Cardano.Ledger.CertState as L import Cardano.Ledger.Core (EraCrypto) import qualified Cardano.Ledger.Credential as L import qualified Cardano.Ledger.Keys as L import Cardano.Ledger.SafeHash -import qualified Cardano.Ledger.Shelley.Core as L import Cardano.Slotting.Slot import Ouroboros.Consensus.HardFork.Combinator.AcrossEras as Consensus @@ -258,9 +258,14 @@ queryDRepStakeDistribution :: () -> LocalStateQueryExpr block point (QueryInMode mode) r IO (Either UnsupportedNtcVersionError (Either EraMismatch (Map (L.DRep L.StandardCrypto) Lovelace))) queryDRepStakeDistribution eraInMode sbe dreps = queryExpr $ QueryInEra eraInMode $ QueryInShelleyBasedEra sbe $ QueryDRepStakeDistr dreps -queryCommitteeState :: () +-- | Returns info about committee members filtered by: cold credentials, hot credentials and statuses. +-- If empty sets are passed as filters, then no filtering is done. +queryCommitteeMembersState :: () => EraInMode era mode -> ShelleyBasedEra era - -> LocalStateQueryExpr block point (QueryInMode mode) r IO (Either UnsupportedNtcVersionError (Either EraMismatch (L.CommitteeState (ShelleyLedgerEra era)))) -queryCommitteeState eraInMode sbe = - queryExpr $ QueryInEra eraInMode $ QueryInShelleyBasedEra sbe QueryCommitteeState + -> Set (L.Credential L.ColdCommitteeRole L.StandardCrypto) + -> Set (L.Credential L.HotCommitteeRole L.StandardCrypto) + -> Set L.MemberStatus + -> LocalStateQueryExpr block point (QueryInMode mode) r IO (Either UnsupportedNtcVersionError (Either EraMismatch (L.CommitteeMembersState L.StandardCrypto))) +queryCommitteeMembersState eraInMode sbe coldCreds hotCreds statuses = + queryExpr $ QueryInEra eraInMode $ QueryInShelleyBasedEra sbe (QueryCommitteeMembersState coldCreds hotCreds statuses) diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 3e0b5f1fcd..a5a541742b 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -991,7 +991,7 @@ module Cardano.Api ( queryGovState, queryDRepState, queryDRepStakeDistribution, - queryCommitteeState, + queryCommitteeMembersState, -- ** DReps DRepKey, From 2d5194b401c66783cd59bc1c66e7cbe7215edbf9 Mon Sep 17 00:00:00 2001 From: teodanciu Date: Wed, 18 Oct 2023 13:56:39 +0100 Subject: [PATCH 08/14] Adapt to new anchor parameter in `ConwayResignCommitteeColdKey` --- cardano-api/internal/Cardano/Api/Certificate.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/Certificate.hs b/cardano-api/internal/Cardano/Api/Certificate.hs index d86e0fda79..36070074d3 100644 --- a/cardano-api/internal/Cardano/Api/Certificate.hs +++ b/cardano-api/internal/Cardano/Api/Certificate.hs @@ -421,16 +421,18 @@ data CommitteeColdkeyResignationRequirements era where CommitteeColdkeyResignationRequirements :: ConwayEraOnwards era -> Ledger.KeyHash Ledger.ColdCommitteeRole (EraCrypto (ShelleyLedgerEra era)) + -> Maybe (Ledger.Anchor (EraCrypto (ShelleyLedgerEra era))) -> CommitteeColdkeyResignationRequirements era makeCommitteeColdkeyResignationCertificate :: () => CommitteeColdkeyResignationRequirements era -> Certificate era -makeCommitteeColdkeyResignationCertificate (CommitteeColdkeyResignationRequirements cOnwards coldKeyHash) = +makeCommitteeColdkeyResignationCertificate (CommitteeColdkeyResignationRequirements cOnwards coldKeyHash anchor) = ConwayCertificate cOnwards . Ledger.ConwayTxCertGov $ Ledger.ConwayResignCommitteeColdKey (Ledger.KeyHashObj coldKeyHash) + (noInlineMaybeToStrictMaybe anchor) data DRepUnregistrationRequirements era where DRepUnregistrationRequirements @@ -494,7 +496,7 @@ selectStakeCredential = fmap fromShelleyStakeCredential . \case Ledger.DelegTxCert sCred _ -> Just sCred Ledger.RegDepositDelegTxCert sCred _ _ -> Just sCred Ledger.AuthCommitteeHotKeyTxCert{} -> Nothing - Ledger.ResignCommitteeColdTxCert _ -> Nothing + Ledger.ResignCommitteeColdTxCert _ _ -> Nothing Ledger.RegDRepTxCert{} -> Nothing Ledger.UnRegDRepTxCert{} -> Nothing Ledger.UpdateDRepTxCert{} -> Nothing @@ -523,7 +525,7 @@ filterUnRegCreds = fmap fromShelleyStakeCredential . \case Ledger.DelegTxCert _ _ -> Nothing Ledger.RegDepositDelegTxCert{} -> Nothing Ledger.AuthCommitteeHotKeyTxCert{} -> Nothing - Ledger.ResignCommitteeColdTxCert _ -> Nothing + Ledger.ResignCommitteeColdTxCert _ _ -> Nothing Ledger.RegDRepTxCert{} -> Nothing Ledger.UnRegDRepTxCert{} -> Nothing Ledger.UpdateDRepTxCert{} -> Nothing @@ -544,7 +546,7 @@ filterUnRegDRepCreds = \case Ledger.DelegTxCert _ _ -> Nothing Ledger.RegDepositDelegTxCert{} -> Nothing Ledger.AuthCommitteeHotKeyTxCert{} -> Nothing - Ledger.ResignCommitteeColdTxCert _ -> Nothing + Ledger.ResignCommitteeColdTxCert _ _ -> Nothing Ledger.RegDRepTxCert{} -> Nothing Ledger.UnRegDRepTxCert cred _ -> Just cred Ledger.UpdateDRepTxCert{} -> Nothing From 8e97d7659e15e270c71473271f431fe08090a2d2 Mon Sep 17 00:00:00 2001 From: teodanciu Date: Wed, 18 Oct 2023 11:54:34 +0100 Subject: [PATCH 09/14] Improve costModel generation and thus fix failing test --- cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index 940c1aa6f2..34ce23e1a0 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -160,7 +160,7 @@ import Test.Gen.Cardano.Api.Metadata (genTxMetadata) import Test.Cardano.Chain.UTxO.Gen (genVKWitness) import Test.Cardano.Crypto.Gen (genProtocolMagicId) -import qualified Test.Cardano.Ledger.Alonzo.PlutusScripts as Plutus +import Test.Cardano.Ledger.Alonzo.Arbitrary (genValidCostModel) import Test.Cardano.Ledger.Conway.Arbitrary () import Test.Cardano.Ledger.Core.Arbitrary () @@ -960,15 +960,12 @@ genUpdateProposal era = genCostModel :: Gen Alonzo.CostModel genCostModel = do - let costModelParams = Alonzo.getCostModelParams Plutus.testingCostModelV1 - eCostModel <- Alonzo.mkCostModel <$> genPlutusLanguage - <*> mapM (const $ Gen.integral (Range.linear 0 5000)) costModelParams - case eCostModel of - Left err -> error $ "genCostModel: " <> show err - Right cModel -> return cModel + lang <- genPlutusLanguage + cm <- Q.quickcheck (genValidCostModel lang) + pure cm genPlutusLanguage :: Gen Language -genPlutusLanguage = Gen.element [PlutusV1, PlutusV2] +genPlutusLanguage = Gen.element [PlutusV1, PlutusV2, PlutusV3] _genCostModels :: Gen (Map AnyPlutusScriptVersion CostModel) _genCostModels = From 6f4f664b1d474fc7468e183732a912126f7ca0f9 Mon Sep 17 00:00:00 2001 From: teodanciu Date: Tue, 24 Oct 2023 12:36:02 +0100 Subject: [PATCH 10/14] Export types needed for querying the committee state --- cardano-api/internal/Cardano/Api/Query/Expr.hs | 2 ++ cardano-api/src/Cardano/Api.hs | 3 +++ 2 files changed, 5 insertions(+) diff --git a/cardano-api/internal/Cardano/Api/Query/Expr.hs b/cardano-api/internal/Cardano/Api/Query/Expr.hs index 5db245dad3..bbf2b699f5 100644 --- a/cardano-api/internal/Cardano/Api/Query/Expr.hs +++ b/cardano-api/internal/Cardano/Api/Query/Expr.hs @@ -26,6 +26,8 @@ module Cardano.Api.Query.Expr , querySystemStart , queryUtxo , determineEraExpr + , L.MemberStatus (..) + , L.CommitteeMembersState (..) , queryCommitteeMembersState , queryDRepStakeDistribution , queryDRepState diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index a5a541742b..fbec3c9ae5 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -993,6 +993,9 @@ module Cardano.Api ( queryDRepStakeDistribution, queryCommitteeMembersState, + -- ** Committee State Query + MemberStatus (..), + CommitteeMembersState (..), -- ** DReps DRepKey, DRepMetadata, From 26ef0e037126473caddcd00f846da8d337d2cc72 Mon Sep 17 00:00:00 2001 From: teodanciu Date: Tue, 24 Oct 2023 17:19:51 +0100 Subject: [PATCH 11/14] Adjust to type change of `proposalProceduresTxBodyL` from Strict Seq to OSet --- cardano-api/internal/Cardano/Api/TxBody.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/cardano-api/internal/Cardano/Api/TxBody.hs b/cardano-api/internal/Cardano/Api/TxBody.hs index a638afef49..5a47ab872f 100644 --- a/cardano-api/internal/Cardano/Api/TxBody.hs +++ b/cardano-api/internal/Cardano/Api/TxBody.hs @@ -237,6 +237,7 @@ import qualified Data.List.NonEmpty as NonEmpty import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Maybe (catMaybes, fromMaybe, maybeToList) +import Data.OSet.Strict as OSet (fromStrictSeq) import Data.Scientific (toBoundedInteger) import qualified Data.Sequence.Strict as Seq import Data.Set (Set) @@ -3126,7 +3127,8 @@ makeShelleyTransactionBody sbe@ShelleyBasedEraConway & L.mintTxBodyL .~ convMintValue txMintValue & L.scriptIntegrityHashTxBodyL .~ scriptIntegrityHash & L.votingProceduresTxBodyL .~ unVotingProcedures @era (maybe emptyVotingProcedures unFeatured txVotingProcedures) - & L.proposalProceduresTxBodyL .~ Seq.fromList (fmap unProposal (maybe [] unFeatured txProposalProcedures)) + & L.proposalProceduresTxBodyL .~ + OSet.fromStrictSeq (Seq.fromList (fmap unProposal (maybe [] unFeatured txProposalProcedures))) -- TODO Conway: support optional network id in TxBodyContent -- & L.networkIdTxBodyL .~ SNothing ) From cf17a2fc548737bc5dddbd002482d34c34f6c7d5 Mon Sep 17 00:00:00 2001 From: teodanciu Date: Wed, 25 Oct 2023 23:22:44 +0100 Subject: [PATCH 12/14] Remove `invalidBeforeL` and `invalidHereAfterL` defined in ledger --- cardano-api/internal/Cardano/Api/Ledger/Lens.hs | 14 ++++---------- 1 file changed, 4 insertions(+), 10 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/Ledger/Lens.hs b/cardano-api/internal/Cardano/Api/Ledger/Lens.hs index 218950af9e..7aa58f28cb 100644 --- a/cardano-api/internal/Cardano/Api/Ledger/Lens.hs +++ b/cardano-api/internal/Cardano/Api/Ledger/Lens.hs @@ -4,8 +4,8 @@ module Cardano.Api.Ledger.Lens ( strictMaybeL - , invalidBeforeL - , invalidHereAfterL + , L.invalidBeforeL + , L.invalidHereAfterL , invalidBeforeStrictL , invalidHereAfterStrictL , invalidBeforeTxBodyL @@ -35,7 +35,7 @@ strictMaybeL = lens g s s _ = maybe SNothing SJust invalidBeforeTxBodyL :: AllegraEraOnwards era -> Lens' (L.TxBody (ShelleyLedgerEra era)) (Maybe SlotNo) -invalidBeforeTxBodyL w = allegraEraOnwardsConstraints w $ L.vldtTxBodyL . invalidBeforeL +invalidBeforeTxBodyL w = allegraEraOnwardsConstraints w $ L.vldtTxBodyL . L.invalidBeforeL -- | Compatibility lens that provides a consistent interface over 'ttlTxBodyL' and -- 'vldtTxBodyL . invalidHereAfterStrictL' across all shelley based eras. @@ -56,7 +56,7 @@ invalidHereAfterTxBodyL :: ShelleyBasedEra era -> Lens' (L.TxBody (ShelleyLedger invalidHereAfterTxBodyL = caseShelleyEraOnlyOrAllegraEraOnwards ttlAsInvalidHereAfterTxBodyL - (const $ L.vldtTxBodyL . invalidHereAfterL) + (const $ L.vldtTxBodyL . L.invalidHereAfterL) -- | Compatibility lens over 'ttlTxBodyL' which represents 'maxBound' as Nothing and all other values as 'Just'. ttlAsInvalidHereAfterTxBodyL :: ShelleyEraOnly era -> Lens' (L.TxBody (ShelleyLedgerEra era)) (Maybe SlotNo) @@ -74,12 +74,6 @@ ttlAsInvalidHereAfterTxBodyL w = lens (g w) (s w) Nothing -> txBody & L.ttlTxBodyL .~ maxBound Just ttl -> txBody & L.ttlTxBodyL .~ ttl -invalidBeforeL :: Lens' L.ValidityInterval (Maybe SlotNo) -invalidBeforeL = invalidBeforeStrictL . strictMaybeL - -invalidHereAfterL :: Lens' L.ValidityInterval (Maybe SlotNo) -invalidHereAfterL = invalidHereAfterStrictL . strictMaybeL - -- | Lens to access the 'invalidBefore' field of a 'ValidityInterval' as a 'StrictMaybe SlotNo'. -- Ideally this should be defined in cardano-ledger invalidBeforeStrictL :: Lens' L.ValidityInterval (StrictMaybe SlotNo) From 2478f54d0fb64bd3f25b7cb45b2d7b7ee245cddf Mon Sep 17 00:00:00 2001 From: teodanciu Date: Wed, 25 Oct 2023 23:23:04 +0100 Subject: [PATCH 13/14] Account for change of type of `GetCommitteeMembersState` --- cardano-api/internal/Cardano/Api/Query.hs | 2 +- cardano-api/internal/Cardano/Api/Query/Expr.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/Query.hs b/cardano-api/internal/Cardano/Api/Query.hs index 8e8fae2051..d2a8702bb0 100644 --- a/cardano-api/internal/Cardano/Api/Query.hs +++ b/cardano-api/internal/Cardano/Api/Query.hs @@ -316,7 +316,7 @@ data QueryInShelleyBasedEra era result where :: Set (Shelley.Credential Shelley.ColdCommitteeRole StandardCrypto) -> Set (Shelley.Credential Shelley.HotCommitteeRole StandardCrypto) -> Set L.MemberStatus - -> QueryInShelleyBasedEra era (L.CommitteeMembersState StandardCrypto) + -> QueryInShelleyBasedEra era (Maybe (L.CommitteeMembersState StandardCrypto)) instance NodeToClientVersionOf (QueryInShelleyBasedEra era result) where diff --git a/cardano-api/internal/Cardano/Api/Query/Expr.hs b/cardano-api/internal/Cardano/Api/Query/Expr.hs index bbf2b699f5..e5104f29e4 100644 --- a/cardano-api/internal/Cardano/Api/Query/Expr.hs +++ b/cardano-api/internal/Cardano/Api/Query/Expr.hs @@ -268,6 +268,6 @@ queryCommitteeMembersState :: () -> Set (L.Credential L.ColdCommitteeRole L.StandardCrypto) -> Set (L.Credential L.HotCommitteeRole L.StandardCrypto) -> Set L.MemberStatus - -> LocalStateQueryExpr block point (QueryInMode mode) r IO (Either UnsupportedNtcVersionError (Either EraMismatch (L.CommitteeMembersState L.StandardCrypto))) + -> LocalStateQueryExpr block point (QueryInMode mode) r IO (Either UnsupportedNtcVersionError (Either EraMismatch (Maybe (L.CommitteeMembersState L.StandardCrypto)))) queryCommitteeMembersState eraInMode sbe coldCreds hotCreds statuses = queryExpr $ QueryInEra eraInMode $ QueryInShelleyBasedEra sbe (QueryCommitteeMembersState coldCreds hotCreds statuses) From d8a60631ac1194c500e15f8a48eb73c397227c79 Mon Sep 17 00:00:00 2001 From: John Ky Date: Fri, 27 Oct 2023 18:18:40 +1100 Subject: [PATCH 14/14] Update CABAL_CACHE_VERSION --- .github/workflows/haskell.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index f5743e45e4..cf741a042b 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -20,7 +20,7 @@ jobs: env: # Modify this value to "invalidate" the cabal cache. - CABAL_CACHE_VERSION: "2023-10-23" + CABAL_CACHE_VERSION: "2023-10-27" concurrency: group: >