From 7326eaab0fb9a514b2dd5f66a1f2cc2265126443 Mon Sep 17 00:00:00 2001 From: John Ky Date: Thu, 12 Oct 2023 02:10:48 +1100 Subject: [PATCH 1/3] New MaryEraOnly eon --- cardano-api/cardano-api.cabal | 1 + .../internal/Cardano/Api/Eon/MaryEraOnly.hs | 101 ++++++++++++++++++ cardano-api/src/Cardano/Api.hs | 6 ++ 3 files changed, 108 insertions(+) create mode 100644 cardano-api/internal/Cardano/Api/Eon/MaryEraOnly.hs diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index eaf67ad6bb..d7f8f517ee 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -66,6 +66,7 @@ library internal Cardano.Api.Eon.ByronToAlonzoEra Cardano.Api.Eon.ByronToMaryEra Cardano.Api.Eon.ConwayEraOnwards + Cardano.Api.Eon.MaryEraOnly Cardano.Api.Eon.MaryEraOnwards Cardano.Api.Eon.ShelleyBasedEra Cardano.Api.Eon.ShelleyEraOnly diff --git a/cardano-api/internal/Cardano/Api/Eon/MaryEraOnly.hs b/cardano-api/internal/Cardano/Api/Eon/MaryEraOnly.hs new file mode 100644 index 0000000000..640fd20469 --- /dev/null +++ b/cardano-api/internal/Cardano/Api/Eon/MaryEraOnly.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module Cardano.Api.Eon.MaryEraOnly + ( MaryEraOnly(..) + , maryEraOnlyConstraints + , maryEraOnlyToCardanoEra + , maryEraOnlyToShelleyBasedEra + + , MaryEraOnlyConstraints + ) where + +import Cardano.Api.Eon.ShelleyBasedEra +import Cardano.Api.Eras.Core +import Cardano.Api.Modes +import Cardano.Api.Query.Types + +import Cardano.Binary +import qualified Cardano.Crypto.Hash.Blake2b as Blake2b +import qualified Cardano.Crypto.Hash.Class as C +import qualified Cardano.Crypto.VRF as C +import qualified Cardano.Ledger.Api as L +import qualified Cardano.Ledger.BaseTypes as L +import qualified Cardano.Ledger.Core as L +import qualified Cardano.Ledger.Mary.Value as L +import qualified Cardano.Ledger.SafeHash as L +import qualified Cardano.Ledger.UTxO as L +import qualified Ouroboros.Consensus.Protocol.Abstract as Consensus +import qualified Ouroboros.Consensus.Protocol.Praos.Common as Consensus +import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus + +import Data.Aeson +import Data.Typeable (Typeable) + +data MaryEraOnly era where + MaryEraOnlyMary :: MaryEraOnly MaryEra + +deriving instance Show (MaryEraOnly era) +deriving instance Eq (MaryEraOnly era) + +instance Eon MaryEraOnly where + inEonForEra no yes = \case + ByronEra -> no + ShelleyEra -> no + AllegraEra -> no + MaryEra -> yes MaryEraOnlyMary + AlonzoEra -> no + BabbageEra -> no + ConwayEra -> no + +instance ToCardanoEra MaryEraOnly where + toCardanoEra = \case + MaryEraOnlyMary -> MaryEra + +type MaryEraOnlyConstraints era = + ( C.HashAlgorithm (L.HASH (L.EraCrypto (ShelleyLedgerEra era))) + , C.Signable (L.VRF (L.EraCrypto (ShelleyLedgerEra era))) L.Seed + , Consensus.PraosProtocolSupportsNode (ConsensusProtocol era) + , Consensus.ShelleyCompatible (ConsensusProtocol era) (ShelleyLedgerEra era) + , L.ADDRHASH (Consensus.PraosProtocolSupportsNodeCrypto (ConsensusProtocol era)) ~ Blake2b.Blake2b_224 + , L.Crypto (L.EraCrypto (ShelleyLedgerEra era)) + , L.Era (ShelleyLedgerEra era) + , L.EraCrypto (ShelleyLedgerEra era) ~ L.StandardCrypto + , L.EraPParams (ShelleyLedgerEra era) + , L.EraTx (ShelleyLedgerEra era) + , L.EraTxBody (ShelleyLedgerEra era) + , L.EraUTxO (ShelleyLedgerEra era) + , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto + , L.MaryEraTxBody (ShelleyLedgerEra era) + , L.ShelleyEraTxBody (ShelleyLedgerEra era) + , L.ShelleyEraTxCert (ShelleyLedgerEra era) + , L.Value (ShelleyLedgerEra era) ~ L.MaryValue L.StandardCrypto + + , FromCBOR (Consensus.ChainDepState (ConsensusProtocol era)) + , FromCBOR (DebugLedgerState era) + , IsCardanoEra era + , IsShelleyBasedEra era + , ToJSON (DebugLedgerState era) + , Typeable era + ) + +maryEraOnlyConstraints :: () + => MaryEraOnly era + -> (MaryEraOnlyConstraints era => a) + -> a +maryEraOnlyConstraints = \case + MaryEraOnlyMary -> id + +maryEraOnlyToCardanoEra :: MaryEraOnly era -> CardanoEra era +maryEraOnlyToCardanoEra = shelleyBasedToCardanoEra . maryEraOnlyToShelleyBasedEra + +maryEraOnlyToShelleyBasedEra :: MaryEraOnly era -> ShelleyBasedEra era +maryEraOnlyToShelleyBasedEra = \case + MaryEraOnlyMary -> ShelleyBasedEraMary diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 8f550b97b1..d1de133cec 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -110,6 +110,11 @@ module Cardano.Api ( -- ** From Allegra -- ** From Mary + MaryEraOnly(..), + maryEraOnlyConstraints, + maryEraOnlyToCardanoEra, + maryEraOnlyToShelleyBasedEra, + MaryEraOnwards(..), maryEraOnwardsConstraints, maryEraOnwardsToCardanoEra, @@ -1026,6 +1031,7 @@ import Cardano.Api.Eon.ByronToAllegraEra import Cardano.Api.Eon.ByronToAlonzoEra import Cardano.Api.Eon.ByronToMaryEra import Cardano.Api.Eon.ConwayEraOnwards +import Cardano.Api.Eon.MaryEraOnly import Cardano.Api.Eon.MaryEraOnwards import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Eon.ShelleyEraOnly From ca143d95c9607feedf709b42b710e32c078fb28c Mon Sep 17 00:00:00 2001 From: John Ky Date: Thu, 12 Oct 2023 02:13:38 +1100 Subject: [PATCH 2/3] New caseMaryEraOnlyOrAlonzoEraOnwards function --- cardano-api/internal/Cardano/Api/Eras/Case.hs | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/cardano-api/internal/Cardano/Api/Eras/Case.hs b/cardano-api/internal/Cardano/Api/Eras/Case.hs index b4aca87e84..293ea1174f 100644 --- a/cardano-api/internal/Cardano/Api/Eras/Case.hs +++ b/cardano-api/internal/Cardano/Api/Eras/Case.hs @@ -19,6 +19,9 @@ module Cardano.Api.Eras.Case , caseShelleyToAlonzoOrBabbageEraOnwards , caseShelleyToBabbageOrConwayEraOnwards + -- Case on MaryEraOnwards + , caseMaryEraOnlyOrAlonzoEraOnwards + -- Case on AlonzoEraOnwards , caseAlonzoOnlyOrBabbageEraOnwards @@ -43,6 +46,7 @@ import Cardano.Api.Eon.ByronToAllegraEra import Cardano.Api.Eon.ByronToAlonzoEra import Cardano.Api.Eon.ByronToMaryEra import Cardano.Api.Eon.ConwayEraOnwards +import Cardano.Api.Eon.MaryEraOnly import Cardano.Api.Eon.MaryEraOnwards import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Eon.ShelleyEraOnly @@ -188,6 +192,17 @@ caseShelleyToBabbageOrConwayEraOnwards l r = \case ShelleyBasedEraBabbage -> l ShelleyToBabbageEraBabbage ShelleyBasedEraConway -> r ConwayEraOnwardsConway +caseMaryEraOnlyOrAlonzoEraOnwards :: () + => (MaryEraOnly era -> a) + -> (AlonzoEraOnwards era -> a) + -> MaryEraOnwards era + -> a +caseMaryEraOnlyOrAlonzoEraOnwards l r = \case + MaryEraOnwardsMary -> l MaryEraOnlyMary + MaryEraOnwardsAlonzo -> r AlonzoEraOnwardsAlonzo + MaryEraOnwardsBabbage -> r AlonzoEraOnwardsBabbage + MaryEraOnwardsConway -> r AlonzoEraOnwardsConway + caseAlonzoOnlyOrBabbageEraOnwards :: () => (AlonzoEraOnly era -> a) -> (BabbageEraOnwards era -> a) From 92e787d41c1a12b46ac4c664f8727e76af4dd8c8 Mon Sep 17 00:00:00 2001 From: John Ky Date: Thu, 12 Oct 2023 01:45:52 +1100 Subject: [PATCH 3/3] New functions disjointAlonzoEraOnlyAndBabbageEraOnwards and disjointByronEraOnlyAndShelleyBasedEra. Deprecate noByronEraInShelleyBasedEra --- cardano-api/internal/Cardano/Api/Eras/Case.hs | 13 ++++++++++++- cardano-api/internal/Cardano/Api/TxBody.hs | 2 +- 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/Eras/Case.hs b/cardano-api/internal/Cardano/Api/Eras/Case.hs index 293ea1174f..b8e0fda67a 100644 --- a/cardano-api/internal/Cardano/Api/Eras/Case.hs +++ b/cardano-api/internal/Cardano/Api/Eras/Case.hs @@ -27,6 +27,8 @@ module Cardano.Api.Eras.Case -- Proofs , noByronEraInShelleyBasedEra + , disjointAlonzoEraOnlyAndBabbageEraOnwards + , disjointByronEraOnlyAndShelleyBasedEra -- Conversions , shelleyToAllegraEraToByronToAllegraEra @@ -213,8 +215,17 @@ caseAlonzoOnlyOrBabbageEraOnwards l r = \case AlonzoEraOnwardsBabbage -> r BabbageEraOnwardsBabbage AlonzoEraOnwardsConway -> r BabbageEraOnwardsConway +{-# DEPRECATED noByronEraInShelleyBasedEra "Use disjointByronEraOnlyAndShelleyBasedEra instead" #-} noByronEraInShelleyBasedEra :: ShelleyBasedEra era -> ByronEraOnly era -> a -noByronEraInShelleyBasedEra sbe ByronEraOnlyByron = case sbe of {} +noByronEraInShelleyBasedEra = flip disjointByronEraOnlyAndShelleyBasedEra + +disjointByronEraOnlyAndShelleyBasedEra :: ByronEraOnly era -> ShelleyBasedEra era -> a +disjointByronEraOnlyAndShelleyBasedEra ByronEraOnlyByron sbe = case sbe of {} + +disjointAlonzoEraOnlyAndBabbageEraOnwards :: AlonzoEraOnly era -> BabbageEraOnwards era -> a +disjointAlonzoEraOnlyAndBabbageEraOnwards eonL eonR = + case eonL of + AlonzoEraOnlyAlonzo -> case eonR of {} shelleyToAllegraEraToByronToAllegraEra :: ShelleyToAllegraEra era -> ByronToAllegraEra era shelleyToAllegraEraToByronToAllegraEra = \case diff --git a/cardano-api/internal/Cardano/Api/TxBody.hs b/cardano-api/internal/Cardano/Api/TxBody.hs index da87ed11a7..2acf034358 100644 --- a/cardano-api/internal/Cardano/Api/TxBody.hs +++ b/cardano-api/internal/Cardano/Api/TxBody.hs @@ -2656,7 +2656,7 @@ convWithdrawals txWithdrawals = convTransactionFee :: ShelleyBasedEra era -> TxFee era -> Ledger.Coin convTransactionFee sbe = \case - TxFeeImplicit w -> noByronEraInShelleyBasedEra sbe w + TxFeeImplicit w -> disjointByronEraOnlyAndShelleyBasedEra w sbe TxFeeExplicit _ fee -> toShelleyLovelace fee convValidityInterval