From dd0153f1185f46c59b2889bf5e5fc67ccf5e4fac Mon Sep 17 00:00:00 2001 From: John Ky Date: Thu, 21 Sep 2023 08:34:01 +1000 Subject: [PATCH 01/14] New ByronToAllegraEra eon --- cardano-api/cardano-api.cabal | 1 + .../Cardano/Api/Eon/ByronToAllegraEra.hs | 84 +++++++++++++++++++ 2 files changed, 85 insertions(+) create mode 100644 cardano-api/internal/Cardano/Api/Eon/ByronToAllegraEra.hs diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index b58a819dba..2111b39e20 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -59,6 +59,7 @@ library internal Cardano.Api.Eon.AlonzoEraOnwards Cardano.Api.Eon.BabbageEraOnwards Cardano.Api.Eon.ByronEraOnly + Cardano.Api.Eon.ByronToAllegraEra Cardano.Api.Eon.ConwayEraOnwards Cardano.Api.Eon.ShelleyBasedEra Cardano.Api.Eon.ShelleyToAllegraEra diff --git a/cardano-api/internal/Cardano/Api/Eon/ByronToAllegraEra.hs b/cardano-api/internal/Cardano/Api/Eon/ByronToAllegraEra.hs new file mode 100644 index 0000000000..825542c7f0 --- /dev/null +++ b/cardano-api/internal/Cardano/Api/Eon/ByronToAllegraEra.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilies #-} + +module Cardano.Api.Eon.ByronToAllegraEra + ( ByronToAllegraEra(..) + , IsByronToAllegraEra(..) + , AnyByronToAllegraEra(..) + , byronToAllegraEraConstraints + , byronToAllegraEraToCardanoEra + + , ByronToAllegraEraConstraints + ) where + +import Cardano.Api.Eras.Core + +import Data.Typeable (Typeable) + +class IsByronToAllegraEra era where + byronToAllegraEra :: ByronToAllegraEra era + +data ByronToAllegraEra era where + ByronToAllegraEraByron :: ByronToAllegraEra ByronEra + ByronToAllegraEraShelley :: ByronToAllegraEra ShelleyEra + ByronToAllegraEraAllegra :: ByronToAllegraEra AllegraEra + +deriving instance Show (ByronToAllegraEra era) +deriving instance Eq (ByronToAllegraEra era) + +instance IsByronToAllegraEra ByronEra where + byronToAllegraEra = ByronToAllegraEraByron + +instance IsByronToAllegraEra ShelleyEra where + byronToAllegraEra = ByronToAllegraEraShelley + +instance IsByronToAllegraEra AllegraEra where + byronToAllegraEra = ByronToAllegraEraAllegra + +instance Eon ByronToAllegraEra where + inEonForEra no yes = \case + ByronEra -> yes ByronToAllegraEraByron + ShelleyEra -> yes ByronToAllegraEraShelley + AllegraEra -> yes ByronToAllegraEraAllegra + MaryEra -> no + AlonzoEra -> no + BabbageEra -> no + ConwayEra -> no + +instance ToCardanoEra ByronToAllegraEra where + toCardanoEra = \case + ByronToAllegraEraByron -> ByronEra + ByronToAllegraEraShelley -> ShelleyEra + ByronToAllegraEraAllegra -> AllegraEra + +type ByronToAllegraEraConstraints era = + ( IsCardanoEra era + , IsByronToAllegraEra era + , Typeable era + ) + +data AnyByronToAllegraEra where + AnyByronToAllegraEra :: ByronToAllegraEra era -> AnyByronToAllegraEra + +deriving instance Show AnyByronToAllegraEra + +byronToAllegraEraConstraints :: () + => ByronToAllegraEra era + -> (ByronToAllegraEraConstraints era => a) + -> a +byronToAllegraEraConstraints = \case + ByronToAllegraEraByron -> id + ByronToAllegraEraShelley -> id + ByronToAllegraEraAllegra -> id + +byronToAllegraEraToCardanoEra :: ByronToAllegraEra era -> CardanoEra era +byronToAllegraEraToCardanoEra = \case + ByronToAllegraEraByron -> ByronEra + ByronToAllegraEraShelley -> ShelleyEra + ByronToAllegraEraAllegra -> AllegraEra From a626bd84257cd59021829ae4fdd5d139b38e0606 Mon Sep 17 00:00:00 2001 From: John Ky Date: Thu, 21 Sep 2023 08:48:16 +1000 Subject: [PATCH 02/14] New caseByronToAllegraOrMaryEraOnwards function --- cardano-api/internal/Cardano/Api/Eras/Case.hs | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/cardano-api/internal/Cardano/Api/Eras/Case.hs b/cardano-api/internal/Cardano/Api/Eras/Case.hs index 1d4c1395ed..e8759ac854 100644 --- a/cardano-api/internal/Cardano/Api/Eras/Case.hs +++ b/cardano-api/internal/Cardano/Api/Eras/Case.hs @@ -7,6 +7,7 @@ module Cardano.Api.Eras.Case ( -- Case on CardanoEra caseByronOrShelleyBasedEra + , caseByronToAllegraOrMaryEraOnwards -- Case on ShelleyBasedEra , caseShelleyToMaryOrAlonzoEraOnwards @@ -19,7 +20,9 @@ module Cardano.Api.Eras.Case import Cardano.Api.Eon.AlonzoEraOnwards import Cardano.Api.Eon.BabbageEraOnwards import Cardano.Api.Eon.ByronEraOnly +import Cardano.Api.Eon.ByronToAllegraEra import Cardano.Api.Eon.ConwayEraOnwards +import Cardano.Api.Eon.MaryEraOnwards import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Eon.ShelleyToAlonzoEra import Cardano.Api.Eon.ShelleyToBabbageEra @@ -41,6 +44,20 @@ caseByronOrShelleyBasedEra l r = \case BabbageEra -> r ShelleyBasedEraBabbage ConwayEra -> r ShelleyBasedEraConway +caseByronToAllegraOrMaryEraOnwards :: () + => (ByronToAllegraEraConstraints era => ByronToAllegraEra era -> a) + -> (MaryEraOnwardsConstraints era => MaryEraOnwards era -> a) + -> CardanoEra era + -> a +caseByronToAllegraOrMaryEraOnwards l r = \case + ByronEra -> l ByronToAllegraEraByron + ShelleyEra -> l ByronToAllegraEraShelley + AllegraEra -> l ByronToAllegraEraAllegra + MaryEra -> r MaryEraOnwardsMary + AlonzoEra -> r MaryEraOnwardsAlonzo + BabbageEra -> r MaryEraOnwardsBabbage + ConwayEra -> r MaryEraOnwardsConway + caseShelleyToMaryOrAlonzoEraOnwards :: () => (ShelleyToMaryEraConstraints era => ShelleyToMaryEra era -> a) -> (AlonzoEraOnwardsConstraints era => AlonzoEraOnwards era -> a) From 8d8b025f5c7aa9c3240a9dbfafc13f42c27370d4 Mon Sep 17 00:00:00 2001 From: John Ky Date: Thu, 21 Sep 2023 17:40:45 +1000 Subject: [PATCH 03/14] Delete MultiAssetSupportedInEra. Use MaryEraOnwards instead --- .../Cardano/Api/Eon/MaryEraOnwards.hs | 134 ++++++++++++++++++ cardano-api/internal/Cardano/Api/Fees.hs | 13 +- cardano-api/internal/Cardano/Api/TxBody.hs | 91 +++++------- cardano-api/src/Cardano/Api.hs | 1 - 4 files changed, 173 insertions(+), 66 deletions(-) create mode 100644 cardano-api/internal/Cardano/Api/Eon/MaryEraOnwards.hs diff --git a/cardano-api/internal/Cardano/Api/Eon/MaryEraOnwards.hs b/cardano-api/internal/Cardano/Api/Eon/MaryEraOnwards.hs new file mode 100644 index 0000000000..bfe858f343 --- /dev/null +++ b/cardano-api/internal/Cardano/Api/Eon/MaryEraOnwards.hs @@ -0,0 +1,134 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module Cardano.Api.Eon.MaryEraOnwards + ( MaryEraOnwards(..) + , IsMaryEraOnwards(..) + , AnyMaryEraOnwards(..) + , maryEraOnwardsConstraints + , maryEraOnwardsToCardanoEra + , maryEraOnwardsToShelleyBasedEra + + , MaryEraOnwardsConstraints + ) 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 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) + +class IsShelleyBasedEra era => IsMaryEraOnwards era where + maryEraOnwards :: MaryEraOnwards era + +data MaryEraOnwards era where + MaryEraOnwardsMary :: MaryEraOnwards MaryEra + MaryEraOnwardsAlonzo :: MaryEraOnwards AlonzoEra + MaryEraOnwardsBabbage :: MaryEraOnwards BabbageEra + MaryEraOnwardsConway :: MaryEraOnwards ConwayEra + +deriving instance Show (MaryEraOnwards era) +deriving instance Eq (MaryEraOnwards era) + +instance IsMaryEraOnwards MaryEra where + maryEraOnwards = MaryEraOnwardsMary + +instance IsMaryEraOnwards AlonzoEra where + maryEraOnwards = MaryEraOnwardsAlonzo + +instance IsMaryEraOnwards BabbageEra where + maryEraOnwards = MaryEraOnwardsBabbage + +instance IsMaryEraOnwards ConwayEra where + maryEraOnwards = MaryEraOnwardsConway + +instance Eon MaryEraOnwards where + inEonForEra no yes = \case + ByronEra -> no + ShelleyEra -> no + AllegraEra -> no + MaryEra -> yes MaryEraOnwardsMary + AlonzoEra -> yes MaryEraOnwardsAlonzo + BabbageEra -> yes MaryEraOnwardsBabbage + ConwayEra -> yes MaryEraOnwardsConway + +instance ToCardanoEra MaryEraOnwards where + toCardanoEra = \case + MaryEraOnwardsMary -> MaryEra + MaryEraOnwardsAlonzo -> AlonzoEra + MaryEraOnwardsBabbage -> BabbageEra + MaryEraOnwardsConway -> ConwayEra + +data AnyMaryEraOnwards where + AnyMaryEraOnwards :: MaryEraOnwards era -> AnyMaryEraOnwards + +deriving instance Show AnyMaryEraOnwards + +type MaryEraOnwardsConstraints 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.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) + , IsMaryEraOnwards era + , IsCardanoEra era + , IsShelleyBasedEra era + , ToJSON (DebugLedgerState era) + , Typeable era + ) + +maryEraOnwardsConstraints :: () + => MaryEraOnwards era + -> (MaryEraOnwardsConstraints era => a) + -> a +maryEraOnwardsConstraints = \case + MaryEraOnwardsMary -> id + MaryEraOnwardsAlonzo -> id + MaryEraOnwardsBabbage -> id + MaryEraOnwardsConway -> id + +maryEraOnwardsToCardanoEra :: MaryEraOnwards era -> CardanoEra era +maryEraOnwardsToCardanoEra = shelleyBasedToCardanoEra . maryEraOnwardsToShelleyBasedEra + +maryEraOnwardsToShelleyBasedEra :: MaryEraOnwards era -> ShelleyBasedEra era +maryEraOnwardsToShelleyBasedEra = \case + MaryEraOnwardsMary -> ShelleyBasedEraMary + MaryEraOnwardsAlonzo -> ShelleyBasedEraAlonzo + MaryEraOnwardsBabbage -> ShelleyBasedEraBabbage + MaryEraOnwardsConway -> ShelleyBasedEraConway diff --git a/cardano-api/internal/Cardano/Api/Fees.hs b/cardano-api/internal/Cardano/Api/Fees.hs index cd96d604b8..08309992a2 100644 --- a/cardano-api/internal/Cardano/Api/Fees.hs +++ b/cardano-api/internal/Cardano/Api/Fees.hs @@ -48,6 +48,7 @@ import Cardano.Api.Address import Cardano.Api.Certificate import Cardano.Api.Eras.Core import Cardano.Api.Eras.Constraints +import Cardano.Api.Eon.MaryEraOnwards import Cardano.Api.Error import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.NetworkId @@ -679,7 +680,7 @@ evaluateTransactionBalance pp poolids stakeDelegDeposits drepDelegDeposits utxo ShelleyLedgerEra era ~ ledgerera => LedgerEraConstraints ledgerera => LedgerMultiAssetConstraints ledgerera - => MultiAssetSupportedInEra era + => MaryEraOnwards era -> TxOutValue era evalMultiAsset evidence = TxOutValue evidence . fromMaryValue $ @@ -721,15 +722,15 @@ evaluateTransactionBalance pp poolids stakeDelegDeposits drepDelegDeposits utxo => LedgerMultiAssetConstraints ledgerera => LedgerPParamsConstraints ledgerera => LedgerTxBodyConstraints ledgerera - => MultiAssetSupportedInEra era + => MaryEraOnwards era -> a) -> a withLedgerConstraints ShelleyBasedEraShelley f _ = f AdaOnlyInShelleyEra withLedgerConstraints ShelleyBasedEraAllegra f _ = f AdaOnlyInAllegraEra - withLedgerConstraints ShelleyBasedEraMary _ f = f MultiAssetInMaryEra - withLedgerConstraints ShelleyBasedEraAlonzo _ f = f MultiAssetInAlonzoEra - withLedgerConstraints ShelleyBasedEraBabbage _ f = f MultiAssetInBabbageEra - withLedgerConstraints ShelleyBasedEraConway _ f = f MultiAssetInConwayEra + withLedgerConstraints ShelleyBasedEraMary _ f = f MaryEraOnwardsMary + withLedgerConstraints ShelleyBasedEraAlonzo _ f = f MaryEraOnwardsAlonzo + withLedgerConstraints ShelleyBasedEraBabbage _ f = f MaryEraOnwardsBabbage + withLedgerConstraints ShelleyBasedEraConway _ f = f MaryEraOnwardsConway type LedgerEraConstraints ledgerera = ( Ledger.EraCrypto ledgerera ~ Ledger.StandardCrypto diff --git a/cardano-api/internal/Cardano/Api/TxBody.hs b/cardano-api/internal/Cardano/Api/TxBody.hs index 4af91ad5ca..565b330db7 100644 --- a/cardano-api/internal/Cardano/Api/TxBody.hs +++ b/cardano-api/internal/Cardano/Api/TxBody.hs @@ -115,7 +115,6 @@ module Cardano.Api.TxBody ( -- * Era-dependent transaction body features CollateralSupportedInEra(..), - MultiAssetSupportedInEra(..), OnlyAdaSupportedInEra(..), ValidityUpperBoundSupportedInEra(..), ValidityNoUpperBoundSupportedInEra(..), @@ -185,6 +184,7 @@ import Cardano.Api.Certificate import Cardano.Api.Convenience.Constraints import Cardano.Api.Eon.ByronEraOnly import Cardano.Api.Eon.ConwayEraOnwards +import Cardano.Api.Eon.MaryEraOnwards import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.EraCast import Cardano.Api.Eras @@ -765,20 +765,20 @@ toShelleyTxOut _ (TxOut addr (TxOutAdaOnly AdaOnlyInShelleyEra value) _ _) = toShelleyTxOut _ (TxOut addr (TxOutAdaOnly AdaOnlyInAllegraEra value) _ _) = L.mkBasicTxOut (toShelleyAddr addr) (toShelleyLovelace value) -toShelleyTxOut _ (TxOut addr (TxOutValue MultiAssetInMaryEra value) _ _) = +toShelleyTxOut _ (TxOut addr (TxOutValue MaryEraOnwardsMary value) _ _) = L.mkBasicTxOut (toShelleyAddr addr) (toMaryValue value) -toShelleyTxOut _ (TxOut addr (TxOutValue MultiAssetInAlonzoEra value) txoutdata _) = +toShelleyTxOut _ (TxOut addr (TxOutValue MaryEraOnwardsAlonzo value) txoutdata _) = L.mkBasicTxOut (toShelleyAddr addr) (toMaryValue value) & L.dataHashTxOutL .~ toAlonzoTxOutDataHash txoutdata -toShelleyTxOut sbe (TxOut addr (TxOutValue MultiAssetInBabbageEra value) txoutdata refScript) = +toShelleyTxOut sbe (TxOut addr (TxOutValue MaryEraOnwardsBabbage value) txoutdata refScript) = let cEra = shelleyBasedToCardanoEra sbe in L.mkBasicTxOut (toShelleyAddr addr) (toMaryValue value) & L.datumTxOutL .~ toBabbageTxOutDatum txoutdata & L.referenceScriptTxOutL .~ refScriptToShelleyScript cEra refScript -toShelleyTxOut sbe (TxOut addr (TxOutValue MultiAssetInConwayEra value) txoutdata refScript) = +toShelleyTxOut sbe (TxOut addr (TxOutValue MaryEraOnwardsConway value) txoutdata refScript) = let cEra = shelleyBasedToCardanoEra sbe in L.mkBasicTxOut (toShelleyAddr addr) (toMaryValue value) & L.datumTxOutL .~ toBabbageTxOutDatum txoutdata @@ -810,7 +810,7 @@ fromShelleyTxOut sbe ledgerTxOut = ShelleyBasedEraMary -> TxOut (fromShelleyAddr sbe addr) - (TxOutValue MultiAssetInMaryEra + (TxOutValue MaryEraOnwardsMary (fromMaryValue value)) TxOutDatumNone ReferenceScriptNone where @@ -819,7 +819,7 @@ fromShelleyTxOut sbe ledgerTxOut = ShelleyBasedEraAlonzo -> TxOut (fromShelleyAddr sbe addr) - (TxOutValue MultiAssetInAlonzoEra + (TxOutValue MaryEraOnwardsAlonzo (fromMaryValue value)) (fromAlonzoTxOutDataHash ScriptDataInAlonzoEra datahash) ReferenceScriptNone @@ -830,7 +830,7 @@ fromShelleyTxOut sbe ledgerTxOut = ShelleyBasedEraBabbage -> TxOut (fromShelleyAddr sbe addr) - (TxOutValue MultiAssetInBabbageEra + (TxOutValue MaryEraOnwardsBabbage (fromMaryValue value)) (fromBabbageTxOutDatum ScriptDataInBabbageEra @@ -848,7 +848,7 @@ fromShelleyTxOut sbe ledgerTxOut = ShelleyBasedEraConway -> TxOut (fromShelleyAddr sbe addr) - (TxOutValue MultiAssetInConwayEra + (TxOutValue MaryEraOnwardsConway (fromMaryValue value)) (fromBabbageTxOutDatum ScriptDataInConwayEra @@ -932,39 +932,12 @@ collateralSupportedInEra AlonzoEra = Just CollateralInAlonzoEra collateralSupportedInEra BabbageEra = Just CollateralInBabbageEra collateralSupportedInEra ConwayEra = Just CollateralInConwayEra - --- | A representation of whether the era supports multi-asset transactions. --- --- The Mary and subsequent eras support multi-asset transactions. --- --- The negation of this is 'OnlyAdaSupportedInEra'. --- -data MultiAssetSupportedInEra era where - - -- | Multi-asset transactions are supported in the 'Mary' era. - MultiAssetInMaryEra :: MultiAssetSupportedInEra MaryEra - - -- | Multi-asset transactions are supported in the 'Alonzo' era. - MultiAssetInAlonzoEra :: MultiAssetSupportedInEra AlonzoEra - - -- | Multi-asset transactions are supported in the 'Babbage' era. - MultiAssetInBabbageEra :: MultiAssetSupportedInEra BabbageEra - - -- | Multi-asset transactions are supported in the 'Conway' era. - MultiAssetInConwayEra :: MultiAssetSupportedInEra ConwayEra - -deriving instance Eq (MultiAssetSupportedInEra era) -deriving instance Show (MultiAssetSupportedInEra era) - -instance ToJSON (MultiAssetSupportedInEra era) where - toJSON = Aeson.String . Text.pack . show - -- | A representation of whether the era supports only ada transactions. -- -- Prior to the Mary era only ada transactions are supported. Multi-assets are -- supported from the Mary era onwards. -- --- This is the negation of 'MultiAssetSupportedInEra'. It exists since we need +-- This is the negation of 'MaryEraOnwards'. It exists since we need -- evidence to be positive. -- data OnlyAdaSupportedInEra era where @@ -978,14 +951,14 @@ deriving instance Show (OnlyAdaSupportedInEra era) multiAssetSupportedInEra :: CardanoEra era -> Either (OnlyAdaSupportedInEra era) - (MultiAssetSupportedInEra era) + (MaryEraOnwards era) multiAssetSupportedInEra ByronEra = Left AdaOnlyInByronEra multiAssetSupportedInEra ShelleyEra = Left AdaOnlyInShelleyEra multiAssetSupportedInEra AllegraEra = Left AdaOnlyInAllegraEra -multiAssetSupportedInEra MaryEra = Right MultiAssetInMaryEra -multiAssetSupportedInEra AlonzoEra = Right MultiAssetInAlonzoEra -multiAssetSupportedInEra BabbageEra = Right MultiAssetInBabbageEra -multiAssetSupportedInEra ConwayEra = Right MultiAssetInConwayEra +multiAssetSupportedInEra MaryEra = Right MaryEraOnwardsMary +multiAssetSupportedInEra AlonzoEra = Right MaryEraOnwardsAlonzo +multiAssetSupportedInEra BabbageEra = Right MaryEraOnwardsBabbage +multiAssetSupportedInEra ConwayEra = Right MaryEraOnwardsConway -- -- | A representation of whether the era requires explicitly specified fees in @@ -1363,9 +1336,9 @@ deriving instance Show (TxInsReference build era) data TxOutValue era where - TxOutAdaOnly :: OnlyAdaSupportedInEra era -> Lovelace -> TxOutValue era + TxOutAdaOnly :: OnlyAdaSupportedInEra era -> Lovelace -> TxOutValue era - TxOutValue :: MultiAssetSupportedInEra era -> Value -> TxOutValue era + TxOutValue :: MaryEraOnwards era -> Value -> TxOutValue era instance EraCast TxOutValue where eraCast toEra v = case v of @@ -1373,7 +1346,7 @@ instance EraCast TxOutValue where case multiAssetSupportedInEra toEra of Left adaOnly -> Right $ TxOutAdaOnly adaOnly lovelace Right multiAssetSupp -> Right $ TxOutValue multiAssetSupp $ lovelaceToValue lovelace - TxOutValue (_ :: MultiAssetSupportedInEra fromEra) value -> + TxOutValue (_ :: MaryEraOnwards fromEra) value -> case multiAssetSupportedInEra toEra of Left _adaOnly -> Left $ EraCastError v (cardanoEra @fromEra) toEra Right multiAssetSupp -> Right $ TxOutValue multiAssetSupp value @@ -1721,7 +1694,7 @@ data TxMintValue build era where TxMintNone :: TxMintValue build era - TxMintValue :: MultiAssetSupportedInEra era + TxMintValue :: MaryEraOnwards era -> Value -> BuildTxWith build (Map PolicyId (ScriptWitness WitCtxMint era)) @@ -2813,7 +2786,7 @@ fromLedgerTxOuts sbe body scriptdata = ShelleyBasedEraAlonzo -> [ fromAlonzoTxOut - MultiAssetInAlonzoEra + MaryEraOnwardsAlonzo ScriptDataInAlonzoEra txdatums txout @@ -2822,7 +2795,7 @@ fromLedgerTxOuts sbe body scriptdata = ShelleyBasedEraBabbage -> [ fromBabbageTxOut - MultiAssetInBabbageEra + MaryEraOnwardsBabbage ScriptDataInBabbageEra ReferenceTxInsScriptsInlineDatumsInBabbageEra txdatums @@ -2833,7 +2806,7 @@ fromLedgerTxOuts sbe body scriptdata = ShelleyBasedEraConway -> [ fromBabbageTxOut - MultiAssetInConwayEra + MaryEraOnwardsConway ScriptDataInConwayEra ReferenceTxInsScriptsInlineDatumsInConwayEra txdatums @@ -2850,7 +2823,7 @@ fromAlonzoTxOut :: forall era ledgerera. => L.AlonzoEraTxOut ledgerera => Ledger.EraCrypto ledgerera ~ StandardCrypto => Ledger.Value ledgerera ~ MaryValue StandardCrypto - => MultiAssetSupportedInEra era + => MaryEraOnwards era -> ScriptDataSupportedInEra era -> Map (L.DataHash StandardCrypto) (L.Data ledgerera) @@ -2879,7 +2852,7 @@ fromBabbageTxOut => ShelleyLedgerEra era ~ ledgerera => Ledger.EraCrypto ledgerera ~ StandardCrypto => Ledger.Value ledgerera ~ MaryValue StandardCrypto - => MultiAssetSupportedInEra era + => MaryEraOnwards era -> ScriptDataSupportedInEra era -> ReferenceTxInsScriptsInlineDatumsSupportedInEra era -> Map (L.DataHash StandardCrypto) @@ -3315,10 +3288,10 @@ fromLedgerTxMintValue sbe body = case sbe of ShelleyBasedEraShelley -> TxMintNone ShelleyBasedEraAllegra -> TxMintNone - ShelleyBasedEraMary -> toMintValue body MultiAssetInMaryEra - ShelleyBasedEraAlonzo -> toMintValue body MultiAssetInAlonzoEra - ShelleyBasedEraBabbage -> toMintValue body MultiAssetInBabbageEra - ShelleyBasedEraConway -> toMintValue body MultiAssetInConwayEra + ShelleyBasedEraMary -> toMintValue body MaryEraOnwardsMary + ShelleyBasedEraAlonzo -> toMintValue body MaryEraOnwardsAlonzo + ShelleyBasedEraBabbage -> toMintValue body MaryEraOnwardsBabbage + ShelleyBasedEraConway -> toMintValue body MaryEraOnwardsConway where toMintValue txBody maInEra | L.isZero mint = TxMintNone @@ -4028,20 +4001,20 @@ toShelleyTxOutAny _ (TxOut addr (TxOutAdaOnly AdaOnlyInShelleyEra value) _ _) = toShelleyTxOutAny _ (TxOut addr (TxOutAdaOnly AdaOnlyInAllegraEra value) _ _) = L.mkBasicTxOut (toShelleyAddr addr) (toShelleyLovelace value) -toShelleyTxOutAny _ (TxOut addr (TxOutValue MultiAssetInMaryEra value) _ _) = +toShelleyTxOutAny _ (TxOut addr (TxOutValue MaryEraOnwardsMary value) _ _) = L.mkBasicTxOut (toShelleyAddr addr) (toMaryValue value) -toShelleyTxOutAny _ (TxOut addr (TxOutValue MultiAssetInAlonzoEra value) txoutdata _) = +toShelleyTxOutAny _ (TxOut addr (TxOutValue MaryEraOnwardsAlonzo value) txoutdata _) = L.mkBasicTxOut (toShelleyAddr addr) (toMaryValue value) & L.dataHashTxOutL .~ toAlonzoTxOutDataHash' txoutdata -toShelleyTxOutAny sbe (TxOut addr (TxOutValue MultiAssetInBabbageEra value) txoutdata refScript) = +toShelleyTxOutAny sbe (TxOut addr (TxOutValue MaryEraOnwardsBabbage value) txoutdata refScript) = let cEra = shelleyBasedToCardanoEra sbe in L.mkBasicTxOut (toShelleyAddr addr) (toMaryValue value) & L.datumTxOutL .~ toBabbageTxOutDatum' txoutdata & L.referenceScriptTxOutL .~ refScriptToShelleyScript cEra refScript -toShelleyTxOutAny sbe (TxOut addr (TxOutValue MultiAssetInConwayEra value) txoutdata refScript) = +toShelleyTxOutAny sbe (TxOut addr (TxOutValue MaryEraOnwardsConway value) txoutdata refScript) = let cEra = shelleyBasedToCardanoEra sbe in L.mkBasicTxOut (toShelleyAddr addr) (toMaryValue value) & L.datumTxOutL .~ toBabbageTxOutDatum' txoutdata diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 8e9bf7f3f9..efe3e243e4 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -342,7 +342,6 @@ module Cardano.Api ( -- ** Era-dependent transaction body features CollateralSupportedInEra(..), - MultiAssetSupportedInEra(..), OnlyAdaSupportedInEra(..), ValidityUpperBoundSupportedInEra(..), ValidityNoUpperBoundSupportedInEra(..), From a3eca591569c4f1b5c3c068acc76b6dd48699f97 Mon Sep 17 00:00:00 2001 From: John Ky Date: Thu, 21 Sep 2023 18:16:18 +1000 Subject: [PATCH 04/14] Delete OnlyAdaSupportedInEra. Use ByronToAllegraEra instead --- cardano-api/cardano-api.cabal | 1 + cardano-api/internal/Cardano/Api/Fees.hs | 9 +-- cardano-api/internal/Cardano/Api/TxBody.hs | 55 +++++++------------ cardano-api/src/Cardano/Api.hs | 8 ++- .../Test/Golden/ErrorsSpec.hs | 2 +- .../TxBodyOutputNegative.txt | 2 +- .../TxBodyOutputOverflow.txt | 2 +- 7 files changed, 35 insertions(+), 44 deletions(-) diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 2111b39e20..42612db207 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -61,6 +61,7 @@ library internal Cardano.Api.Eon.ByronEraOnly Cardano.Api.Eon.ByronToAllegraEra Cardano.Api.Eon.ConwayEraOnwards + Cardano.Api.Eon.MaryEraOnwards Cardano.Api.Eon.ShelleyBasedEra Cardano.Api.Eon.ShelleyToAllegraEra Cardano.Api.Eon.ShelleyToAlonzoEra diff --git a/cardano-api/internal/Cardano/Api/Fees.hs b/cardano-api/internal/Cardano/Api/Fees.hs index 08309992a2..591d9f7bcc 100644 --- a/cardano-api/internal/Cardano/Api/Fees.hs +++ b/cardano-api/internal/Cardano/Api/Fees.hs @@ -48,6 +48,7 @@ import Cardano.Api.Address import Cardano.Api.Certificate import Cardano.Api.Eras.Core import Cardano.Api.Eras.Constraints +import Cardano.Api.Eon.ByronToAllegraEra import Cardano.Api.Eon.MaryEraOnwards import Cardano.Api.Error import Cardano.Api.Eon.ShelleyBasedEra @@ -696,7 +697,7 @@ evaluateTransactionBalance pp poolids stakeDelegDeposits drepDelegDeposits utxo ShelleyLedgerEra era ~ ledgerera => LedgerEraConstraints ledgerera => LedgerAdaOnlyConstraints ledgerera - => OnlyAdaSupportedInEra era + => ByronToAllegraEra era -> TxOutValue era evalAdaOnly evidence = TxOutAdaOnly evidence . fromShelleyLovelace @@ -716,7 +717,7 @@ evaluateTransactionBalance pp poolids stakeDelegDeposits drepDelegDeposits utxo => LedgerAdaOnlyConstraints ledgerera => LedgerPParamsConstraints ledgerera => LedgerTxBodyConstraints ledgerera - => OnlyAdaSupportedInEra era + => ByronToAllegraEra era -> a) -> ( LedgerEraConstraints ledgerera => LedgerMultiAssetConstraints ledgerera @@ -725,8 +726,8 @@ evaluateTransactionBalance pp poolids stakeDelegDeposits drepDelegDeposits utxo => MaryEraOnwards era -> a) -> a - withLedgerConstraints ShelleyBasedEraShelley f _ = f AdaOnlyInShelleyEra - withLedgerConstraints ShelleyBasedEraAllegra f _ = f AdaOnlyInAllegraEra + withLedgerConstraints ShelleyBasedEraShelley f _ = f ByronToAllegraEraShelley + withLedgerConstraints ShelleyBasedEraAllegra f _ = f ByronToAllegraEraAllegra withLedgerConstraints ShelleyBasedEraMary _ f = f MaryEraOnwardsMary withLedgerConstraints ShelleyBasedEraAlonzo _ f = f MaryEraOnwardsAlonzo withLedgerConstraints ShelleyBasedEraBabbage _ f = f MaryEraOnwardsBabbage diff --git a/cardano-api/internal/Cardano/Api/TxBody.hs b/cardano-api/internal/Cardano/Api/TxBody.hs index 565b330db7..58fb477134 100644 --- a/cardano-api/internal/Cardano/Api/TxBody.hs +++ b/cardano-api/internal/Cardano/Api/TxBody.hs @@ -115,7 +115,6 @@ module Cardano.Api.TxBody ( -- * Era-dependent transaction body features CollateralSupportedInEra(..), - OnlyAdaSupportedInEra(..), ValidityUpperBoundSupportedInEra(..), ValidityNoUpperBoundSupportedInEra(..), ValidityLowerBoundSupportedInEra(..), @@ -183,6 +182,7 @@ import Cardano.Api.Address import Cardano.Api.Certificate import Cardano.Api.Convenience.Constraints import Cardano.Api.Eon.ByronEraOnly +import Cardano.Api.Eon.ByronToAllegraEra import Cardano.Api.Eon.ConwayEraOnwards import Cardano.Api.Eon.MaryEraOnwards import Cardano.Api.Eon.ShelleyBasedEra @@ -735,13 +735,13 @@ fromByronTxOut :: Byron.TxOut -> TxOut ctx ByronEra fromByronTxOut (Byron.TxOut addr value) = TxOut (AddressInEra ByronAddressInAnyEra (ByronAddress addr)) - (TxOutAdaOnly AdaOnlyInByronEra (fromByronLovelace value)) + (TxOutAdaOnly ByronToAllegraEraByron (fromByronLovelace value)) TxOutDatumNone ReferenceScriptNone toByronTxOut :: TxOut ctx ByronEra -> Maybe Byron.TxOut toByronTxOut (TxOut (AddressInEra ByronAddressInAnyEra (ByronAddress addr)) - (TxOutAdaOnly AdaOnlyInByronEra value) _ _) = + (TxOutAdaOnly ByronToAllegraEraByron value) _ _) = Byron.TxOut addr <$> toByronLovelace value toByronTxOut (TxOut (AddressInEra ByronAddressInAnyEra (ByronAddress _)) @@ -756,13 +756,13 @@ toShelleyTxOut :: forall era ledgerera. => ShelleyBasedEra era -> TxOut CtxUTxO era -> Ledger.TxOut ledgerera -toShelleyTxOut sbe (TxOut _ (TxOutAdaOnly AdaOnlyInByronEra _) _ _) = +toShelleyTxOut sbe (TxOut _ (TxOutAdaOnly ByronToAllegraEraByron _) _ _) = case sbe of {} -toShelleyTxOut _ (TxOut addr (TxOutAdaOnly AdaOnlyInShelleyEra value) _ _) = +toShelleyTxOut _ (TxOut addr (TxOutAdaOnly ByronToAllegraEraShelley value) _ _) = L.mkBasicTxOut (toShelleyAddr addr) (toShelleyLovelace value) -toShelleyTxOut _ (TxOut addr (TxOutAdaOnly AdaOnlyInAllegraEra value) _ _) = +toShelleyTxOut _ (TxOut addr (TxOutAdaOnly ByronToAllegraEraAllegra value) _ _) = L.mkBasicTxOut (toShelleyAddr addr) (toShelleyLovelace value) toShelleyTxOut _ (TxOut addr (TxOutValue MaryEraOnwardsMary value) _ _) = @@ -792,7 +792,7 @@ fromShelleyTxOut sbe ledgerTxOut = case sbe of ShelleyBasedEraShelley -> TxOut (fromShelleyAddr sbe addr) - (TxOutAdaOnly AdaOnlyInShelleyEra + (TxOutAdaOnly ByronToAllegraEraShelley (fromShelleyLovelace value)) TxOutDatumNone ReferenceScriptNone where @@ -801,7 +801,7 @@ fromShelleyTxOut sbe ledgerTxOut = ShelleyBasedEraAllegra -> TxOut (fromShelleyAddr sbe addr) - (TxOutAdaOnly AdaOnlyInAllegraEra + (TxOutAdaOnly ByronToAllegraEraAllegra (fromShelleyLovelace value)) TxOutDatumNone ReferenceScriptNone where @@ -932,29 +932,12 @@ collateralSupportedInEra AlonzoEra = Just CollateralInAlonzoEra collateralSupportedInEra BabbageEra = Just CollateralInBabbageEra collateralSupportedInEra ConwayEra = Just CollateralInConwayEra --- | A representation of whether the era supports only ada transactions. --- --- Prior to the Mary era only ada transactions are supported. Multi-assets are --- supported from the Mary era onwards. --- --- This is the negation of 'MaryEraOnwards'. It exists since we need --- evidence to be positive. --- -data OnlyAdaSupportedInEra era where - - AdaOnlyInByronEra :: OnlyAdaSupportedInEra ByronEra - AdaOnlyInShelleyEra :: OnlyAdaSupportedInEra ShelleyEra - AdaOnlyInAllegraEra :: OnlyAdaSupportedInEra AllegraEra - -deriving instance Eq (OnlyAdaSupportedInEra era) -deriving instance Show (OnlyAdaSupportedInEra era) - -multiAssetSupportedInEra :: CardanoEra era - -> Either (OnlyAdaSupportedInEra era) - (MaryEraOnwards era) -multiAssetSupportedInEra ByronEra = Left AdaOnlyInByronEra -multiAssetSupportedInEra ShelleyEra = Left AdaOnlyInShelleyEra -multiAssetSupportedInEra AllegraEra = Left AdaOnlyInAllegraEra +multiAssetSupportedInEra :: () + => CardanoEra era + -> Either (ByronToAllegraEra era) (MaryEraOnwards era) +multiAssetSupportedInEra ByronEra = Left ByronToAllegraEraByron +multiAssetSupportedInEra ShelleyEra = Left ByronToAllegraEraShelley +multiAssetSupportedInEra AllegraEra = Left ByronToAllegraEraAllegra multiAssetSupportedInEra MaryEra = Right MaryEraOnwardsMary multiAssetSupportedInEra AlonzoEra = Right MaryEraOnwardsAlonzo multiAssetSupportedInEra BabbageEra = Right MaryEraOnwardsBabbage @@ -1336,7 +1319,7 @@ deriving instance Show (TxInsReference build era) data TxOutValue era where - TxOutAdaOnly :: OnlyAdaSupportedInEra era -> Lovelace -> TxOutValue era + TxOutAdaOnly :: ByronToAllegraEra era -> Lovelace -> TxOutValue era TxOutValue :: MaryEraOnwards era -> Value -> TxOutValue era @@ -3325,7 +3308,7 @@ makeByronTransactionBody TxBodyContent { txIns, txOuts } = do classifyRangeError :: TxOut CtxTx ByronEra -> TxBodyError classifyRangeError txout@(TxOut (AddressInEra ByronAddressInAnyEra ByronAddress{}) - (TxOutAdaOnly AdaOnlyInByronEra value) _ _) + (TxOutAdaOnly ByronToAllegraEraByron value) _ _) | value < 0 = TxBodyOutputNegative (lovelaceToQuantity value) (txOutInAnyEra txout) | otherwise = TxBodyOutputOverflow (lovelaceToQuantity value) @@ -3992,13 +3975,13 @@ toShelleyTxOutAny :: forall ctx era ledgerera. => ShelleyBasedEra era -> TxOut ctx era -> Ledger.TxOut ledgerera -toShelleyTxOutAny sbe (TxOut _ (TxOutAdaOnly AdaOnlyInByronEra _) _ _) = +toShelleyTxOutAny sbe (TxOut _ (TxOutAdaOnly ByronToAllegraEraByron _) _ _) = case sbe of {} -toShelleyTxOutAny _ (TxOut addr (TxOutAdaOnly AdaOnlyInShelleyEra value) _ _) = +toShelleyTxOutAny _ (TxOut addr (TxOutAdaOnly ByronToAllegraEraShelley value) _ _) = L.mkBasicTxOut (toShelleyAddr addr) (toShelleyLovelace value) -toShelleyTxOutAny _ (TxOut addr (TxOutAdaOnly AdaOnlyInAllegraEra value) _ _) = +toShelleyTxOutAny _ (TxOut addr (TxOutAdaOnly ByronToAllegraEraAllegra value) _ _) = L.mkBasicTxOut (toShelleyAddr addr) (toShelleyLovelace value) toShelleyTxOutAny _ (TxOut addr (TxOutValue MaryEraOnwardsMary value) _ _) = diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index efe3e243e4..908dbc2def 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -48,6 +48,12 @@ module Cardano.Api ( byronEraOnlyConstraints, byronEraOnlyToCardanoEra, + ByronToAllegraEra(..), + IsByronToAllegraEra(..), + AnyByronToAllegraEra(..), + byronToAllegraEraConstraints, + byronToAllegraEraToCardanoEra, + ShelleyToBabbageEra(..), AnyShelleyToBabbageEra(..), shelleyToBabbageEraConstraints, @@ -342,7 +348,6 @@ module Cardano.Api ( -- ** Era-dependent transaction body features CollateralSupportedInEra(..), - OnlyAdaSupportedInEra(..), ValidityUpperBoundSupportedInEra(..), ValidityNoUpperBoundSupportedInEra(..), ValidityLowerBoundSupportedInEra(..), @@ -1005,6 +1010,7 @@ import Cardano.Api.Eon.AlonzoEraOnly import Cardano.Api.Eon.AlonzoEraOnwards import Cardano.Api.Eon.BabbageEraOnwards import Cardano.Api.Eon.ByronEraOnly +import Cardano.Api.Eon.ByronToAllegraEra import Cardano.Api.Eon.ConwayEraOnwards import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Eon.ShelleyToAllegraEra diff --git a/cardano-api/test/cardano-api-golden/Test/Golden/ErrorsSpec.hs b/cardano-api/test/cardano-api-golden/Test/Golden/ErrorsSpec.hs index ea69ec5adb..45977d3561 100644 --- a/cardano-api/test/cardano-api-golden/Test/Golden/ErrorsSpec.hs +++ b/cardano-api/test/cardano-api-golden/Test/Golden/ErrorsSpec.hs @@ -116,7 +116,7 @@ changeaddr1 = (PaymentCredentialByKey (verificationKeyHash paymentVerKey1)) NoStakeAddress) txOutValue1 :: TxOutValue AllegraEra -txOutValue1 = TxOutAdaOnly AdaOnlyInAllegraEra 1 +txOutValue1 = TxOutAdaOnly ByronToAllegraEraAllegra 1 txout1 :: TxOut ctx AllegraEra txout1 = TxOut changeaddr1 txOutValue1 TxOutDatumNone ReferenceScriptNone diff --git a/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.TxBody.TxBodyError/TxBodyOutputNegative.txt b/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.TxBody.TxBodyError/TxBodyOutputNegative.txt index 45d1867a56..eed94129ee 100644 --- a/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.TxBody.TxBodyError/TxBodyOutputNegative.txt +++ b/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.TxBody.TxBodyError/TxBodyOutputNegative.txt @@ -1 +1 @@ -Negative quantity (1) in transaction output: TxOutInAnyEra AllegraEra (TxOut (AddressInEra (ShelleyAddressInEra ShelleyBasedEraAllegra) (ShelleyAddress Mainnet (KeyHashObj (KeyHash "250ca83514191f9ceaccee2eb3276d5ad964e17cc31a067691e04ca8")) StakeRefNull)) (TxOutAdaOnly AdaOnlyInAllegraEra (Lovelace 1)) TxOutDatumNone ReferenceScriptNone) \ No newline at end of file +Negative quantity (1) in transaction output: TxOutInAnyEra AllegraEra (TxOut (AddressInEra (ShelleyAddressInEra ShelleyBasedEraAllegra) (ShelleyAddress Mainnet (KeyHashObj (KeyHash "250ca83514191f9ceaccee2eb3276d5ad964e17cc31a067691e04ca8")) StakeRefNull)) (TxOutAdaOnly ByronToAllegraEraAllegra (Lovelace 1)) TxOutDatumNone ReferenceScriptNone) \ No newline at end of file diff --git a/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.TxBody.TxBodyError/TxBodyOutputOverflow.txt b/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.TxBody.TxBodyError/TxBodyOutputOverflow.txt index 20554ff0f5..34c4524709 100644 --- a/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.TxBody.TxBodyError/TxBodyOutputOverflow.txt +++ b/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.TxBody.TxBodyError/TxBodyOutputOverflow.txt @@ -1 +1 @@ -Quantity too large (1 >= 2^64) in transaction output: TxOutInAnyEra AllegraEra (TxOut (AddressInEra (ShelleyAddressInEra ShelleyBasedEraAllegra) (ShelleyAddress Mainnet (KeyHashObj (KeyHash "250ca83514191f9ceaccee2eb3276d5ad964e17cc31a067691e04ca8")) StakeRefNull)) (TxOutAdaOnly AdaOnlyInAllegraEra (Lovelace 1)) TxOutDatumNone ReferenceScriptNone) \ No newline at end of file +Quantity too large (1 >= 2^64) in transaction output: TxOutInAnyEra AllegraEra (TxOut (AddressInEra (ShelleyAddressInEra ShelleyBasedEraAllegra) (ShelleyAddress Mainnet (KeyHashObj (KeyHash "250ca83514191f9ceaccee2eb3276d5ad964e17cc31a067691e04ca8")) StakeRefNull)) (TxOutAdaOnly ByronToAllegraEraAllegra (Lovelace 1)) TxOutDatumNone ReferenceScriptNone) \ No newline at end of file From e37dc4859a0017da705f3d52848905bcb76011a6 Mon Sep 17 00:00:00 2001 From: John Ky Date: Thu, 21 Sep 2023 20:15:16 +1000 Subject: [PATCH 05/14] Additional constraints for MaryEraOnwards and ShelleyToAllegraEra --- cardano-api/internal/Cardano/Api/Eon/ShelleyToAllegraEra.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/cardano-api/internal/Cardano/Api/Eon/ShelleyToAllegraEra.hs b/cardano-api/internal/Cardano/Api/Eon/ShelleyToAllegraEra.hs index 5274e282f3..63a315e51e 100644 --- a/cardano-api/internal/Cardano/Api/Eon/ShelleyToAllegraEra.hs +++ b/cardano-api/internal/Cardano/Api/Eon/ShelleyToAllegraEra.hs @@ -29,6 +29,7 @@ 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.Coin as L import qualified Cardano.Ledger.Core as L import qualified Cardano.Ledger.SafeHash as L import qualified Cardano.Ledger.Shelley.TxCert as L @@ -80,6 +81,7 @@ type ShelleyToAllegraEraConstraints era = , L.ShelleyEraTxBody (ShelleyLedgerEra era) , L.ShelleyEraTxCert (ShelleyLedgerEra era) , L.TxCert (ShelleyLedgerEra era) ~ L.ShelleyTxCert (ShelleyLedgerEra era) + , L.Value (ShelleyLedgerEra era) ~ L.Coin , FromCBOR (Consensus.ChainDepState (ConsensusProtocol era)) , FromCBOR (DebugLedgerState era) From e0e2cf7d7c25db38cc05c72fdb8f860223d113a7 Mon Sep 17 00:00:00 2001 From: John Ky Date: Thu, 21 Sep 2023 18:38:15 +1000 Subject: [PATCH 06/14] Delete multiAssetSupportedInEra. Use caseByronToAllegraOrMaryEraOnwards instead --- cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs | 17 +++--- cardano-api/internal/Cardano/Api/Eras.hs | 1 + cardano-api/internal/Cardano/Api/Fees.hs | 14 +++-- cardano-api/internal/Cardano/Api/TxBody.hs | 59 +++++++------------ cardano-api/src/Cardano/Api.hs | 2 +- 5 files changed, 40 insertions(+), 53 deletions(-) diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index fd631451f6..8048b3003a 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -500,10 +500,10 @@ genTxIndex :: Gen TxIx genTxIndex = TxIx . fromIntegral <$> Gen.word16 Range.constantBounded genTxOutValue :: CardanoEra era -> Gen (TxOutValue era) -genTxOutValue era = - case multiAssetSupportedInEra era of - Left adaOnlyInEra -> TxOutAdaOnly adaOnlyInEra <$> genPositiveLovelace - Right multiAssetInEra -> TxOutValue multiAssetInEra <$> genValueForTxOut +genTxOutValue = + caseByronToAllegraOrMaryEraOnwards + (\w -> TxOutAdaOnly w <$> genPositiveLovelace) + (\w -> TxOutValue w <$> genValueForTxOut) genTxOutTxContext :: CardanoEra era -> Gen (TxOut CtxTx era) genTxOutTxContext era = @@ -636,14 +636,15 @@ genTxUpdateProposal era = ] genTxMintValue :: CardanoEra era -> Gen (TxMintValue BuildTx era) -genTxMintValue era = - case multiAssetSupportedInEra era of - Left _ -> pure TxMintNone - Right supported -> +genTxMintValue = + caseByronToAllegraOrMaryEraOnwards + (const (pure TxMintNone)) + (\supported -> Gen.choice [ pure TxMintNone , TxMintValue supported <$> genValueForMinting <*> return (BuildTxWith mempty) ] + ) genTxBodyContent :: CardanoEra era -> Gen (TxBodyContent BuildTx era) genTxBodyContent era = do diff --git a/cardano-api/internal/Cardano/Api/Eras.hs b/cardano-api/internal/Cardano/Api/Eras.hs index df4df06566..7afe9c65c9 100644 --- a/cardano-api/internal/Cardano/Api/Eras.hs +++ b/cardano-api/internal/Cardano/Api/Eras.hs @@ -37,6 +37,7 @@ module Cardano.Api.Eras , caseByronOrShelleyBasedEra -- ** Case on ShelleyBasedEra + , caseByronToAllegraOrMaryEraOnwards , caseShelleyToMaryOrAlonzoEraOnwards , caseShelleyToAlonzoOrBabbageEraOnwards , caseShelleyToBabbageOrConwayEraOnwards diff --git a/cardano-api/internal/Cardano/Api/Fees.hs b/cardano-api/internal/Cardano/Api/Fees.hs index 591d9f7bcc..dc2110eb21 100644 --- a/cardano-api/internal/Cardano/Api/Fees.hs +++ b/cardano-api/internal/Cardano/Api/Fees.hs @@ -46,12 +46,13 @@ module Cardano.Api.Fees ( import Cardano.Api.Address import Cardano.Api.Certificate -import Cardano.Api.Eras.Core -import Cardano.Api.Eras.Constraints import Cardano.Api.Eon.ByronToAllegraEra import Cardano.Api.Eon.MaryEraOnwards -import Cardano.Api.Error import Cardano.Api.Eon.ShelleyBasedEra +import Cardano.Api.Eras.Case +import Cardano.Api.Eras.Constraints +import Cardano.Api.Eras.Core +import Cardano.Api.Error import Cardano.Api.NetworkId import Cardano.Api.ProtocolParameters import Cardano.Api.Query @@ -977,9 +978,10 @@ makeTransactionBodyAutoBalance systemstart history lpp@(LedgerProtocolParameters , negateValue outgoingNonAda ] - let changeTxOut = case multiAssetSupportedInEra cardanoEra of - Left _ -> lovelaceToTxOutValue $ Lovelace (2^(64 :: Integer)) - 1 - Right multiAsset -> TxOutValue multiAsset (lovelaceToValue (Lovelace (2^(64 :: Integer)) - 1) <> nonAdaChange) + let changeTxOut = caseByronToAllegraOrMaryEraOnwards + (const (lovelaceToTxOutValue $ Lovelace (2^(64 :: Integer)) - 1)) + (\w -> TxOutValue w (lovelaceToValue (Lovelace (2^(64 :: Integer)) - 1) <> nonAdaChange)) + (cardanoEra @era) let (dummyCollRet, dummyTotColl) = maybeDummyTotalCollAndCollReturnOutput txbodycontent changeaddr txbody1 <- first TxBodyError $ -- TODO: impossible to fail now diff --git a/cardano-api/internal/Cardano/Api/TxBody.hs b/cardano-api/internal/Cardano/Api/TxBody.hs index 58fb477134..2f3b43a5fe 100644 --- a/cardano-api/internal/Cardano/Api/TxBody.hs +++ b/cardano-api/internal/Cardano/Api/TxBody.hs @@ -129,7 +129,6 @@ module Cardano.Api.TxBody ( -- ** Feature availability functions collateralSupportedInEra, - multiAssetSupportedInEra, validityUpperBoundSupportedInEra, validityNoUpperBoundSupportedInEra, validityLowerBoundSupportedInEra, @@ -932,27 +931,6 @@ collateralSupportedInEra AlonzoEra = Just CollateralInAlonzoEra collateralSupportedInEra BabbageEra = Just CollateralInBabbageEra collateralSupportedInEra ConwayEra = Just CollateralInConwayEra -multiAssetSupportedInEra :: () - => CardanoEra era - -> Either (ByronToAllegraEra era) (MaryEraOnwards era) -multiAssetSupportedInEra ByronEra = Left ByronToAllegraEraByron -multiAssetSupportedInEra ShelleyEra = Left ByronToAllegraEraShelley -multiAssetSupportedInEra AllegraEra = Left ByronToAllegraEraAllegra -multiAssetSupportedInEra MaryEra = Right MaryEraOnwardsMary -multiAssetSupportedInEra AlonzoEra = Right MaryEraOnwardsAlonzo -multiAssetSupportedInEra BabbageEra = Right MaryEraOnwardsBabbage -multiAssetSupportedInEra ConwayEra = Right MaryEraOnwardsConway - - --- -- | A representation of whether the era requires explicitly specified fees in --- -- transactions. --- -- --- -- The Byron era tx fees are implicit (as the difference bettween the sum of --- -- outputs and sum of inputs), but all later eras the fees are specified in the --- -- transaction explicitly. --- -- --- data TxFeesExplicitInEra era where - -- TxFeesExplicitInShelleyEra :: TxFeesExplicitInEra ShelleyEra -- TxFeesExplicitInAllegraEra :: TxFeesExplicitInEra AllegraEra -- TxFeesExplicitInMaryEra :: TxFeesExplicitInEra MaryEra @@ -1326,14 +1304,15 @@ data TxOutValue era where instance EraCast TxOutValue where eraCast toEra v = case v of TxOutAdaOnly _previousEra lovelace -> - case multiAssetSupportedInEra toEra of - Left adaOnly -> Right $ TxOutAdaOnly adaOnly lovelace - Right multiAssetSupp -> Right $ TxOutValue multiAssetSupp $ lovelaceToValue lovelace + caseByronToAllegraOrMaryEraOnwards + (\w -> Right $ TxOutAdaOnly w lovelace) + (\w -> Right $ TxOutValue w $ lovelaceToValue lovelace) + toEra TxOutValue (_ :: MaryEraOnwards fromEra) value -> - case multiAssetSupportedInEra toEra of - Left _adaOnly -> Left $ EraCastError v (cardanoEra @fromEra) toEra - Right multiAssetSupp -> Right $ TxOutValue multiAssetSupp value - + caseByronToAllegraOrMaryEraOnwards + (const (Left $ EraCastError v (cardanoEra @fromEra) toEra)) + (\w -> Right $ TxOutValue w value) + toEra deriving instance Eq (TxOutValue era) deriving instance Show (TxOutValue era) @@ -1344,15 +1323,18 @@ instance ToJSON (TxOutValue era) where toJSON (TxOutValue _ val) = toJSON val instance IsCardanoEra era => FromJSON (TxOutValue era) where - parseJSON = withObject "TxOutValue" $ \o -> do - case multiAssetSupportedInEra cardanoEra of - Left onlyAda -> do + parseJSON = withObject "TxOutValue" $ \o -> + caseByronToAllegraOrMaryEraOnwards + (\w -> do ll <- o .: "lovelace" - pure $ TxOutAdaOnly onlyAda $ selectLovelace ll - Right maSupported -> do + pure $ TxOutAdaOnly w $ selectLovelace ll + ) + (\w -> do let l = KeyMap.toList o vals <- mapM decodeAssetId l - pure $ TxOutValue maSupported $ mconcat vals + pure $ TxOutValue w $ mconcat vals + ) + cardanoEra where decodeAssetId :: (Aeson.Key, Aeson.Value) -> Aeson.Parser Value decodeAssetId (polid, Aeson.Object assetNameHm) = do @@ -1386,9 +1368,10 @@ instance IsCardanoEra era => FromJSON (TxOutValue era) where lovelaceToTxOutValue :: IsCardanoEra era => Lovelace -> TxOutValue era lovelaceToTxOutValue l = - case multiAssetSupportedInEra cardanoEra of - Left adaOnly -> TxOutAdaOnly adaOnly l - Right multiAsset -> TxOutValue multiAsset (lovelaceToValue l) + caseByronToAllegraOrMaryEraOnwards + (\w -> TxOutAdaOnly w l) + (\w -> TxOutValue w (lovelaceToValue l)) + cardanoEra txOutValueToLovelace :: TxOutValue era -> Lovelace txOutValueToLovelace tv = diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 908dbc2def..633c76aadc 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -119,6 +119,7 @@ module Cardano.Api ( caseByronOrShelleyBasedEra, -- ** Case on ShelleyBasedEra + caseByronToAllegraOrMaryEraOnwards, caseShelleyToMaryOrAlonzoEraOnwards, caseShelleyToAlonzoOrBabbageEraOnwards, caseShelleyToBabbageOrConwayEraOnwards, @@ -362,7 +363,6 @@ module Cardano.Api ( -- ** Feature availability functions collateralSupportedInEra, - multiAssetSupportedInEra, validityUpperBoundSupportedInEra, validityNoUpperBoundSupportedInEra, validityLowerBoundSupportedInEra, From 0e5c9f6a10121df3f4a95a039a605de428fff68d Mon Sep 17 00:00:00 2001 From: John Ky Date: Thu, 21 Sep 2023 20:11:51 +1000 Subject: [PATCH 07/14] New caseShelleyToAllegraOrMaryEraOnwards and shelleyToAllegraEraToByronToAllegraEra functions --- cardano-api/internal/Cardano/Api/Eras.hs | 1 + cardano-api/internal/Cardano/Api/Eras/Case.hs | 23 +++++++++++++++++++ cardano-api/src/Cardano/Api.hs | 1 + 3 files changed, 25 insertions(+) diff --git a/cardano-api/internal/Cardano/Api/Eras.hs b/cardano-api/internal/Cardano/Api/Eras.hs index 7afe9c65c9..4e7447dc5d 100644 --- a/cardano-api/internal/Cardano/Api/Eras.hs +++ b/cardano-api/internal/Cardano/Api/Eras.hs @@ -38,6 +38,7 @@ module Cardano.Api.Eras -- ** Case on ShelleyBasedEra , caseByronToAllegraOrMaryEraOnwards + , caseShelleyToAllegraOrMaryEraOnwards , caseShelleyToMaryOrAlonzoEraOnwards , caseShelleyToAlonzoOrBabbageEraOnwards , caseShelleyToBabbageOrConwayEraOnwards diff --git a/cardano-api/internal/Cardano/Api/Eras/Case.hs b/cardano-api/internal/Cardano/Api/Eras/Case.hs index e8759ac854..03babab9f9 100644 --- a/cardano-api/internal/Cardano/Api/Eras/Case.hs +++ b/cardano-api/internal/Cardano/Api/Eras/Case.hs @@ -10,11 +10,15 @@ module Cardano.Api.Eras.Case , caseByronToAllegraOrMaryEraOnwards -- Case on ShelleyBasedEra + , caseShelleyToAllegraOrMaryEraOnwards , caseShelleyToMaryOrAlonzoEraOnwards , caseShelleyToAlonzoOrBabbageEraOnwards , caseShelleyToBabbageOrConwayEraOnwards , noByronEraInShelleyBasedEra + + -- Conversions + , shelleyToAllegraEraToByronToAllegraEra ) where import Cardano.Api.Eon.AlonzoEraOnwards @@ -24,6 +28,7 @@ import Cardano.Api.Eon.ByronToAllegraEra import Cardano.Api.Eon.ConwayEraOnwards import Cardano.Api.Eon.MaryEraOnwards import Cardano.Api.Eon.ShelleyBasedEra +import Cardano.Api.Eon.ShelleyToAllegraEra import Cardano.Api.Eon.ShelleyToAlonzoEra import Cardano.Api.Eon.ShelleyToBabbageEra import Cardano.Api.Eon.ShelleyToMaryEra @@ -58,6 +63,19 @@ caseByronToAllegraOrMaryEraOnwards l r = \case BabbageEra -> r MaryEraOnwardsBabbage ConwayEra -> r MaryEraOnwardsConway +caseShelleyToAllegraOrMaryEraOnwards :: () + => (ShelleyToAllegraEraConstraints era => ShelleyToAllegraEra era -> a) + -> (MaryEraOnwardsConstraints era => MaryEraOnwards era -> a) + -> ShelleyBasedEra era + -> a +caseShelleyToAllegraOrMaryEraOnwards l r = \case + ShelleyBasedEraShelley -> l ShelleyToAllegraEraShelley + ShelleyBasedEraAllegra -> l ShelleyToAllegraEraAllegra + ShelleyBasedEraMary -> r MaryEraOnwardsMary + ShelleyBasedEraAlonzo -> r MaryEraOnwardsAlonzo + ShelleyBasedEraBabbage -> r MaryEraOnwardsBabbage + ShelleyBasedEraConway -> r MaryEraOnwardsConway + caseShelleyToMaryOrAlonzoEraOnwards :: () => (ShelleyToMaryEraConstraints era => ShelleyToMaryEra era -> a) -> (AlonzoEraOnwardsConstraints era => AlonzoEraOnwards era -> a) @@ -99,3 +117,8 @@ caseShelleyToBabbageOrConwayEraOnwards l r = \case noByronEraInShelleyBasedEra :: ShelleyBasedEra era -> ByronEraOnly era -> a noByronEraInShelleyBasedEra sbe ByronEraOnlyByron = case sbe of {} + +shelleyToAllegraEraToByronToAllegraEra :: ShelleyToAllegraEra era -> ByronToAllegraEra era +shelleyToAllegraEraToByronToAllegraEra = \case + ShelleyToAllegraEraShelley -> ByronToAllegraEraShelley + ShelleyToAllegraEraAllegra -> ByronToAllegraEraAllegra diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 633c76aadc..e6e90eb2de 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -120,6 +120,7 @@ module Cardano.Api ( -- ** Case on ShelleyBasedEra caseByronToAllegraOrMaryEraOnwards, + caseShelleyToAllegraOrMaryEraOnwards, caseShelleyToMaryOrAlonzoEraOnwards, caseShelleyToAlonzoOrBabbageEraOnwards, caseShelleyToBabbageOrConwayEraOnwards, From b14c8bc3f7e14be31793974877cb1384eb78d82c Mon Sep 17 00:00:00 2001 From: John Ky Date: Thu, 21 Sep 2023 20:24:55 +1000 Subject: [PATCH 08/14] In implementation of fromShelleyTxOut, compute txOutValue and addressInEra once rather than in each era --- cardano-api/internal/Cardano/Api/TxBody.hs | 66 ++++++++-------------- 1 file changed, 25 insertions(+), 41 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/TxBody.hs b/cardano-api/internal/Cardano/Api/TxBody.hs index 2f3b43a5fe..73bbfe0d0c 100644 --- a/cardano-api/internal/Cardano/Api/TxBody.hs +++ b/cardano-api/internal/Cardano/Api/TxBody.hs @@ -783,54 +783,43 @@ toShelleyTxOut sbe (TxOut addr (TxOutValue MaryEraOnwardsConway value) txoutdata & L.datumTxOutL .~ toBabbageTxOutDatum txoutdata & L.referenceScriptTxOutL .~ refScriptToShelleyScript cEra refScript -fromShelleyTxOut :: ShelleyLedgerEra era ~ ledgerera - => ShelleyBasedEra era - -> Core.TxOut ledgerera - -> TxOut ctx era -fromShelleyTxOut sbe ledgerTxOut = +fromShelleyTxOut :: forall era ledgerera ctx. () + => ShelleyLedgerEra era ~ ledgerera + => ShelleyBasedEra era + -> Core.TxOut ledgerera + -> TxOut ctx era +fromShelleyTxOut sbe ledgerTxOut = do + let txOutValue :: TxOutValue era + txOutValue = + caseShelleyToAllegraOrMaryEraOnwards + (\w -> TxOutAdaOnly (shelleyToAllegraEraToByronToAllegraEra w) (fromShelleyLovelace (ledgerTxOut ^. L.valueTxOutL))) + (\w -> TxOutValue w (fromMaryValue (ledgerTxOut ^. L.valueTxOutL))) + sbe + + let addressInEra :: AddressInEra era + addressInEra = shelleyBasedEraConstraints sbe $ fromShelleyAddr sbe $ ledgerTxOut ^. L.addrTxOutL + case sbe of ShelleyBasedEraShelley -> - TxOut (fromShelleyAddr sbe addr) - (TxOutAdaOnly ByronToAllegraEraShelley - (fromShelleyLovelace value)) - TxOutDatumNone ReferenceScriptNone - where - addr = ledgerTxOut ^. L.addrTxOutL - value = ledgerTxOut ^. L.valueTxOutL + TxOut addressInEra txOutValue TxOutDatumNone ReferenceScriptNone ShelleyBasedEraAllegra -> - TxOut (fromShelleyAddr sbe addr) - (TxOutAdaOnly ByronToAllegraEraAllegra - (fromShelleyLovelace value)) - TxOutDatumNone ReferenceScriptNone - where - addr = ledgerTxOut ^. L.addrTxOutL - value = ledgerTxOut ^. L.valueTxOutL + TxOut addressInEra txOutValue TxOutDatumNone ReferenceScriptNone ShelleyBasedEraMary -> - TxOut (fromShelleyAddr sbe addr) - (TxOutValue MaryEraOnwardsMary - (fromMaryValue value)) - TxOutDatumNone ReferenceScriptNone - where - addr = ledgerTxOut ^. L.addrTxOutL - value = ledgerTxOut ^. L.valueTxOutL + TxOut addressInEra txOutValue TxOutDatumNone ReferenceScriptNone ShelleyBasedEraAlonzo -> - TxOut (fromShelleyAddr sbe addr) - (TxOutValue MaryEraOnwardsAlonzo - (fromMaryValue value)) + TxOut addressInEra + txOutValue (fromAlonzoTxOutDataHash ScriptDataInAlonzoEra datahash) ReferenceScriptNone where - addr = ledgerTxOut ^. L.addrTxOutL - value = ledgerTxOut ^. L.valueTxOutL datahash = ledgerTxOut ^. L.dataHashTxOutL ShelleyBasedEraBabbage -> - TxOut (fromShelleyAddr sbe addr) - (TxOutValue MaryEraOnwardsBabbage - (fromMaryValue value)) + TxOut addressInEra + txOutValue (fromBabbageTxOutDatum ScriptDataInBabbageEra ReferenceTxInsScriptsInlineDatumsInBabbageEra @@ -840,15 +829,12 @@ fromShelleyTxOut sbe ledgerTxOut = SJust refScript -> fromShelleyScriptToReferenceScript ShelleyBasedEraBabbage refScript) where - addr = ledgerTxOut ^. L.addrTxOutL - value = ledgerTxOut ^. L.valueTxOutL datum = ledgerTxOut ^. L.datumTxOutL mRefScript = ledgerTxOut ^. L.referenceScriptTxOutL ShelleyBasedEraConway -> - TxOut (fromShelleyAddr sbe addr) - (TxOutValue MaryEraOnwardsConway - (fromMaryValue value)) + TxOut addressInEra + txOutValue (fromBabbageTxOutDatum ScriptDataInConwayEra ReferenceTxInsScriptsInlineDatumsInConwayEra @@ -858,8 +844,6 @@ fromShelleyTxOut sbe ledgerTxOut = SJust refScript -> fromShelleyScriptToReferenceScript ShelleyBasedEraConway refScript) where - addr = ledgerTxOut ^. L.addrTxOutL - value = ledgerTxOut ^. L.valueTxOutL datum = ledgerTxOut ^. L.datumTxOutL mRefScript = ledgerTxOut ^. L.referenceScriptTxOutL From 6848a8200aec8a0f3d9b4bfcaee1f039162349e4 Mon Sep 17 00:00:00 2001 From: John Ky Date: Thu, 21 Sep 2023 21:39:03 +1000 Subject: [PATCH 09/14] Delete ReferenceTxInsScriptsInlineDatumsInBabbageEra. Use BabbageEraOnwardsConway instead. --- cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs | 8 +-- cardano-api/internal/Cardano/Api/Script.hs | 19 +++---- cardano-api/internal/Cardano/Api/TxBody.hs | 51 ++++++++++--------- cardano-api/src/Cardano/Api/Shelley.hs | 1 - 4 files changed, 36 insertions(+), 43 deletions(-) diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index 8048b3003a..2607b300be 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -1021,13 +1021,13 @@ genTxOutDatumHashTxContext era = case era of [ pure TxOutDatumNone , TxOutDatumHash ScriptDataInBabbageEra <$> genHashScriptData , TxOutDatumInTx ScriptDataInBabbageEra <$> genHashableScriptData - , TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInBabbageEra <$> genHashableScriptData + , TxOutDatumInline BabbageEraOnwardsBabbage <$> genHashableScriptData ] ConwayEra -> Gen.choice [ pure TxOutDatumNone , TxOutDatumHash ScriptDataInConwayEra <$> genHashScriptData , TxOutDatumInTx ScriptDataInConwayEra <$> genHashableScriptData - , TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInConwayEra <$> genHashableScriptData + , TxOutDatumInline BabbageEraOnwardsConway <$> genHashableScriptData ] genTxOutDatumHashUTxOContext :: CardanoEra era -> Gen (TxOutDatum CtxUTxO era) @@ -1043,12 +1043,12 @@ genTxOutDatumHashUTxOContext era = case era of BabbageEra -> Gen.choice [ pure TxOutDatumNone , TxOutDatumHash ScriptDataInBabbageEra <$> genHashScriptData - , TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInBabbageEra <$> genHashableScriptData + , TxOutDatumInline BabbageEraOnwardsBabbage <$> genHashableScriptData ] ConwayEra -> Gen.choice [ pure TxOutDatumNone , TxOutDatumHash ScriptDataInConwayEra <$> genHashScriptData - , TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInConwayEra <$> genHashableScriptData + , TxOutDatumInline BabbageEraOnwardsConway <$> genHashableScriptData ] mkDummyHash :: forall h a. CRYPTO.HashAlgorithm h => Int -> CRYPTO.Hash h a diff --git a/cardano-api/internal/Cardano/Api/Script.hs b/cardano-api/internal/Cardano/Api/Script.hs index 0ac5616e6a..fa6e801a3b 100644 --- a/cardano-api/internal/Cardano/Api/Script.hs +++ b/cardano-api/internal/Cardano/Api/Script.hs @@ -43,7 +43,6 @@ module Cardano.Api.Script ( -- * Reference scripts ReferenceScript(..), - ReferenceTxInsScriptsInlineDatumsSupportedInEra(..), refInsScriptsAndInlineDatsSupportedInEra, refScriptToShelleyScript, @@ -110,6 +109,7 @@ module Cardano.Api.Script ( Hash(..), ) where +import Cardano.Api.Eon.BabbageEraOnwards import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.EraCast import Cardano.Api.Eras @@ -1379,7 +1379,7 @@ parsePaymentKeyHash = -- has to be added to the transaction, they can now be referenced via a transaction output. data ReferenceScript era where - ReferenceScript :: ReferenceTxInsScriptsInlineDatumsSupportedInEra era + ReferenceScript :: BabbageEraOnwards era -> ScriptInAnyLang -> ReferenceScript era @@ -1403,27 +1403,20 @@ instance IsCardanoEra era => FromJSON (ReferenceScript era) where instance EraCast ReferenceScript where eraCast toEra = \case ReferenceScriptNone -> pure ReferenceScriptNone - v@(ReferenceScript (_ :: ReferenceTxInsScriptsInlineDatumsSupportedInEra fromEra) scriptInAnyLang) -> + v@(ReferenceScript (_ :: BabbageEraOnwards fromEra) scriptInAnyLang) -> case refInsScriptsAndInlineDatsSupportedInEra toEra of Nothing -> Left $ EraCastError v (cardanoEra @fromEra) toEra Just supportedInEra -> Right $ ReferenceScript supportedInEra scriptInAnyLang -data ReferenceTxInsScriptsInlineDatumsSupportedInEra era where - ReferenceTxInsScriptsInlineDatumsInBabbageEra :: ReferenceTxInsScriptsInlineDatumsSupportedInEra BabbageEra - ReferenceTxInsScriptsInlineDatumsInConwayEra :: ReferenceTxInsScriptsInlineDatumsSupportedInEra ConwayEra - -deriving instance Eq (ReferenceTxInsScriptsInlineDatumsSupportedInEra era) -deriving instance Show (ReferenceTxInsScriptsInlineDatumsSupportedInEra era) - refInsScriptsAndInlineDatsSupportedInEra - :: CardanoEra era -> Maybe (ReferenceTxInsScriptsInlineDatumsSupportedInEra era) + :: CardanoEra era -> Maybe (BabbageEraOnwards era) refInsScriptsAndInlineDatsSupportedInEra ByronEra = Nothing refInsScriptsAndInlineDatsSupportedInEra ShelleyEra = Nothing refInsScriptsAndInlineDatsSupportedInEra AllegraEra = Nothing refInsScriptsAndInlineDatsSupportedInEra MaryEra = Nothing refInsScriptsAndInlineDatsSupportedInEra AlonzoEra = Nothing -refInsScriptsAndInlineDatsSupportedInEra BabbageEra = Just ReferenceTxInsScriptsInlineDatumsInBabbageEra -refInsScriptsAndInlineDatsSupportedInEra ConwayEra = Just ReferenceTxInsScriptsInlineDatumsInConwayEra +refInsScriptsAndInlineDatsSupportedInEra BabbageEra = Just BabbageEraOnwardsBabbage +refInsScriptsAndInlineDatsSupportedInEra ConwayEra = Just BabbageEraOnwardsConway refScriptToShelleyScript :: CardanoEra era diff --git a/cardano-api/internal/Cardano/Api/TxBody.hs b/cardano-api/internal/Cardano/Api/TxBody.hs index 73bbfe0d0c..51c4ceb994 100644 --- a/cardano-api/internal/Cardano/Api/TxBody.hs +++ b/cardano-api/internal/Cardano/Api/TxBody.hs @@ -180,6 +180,7 @@ module Cardano.Api.TxBody ( import Cardano.Api.Address import Cardano.Api.Certificate import Cardano.Api.Convenience.Constraints +import Cardano.Api.Eon.BabbageEraOnwards import Cardano.Api.Eon.ByronEraOnly import Cardano.Api.Eon.ByronToAllegraEra import Cardano.Api.Eon.ConwayEraOnwards @@ -514,7 +515,7 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxTx era) where Right hashableData -> do if hashScriptDataBytes hashableData /= h then fail "Inline datum not equivalent to inline datum hash" - else return $ TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInBabbageEra hashableData + else return $ TxOutDatumInline BabbageEraOnwardsBabbage hashableData (Nothing, Nothing) -> return TxOutDatumNone (_,_) -> fail "Should not be possible to create a tx output with either an inline datum hash or an inline datum" @@ -537,7 +538,7 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxTx era) where Right sData -> if hashScriptDataBytes sData /= h then fail "Inline datum not equivalent to inline datum hash" - else return $ TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInConwayEra sData + else return $ TxOutDatumInline BabbageEraOnwardsConway 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" @@ -563,7 +564,7 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxTx era) where finalRefScript <- case mBabRefScript of Nothing -> return r Just anyScript -> - return $ ReferenceScript ReferenceTxInsScriptsInlineDatumsInBabbageEra anyScript + return $ ReferenceScript BabbageEraOnwardsBabbage anyScript return $ TxOut addr v finalDat finalRefScript reconcileConway @@ -584,7 +585,7 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxTx era) where finalRefScript <- case mBabRefScript of Nothing -> return r Just anyScript -> - return $ ReferenceScript ReferenceTxInsScriptsInlineDatumsInConwayEra anyScript + return $ ReferenceScript BabbageEraOnwardsConway anyScript return $ TxOut addr v finalDat finalRefScript alonzoTxOutParser @@ -647,7 +648,7 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxUTxO era) where Right hashableData -> do if hashScriptDataBytes hashableData /= h then fail "Inline datum not equivalent to inline datum hash" - else return $ TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInBabbageEra hashableData + else return $ TxOutDatumInline BabbageEraOnwardsBabbage hashableData (Nothing, Nothing) -> return TxOutDatumNone (_,_) -> fail "Should not be possible to create a tx output with either an inline datum hash or an inline datum" @@ -671,7 +672,7 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxUTxO era) where Right sData -> if hashScriptDataBytes sData /= h then fail "Inline datum not equivalent to inline datum hash" - else return $ TxOutDatumInline ReferenceTxInsScriptsInlineDatumsInConwayEra sData + else return $ TxOutDatumInline BabbageEraOnwardsConway 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" @@ -694,7 +695,7 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxUTxO era) where finalRefScript <- case mBabRefScript of Nothing -> return r Just anyScript -> - return $ ReferenceScript ReferenceTxInsScriptsInlineDatumsInBabbageEra anyScript + return $ ReferenceScript BabbageEraOnwardsBabbage anyScript return $ TxOut addr v finalDat finalRefScript @@ -712,7 +713,7 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxUTxO era) where finalRefScript <- case mBabRefScript of Nothing -> return r Just anyScript -> - return $ ReferenceScript ReferenceTxInsScriptsInlineDatumsInConwayEra anyScript + return $ ReferenceScript BabbageEraOnwardsConway anyScript return $ TxOut addr v finalDat finalRefScript @@ -822,7 +823,7 @@ fromShelleyTxOut sbe ledgerTxOut = do txOutValue (fromBabbageTxOutDatum ScriptDataInBabbageEra - ReferenceTxInsScriptsInlineDatumsInBabbageEra + BabbageEraOnwardsBabbage datum) (case mRefScript of SNothing -> ReferenceScriptNone @@ -837,7 +838,7 @@ fromShelleyTxOut sbe ledgerTxOut = do txOutValue (fromBabbageTxOutDatum ScriptDataInConwayEra - ReferenceTxInsScriptsInlineDatumsInConwayEra + BabbageEraOnwardsConway datum) (case mRefScript of SNothing -> ReferenceScriptNone @@ -856,7 +857,7 @@ toAlonzoTxOutDataHash toAlonzoTxOutDataHash TxOutDatumNone = SNothing toAlonzoTxOutDataHash (TxOutDatumHash _ (ScriptDataHash dh)) = SJust dh toAlonzoTxOutDataHash (TxOutDatumInline inlineDatumSupp _sd) = - case inlineDatumSupp :: ReferenceTxInsScriptsInlineDatumsSupportedInEra AlonzoEra of {} + case inlineDatumSupp :: BabbageEraOnwards AlonzoEra of {} fromAlonzoTxOutDataHash :: ScriptDataSupportedInEra era -> StrictMaybe (L.DataHash StandardCrypto) @@ -876,7 +877,7 @@ toBabbageTxOutDatum (TxOutDatumInline _ sd) = scriptDataToInlineDatum sd fromBabbageTxOutDatum :: (L.Era ledgerera, Ledger.EraCrypto ledgerera ~ StandardCrypto) => ScriptDataSupportedInEra era - -> ReferenceTxInsScriptsInlineDatumsSupportedInEra era + -> BabbageEraOnwards era -> Babbage.Datum ledgerera -> TxOutDatum ctx era fromBabbageTxOutDatum _ _ Babbage.NoDatum = TxOutDatumNone @@ -1268,7 +1269,7 @@ data TxInsReference build era where TxInsReferenceNone :: TxInsReference build era - TxInsReference :: ReferenceTxInsScriptsInlineDatumsSupportedInEra era + TxInsReference :: BabbageEraOnwards era -> [TxIn] -> TxInsReference build era @@ -1442,7 +1443,7 @@ data TxOutDatum ctx era where -- datum hash. Note that the datum map will not be updated with this datum, -- it only exists at the transaction output. -- - TxOutDatumInline :: ReferenceTxInsScriptsInlineDatumsSupportedInEra era + TxOutDatumInline :: BabbageEraOnwards era -> HashableScriptData -> TxOutDatum ctx era @@ -1462,7 +1463,7 @@ instance EraCast (TxOutDatum ctx) where Nothing -> Left $ EraCastError v (cardanoEra @fromEra) toEra Just sDatumsSupported -> Right $ TxOutDatumInTx' sDatumsSupported scriptData hash - TxOutDatumInline (_ :: ReferenceTxInsScriptsInlineDatumsSupportedInEra fromEra) scriptData -> + TxOutDatumInline (_ :: BabbageEraOnwards fromEra) scriptData -> case refInsScriptsAndInlineDatsSupportedInEra toEra of Nothing -> Left $ EraCastError v (cardanoEra @fromEra) toEra Just refInsAndInlineSupported -> @@ -2711,11 +2712,11 @@ fromLedgerTxInsReference sbe txBody = $ map fromShelleyTxIn . Set.toList $ ledgerRefInputs where obtainReferenceInputsHasFieldConstraint - :: ReferenceTxInsScriptsInlineDatumsSupportedInEra era + :: BabbageEraOnwards era -> ((L.EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto, L.BabbageEraTxBody (ShelleyLedgerEra era)) => a) -> a - obtainReferenceInputsHasFieldConstraint ReferenceTxInsScriptsInlineDatumsInBabbageEra f = f - obtainReferenceInputsHasFieldConstraint ReferenceTxInsScriptsInlineDatumsInConwayEra f = f + obtainReferenceInputsHasFieldConstraint BabbageEraOnwardsBabbage f = f + obtainReferenceInputsHasFieldConstraint BabbageEraOnwardsConway f = f fromLedgerTxOuts :: forall era. @@ -2747,7 +2748,7 @@ fromLedgerTxOuts sbe body scriptdata = [ fromBabbageTxOut MaryEraOnwardsBabbage ScriptDataInBabbageEra - ReferenceTxInsScriptsInlineDatumsInBabbageEra + BabbageEraOnwardsBabbage txdatums txouts | let txdatums = selectTxDatums scriptdata @@ -2758,7 +2759,7 @@ fromLedgerTxOuts sbe body scriptdata = [ fromBabbageTxOut MaryEraOnwardsConway ScriptDataInConwayEra - ReferenceTxInsScriptsInlineDatumsInConwayEra + BabbageEraOnwardsConway txdatums txouts | let txdatums = selectTxDatums scriptdata @@ -2804,7 +2805,7 @@ fromBabbageTxOut => Ledger.Value ledgerera ~ MaryValue StandardCrypto => MaryEraOnwards era -> ScriptDataSupportedInEra era - -> ReferenceTxInsScriptsInlineDatumsSupportedInEra era + -> BabbageEraOnwards era -> Map (L.DataHash StandardCrypto) (L.Data ledgerera) -> L.TxOut ledgerera @@ -3976,7 +3977,7 @@ toAlonzoTxOutDataHash' TxOutDatumNone = SNothing toAlonzoTxOutDataHash' (TxOutDatumHash _ (ScriptDataHash dh)) = SJust dh toAlonzoTxOutDataHash' (TxOutDatumInTx' _ (ScriptDataHash dh) _) = SJust dh toAlonzoTxOutDataHash' (TxOutDatumInline inlineDatumSupp _sd) = - case inlineDatumSupp :: ReferenceTxInsScriptsInlineDatumsSupportedInEra AlonzoEra of {} + case inlineDatumSupp :: BabbageEraOnwards AlonzoEra of {} -- TODO: Consolidate with alonzo function and rename toBabbageTxOutDatum' @@ -4233,9 +4234,9 @@ scriptDataToInlineDatum d = binaryDataToScriptData :: L.Era ledgerera - => ReferenceTxInsScriptsInlineDatumsSupportedInEra era + => BabbageEraOnwards era -> L.BinaryData ledgerera -> HashableScriptData -binaryDataToScriptData ReferenceTxInsScriptsInlineDatumsInBabbageEra d = +binaryDataToScriptData BabbageEraOnwardsBabbage d = fromAlonzoData $ L.binaryDataToData d -binaryDataToScriptData ReferenceTxInsScriptsInlineDatumsInConwayEra d = +binaryDataToScriptData BabbageEraOnwardsConway d = fromAlonzoData $ L.binaryDataToData d diff --git a/cardano-api/src/Cardano/Api/Shelley.hs b/cardano-api/src/Cardano/Api/Shelley.hs index a5f7b72f63..097e0a736c 100644 --- a/cardano-api/src/Cardano/Api/Shelley.hs +++ b/cardano-api/src/Cardano/Api/Shelley.hs @@ -153,7 +153,6 @@ module Cardano.Api.Shelley -- * Reference Scripts ReferenceScript(..), - ReferenceTxInsScriptsInlineDatumsSupportedInEra(..), refInsScriptsAndInlineDatsSupportedInEra, refScriptToShelleyScript, From 884b330adbebd8d3243e6f575dc84c2c65d99823 Mon Sep 17 00:00:00 2001 From: John Ky Date: Thu, 21 Sep 2023 22:17:16 +1000 Subject: [PATCH 10/14] Delete refInsScriptsAndInlineDatsSupportedInEra. Use caseShelleyToAlonzoOrBabbageEraOnwards instead. --- cardano-api/cardano-api.cabal | 1 + cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs | 15 +-- .../Cardano/Api/Eon/ByronToAlonzoEra.hs | 98 +++++++++++++++++++ cardano-api/internal/Cardano/Api/Eras.hs | 1 + cardano-api/internal/Cardano/Api/Eras/Case.hs | 16 +++ cardano-api/internal/Cardano/Api/Script.hs | 42 +++----- cardano-api/internal/Cardano/Api/TxBody.hs | 28 ++---- cardano-api/src/Cardano/Api.hs | 1 + cardano-api/src/Cardano/Api/Shelley.hs | 1 - 9 files changed, 149 insertions(+), 54 deletions(-) create mode 100644 cardano-api/internal/Cardano/Api/Eon/ByronToAlonzoEra.hs diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 42612db207..908e8428e7 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -60,6 +60,7 @@ library internal Cardano.Api.Eon.BabbageEraOnwards Cardano.Api.Eon.ByronEraOnly Cardano.Api.Eon.ByronToAllegraEra + Cardano.Api.Eon.ByronToAlonzoEra Cardano.Api.Eon.ConwayEraOnwards Cardano.Api.Eon.MaryEraOnwards Cardano.Api.Eon.ShelleyBasedEra diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index 2607b300be..12d59f2dcd 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -521,9 +521,10 @@ genTxOutUTxOContext era = genReferenceScript :: CardanoEra era -> Gen (ReferenceScript era) genReferenceScript era = - case refInsScriptsAndInlineDatsSupportedInEra era of - Nothing -> return ReferenceScriptNone - Just _ -> scriptInEraToRefScript <$> genScriptInEra era + caseByronToAlonzoOrBabbageEraOnwards + (const (return ReferenceScriptNone)) + (const (scriptInEraToRefScript <$> genScriptInEra era)) + era genUTxO :: CardanoEra era -> Gen (UTxO era) genUTxO era = @@ -701,10 +702,10 @@ genTxInsCollateral era = ] genTxInsReference :: CardanoEra era -> Gen (TxInsReference BuildTx era) -genTxInsReference era = - case refInsScriptsAndInlineDatsSupportedInEra era of - Nothing -> pure TxInsReferenceNone - Just supported -> TxInsReference supported <$> Gen.list (Range.linear 0 10) genTxIn +genTxInsReference = + caseByronToAlonzoOrBabbageEraOnwards + (const (pure TxInsReferenceNone)) + (\w -> TxInsReference w <$> Gen.list (Range.linear 0 10) genTxIn) genTxReturnCollateral :: CardanoEra era -> Gen (TxReturnCollateral CtxTx era) genTxReturnCollateral era = diff --git a/cardano-api/internal/Cardano/Api/Eon/ByronToAlonzoEra.hs b/cardano-api/internal/Cardano/Api/Eon/ByronToAlonzoEra.hs new file mode 100644 index 0000000000..7b046dd49a --- /dev/null +++ b/cardano-api/internal/Cardano/Api/Eon/ByronToAlonzoEra.hs @@ -0,0 +1,98 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilies #-} + +module Cardano.Api.Eon.ByronToAlonzoEra + ( ByronToAlonzoEra(..) + , IsByronToAlonzoEra(..) + , AnyByronToAlonzoEra(..) + , byronToAlonzoEraConstraints + , byronToAlonzoEraToCardanoEra + + , ByronToAlonzoEraConstraints + ) where + +import Cardano.Api.Eras.Core + +import Data.Typeable (Typeable) + +class IsByronToAlonzoEra era where + byronToAlonzoEra :: ByronToAlonzoEra era + +data ByronToAlonzoEra era where + ByronToAlonzoEraByron :: ByronToAlonzoEra ByronEra + ByronToAlonzoEraShelley :: ByronToAlonzoEra ShelleyEra + ByronToAlonzoEraAllegra :: ByronToAlonzoEra AllegraEra + ByronToAlonzoEraMary :: ByronToAlonzoEra MaryEra + ByronToAlonzoEraAlonzo :: ByronToAlonzoEra AlonzoEra + +deriving instance Show (ByronToAlonzoEra era) +deriving instance Eq (ByronToAlonzoEra era) + +instance IsByronToAlonzoEra ByronEra where + byronToAlonzoEra = ByronToAlonzoEraByron + +instance IsByronToAlonzoEra ShelleyEra where + byronToAlonzoEra = ByronToAlonzoEraShelley + +instance IsByronToAlonzoEra AllegraEra where + byronToAlonzoEra = ByronToAlonzoEraAllegra + +instance IsByronToAlonzoEra MaryEra where + byronToAlonzoEra = ByronToAlonzoEraMary + +instance IsByronToAlonzoEra AlonzoEra where + byronToAlonzoEra = ByronToAlonzoEraAlonzo + +instance Eon ByronToAlonzoEra where + inEonForEra no yes = \case + ByronEra -> yes ByronToAlonzoEraByron + ShelleyEra -> yes ByronToAlonzoEraShelley + AllegraEra -> yes ByronToAlonzoEraAllegra + MaryEra -> yes ByronToAlonzoEraMary + AlonzoEra -> yes ByronToAlonzoEraAlonzo + BabbageEra -> no + ConwayEra -> no + +instance ToCardanoEra ByronToAlonzoEra where + toCardanoEra = \case + ByronToAlonzoEraByron -> ByronEra + ByronToAlonzoEraShelley -> ShelleyEra + ByronToAlonzoEraAllegra -> AllegraEra + ByronToAlonzoEraMary -> MaryEra + ByronToAlonzoEraAlonzo -> AlonzoEra + +type ByronToAlonzoEraConstraints era = + ( IsCardanoEra era + , IsByronToAlonzoEra era + , Typeable era + ) + +data AnyByronToAlonzoEra where + AnyByronToAlonzoEra :: ByronToAlonzoEra era -> AnyByronToAlonzoEra + +deriving instance Show AnyByronToAlonzoEra + +byronToAlonzoEraConstraints :: () + => ByronToAlonzoEra era + -> (ByronToAlonzoEraConstraints era => a) + -> a +byronToAlonzoEraConstraints = \case + ByronToAlonzoEraByron -> id + ByronToAlonzoEraShelley -> id + ByronToAlonzoEraAllegra -> id + ByronToAlonzoEraMary -> id + ByronToAlonzoEraAlonzo -> id + +byronToAlonzoEraToCardanoEra :: ByronToAlonzoEra era -> CardanoEra era +byronToAlonzoEraToCardanoEra = \case + ByronToAlonzoEraByron -> ByronEra + ByronToAlonzoEraShelley -> ShelleyEra + ByronToAlonzoEraAllegra -> AllegraEra + ByronToAlonzoEraMary -> MaryEra + ByronToAlonzoEraAlonzo -> AlonzoEra diff --git a/cardano-api/internal/Cardano/Api/Eras.hs b/cardano-api/internal/Cardano/Api/Eras.hs index 4e7447dc5d..fc9e9be447 100644 --- a/cardano-api/internal/Cardano/Api/Eras.hs +++ b/cardano-api/internal/Cardano/Api/Eras.hs @@ -38,6 +38,7 @@ module Cardano.Api.Eras -- ** Case on ShelleyBasedEra , caseByronToAllegraOrMaryEraOnwards + , caseByronToAlonzoOrBabbageEraOnwards , caseShelleyToAllegraOrMaryEraOnwards , caseShelleyToMaryOrAlonzoEraOnwards , caseShelleyToAlonzoOrBabbageEraOnwards diff --git a/cardano-api/internal/Cardano/Api/Eras/Case.hs b/cardano-api/internal/Cardano/Api/Eras/Case.hs index 03babab9f9..ea0d2f1a6d 100644 --- a/cardano-api/internal/Cardano/Api/Eras/Case.hs +++ b/cardano-api/internal/Cardano/Api/Eras/Case.hs @@ -8,6 +8,7 @@ module Cardano.Api.Eras.Case ( -- Case on CardanoEra caseByronOrShelleyBasedEra , caseByronToAllegraOrMaryEraOnwards + , caseByronToAlonzoOrBabbageEraOnwards -- Case on ShelleyBasedEra , caseShelleyToAllegraOrMaryEraOnwards @@ -25,6 +26,7 @@ import Cardano.Api.Eon.AlonzoEraOnwards import Cardano.Api.Eon.BabbageEraOnwards import Cardano.Api.Eon.ByronEraOnly import Cardano.Api.Eon.ByronToAllegraEra +import Cardano.Api.Eon.ByronToAlonzoEra import Cardano.Api.Eon.ConwayEraOnwards import Cardano.Api.Eon.MaryEraOnwards import Cardano.Api.Eon.ShelleyBasedEra @@ -63,6 +65,20 @@ caseByronToAllegraOrMaryEraOnwards l r = \case BabbageEra -> r MaryEraOnwardsBabbage ConwayEra -> r MaryEraOnwardsConway +caseByronToAlonzoOrBabbageEraOnwards :: () + => (ByronToAlonzoEraConstraints era => ByronToAlonzoEra era -> a) + -> (BabbageEraOnwardsConstraints era => BabbageEraOnwards era -> a) + -> CardanoEra era + -> a +caseByronToAlonzoOrBabbageEraOnwards l r = \case + ByronEra -> l ByronToAlonzoEraByron + ShelleyEra -> l ByronToAlonzoEraShelley + AllegraEra -> l ByronToAlonzoEraAllegra + MaryEra -> l ByronToAlonzoEraMary + AlonzoEra -> l ByronToAlonzoEraAlonzo + BabbageEra -> r BabbageEraOnwardsBabbage + ConwayEra -> r BabbageEraOnwardsConway + caseShelleyToAllegraOrMaryEraOnwards :: () => (ShelleyToAllegraEraConstraints era => ShelleyToAllegraEra era -> a) -> (MaryEraOnwardsConstraints era => MaryEraOnwards era -> a) diff --git a/cardano-api/internal/Cardano/Api/Script.hs b/cardano-api/internal/Cardano/Api/Script.hs index fa6e801a3b..bd107ff2f4 100644 --- a/cardano-api/internal/Cardano/Api/Script.hs +++ b/cardano-api/internal/Cardano/Api/Script.hs @@ -43,7 +43,6 @@ module Cardano.Api.Script ( -- * Reference scripts ReferenceScript(..), - refInsScriptsAndInlineDatsSupportedInEra, refScriptToShelleyScript, -- * Use of a script in an era as a witness @@ -112,7 +111,8 @@ module Cardano.Api.Script ( import Cardano.Api.Eon.BabbageEraOnwards import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.EraCast -import Cardano.Api.Eras +import Cardano.Api.Eras.Case +import Cardano.Api.Eras.Core import Cardano.Api.Error import Cardano.Api.Hash import Cardano.Api.HasTypeProxy @@ -1395,28 +1395,19 @@ instance IsCardanoEra era => ToJSON (ReferenceScript era) where instance IsCardanoEra era => FromJSON (ReferenceScript era) where parseJSON = Aeson.withObject "ReferenceScript" $ \o -> - case refInsScriptsAndInlineDatsSupportedInEra (cardanoEra :: CardanoEra era) of - Nothing -> pure ReferenceScriptNone - Just refSupInEra -> - ReferenceScript refSupInEra <$> o .: "referenceScript" + caseByronToAlonzoOrBabbageEraOnwards + (const (pure ReferenceScriptNone)) + (\w -> ReferenceScript w <$> o .: "referenceScript") + (cardanoEra :: CardanoEra era) instance EraCast ReferenceScript where eraCast toEra = \case ReferenceScriptNone -> pure ReferenceScriptNone - v@(ReferenceScript (_ :: BabbageEraOnwards fromEra) scriptInAnyLang) -> - case refInsScriptsAndInlineDatsSupportedInEra toEra of - Nothing -> Left $ EraCastError v (cardanoEra @fromEra) toEra - Just supportedInEra -> Right $ ReferenceScript supportedInEra scriptInAnyLang - -refInsScriptsAndInlineDatsSupportedInEra - :: CardanoEra era -> Maybe (BabbageEraOnwards era) -refInsScriptsAndInlineDatsSupportedInEra ByronEra = Nothing -refInsScriptsAndInlineDatsSupportedInEra ShelleyEra = Nothing -refInsScriptsAndInlineDatsSupportedInEra AllegraEra = Nothing -refInsScriptsAndInlineDatsSupportedInEra MaryEra = Nothing -refInsScriptsAndInlineDatsSupportedInEra AlonzoEra = Nothing -refInsScriptsAndInlineDatsSupportedInEra BabbageEra = Just BabbageEraOnwardsBabbage -refInsScriptsAndInlineDatsSupportedInEra ConwayEra = Just BabbageEraOnwardsConway + v@(ReferenceScript ws scriptInAnyLang) -> + caseByronToAlonzoOrBabbageEraOnwards + (const (Left $ EraCastError v (babbageEraOnwardsToCardanoEra ws) toEra)) + (\wt -> Right $ ReferenceScript wt scriptInAnyLang) + toEra refScriptToShelleyScript :: CardanoEra era @@ -1435,13 +1426,10 @@ fromShelleyScriptToReferenceScript sbe script = scriptInEraToRefScript :: ScriptInEra era -> ReferenceScript era scriptInEraToRefScript sIne@(ScriptInEra _ s) = - case refInsScriptsAndInlineDatsSupportedInEra era of - Nothing -> ReferenceScriptNone - Just supp -> - -- Any script can be a reference script - ReferenceScript supp $ toScriptInAnyLang s - where - era = shelleyBasedToCardanoEra $ eraOfScriptInEra sIne + caseShelleyToAlonzoOrBabbageEraOnwards + (const ReferenceScriptNone) + (\w -> ReferenceScript w $ toScriptInAnyLang s) -- Any script can be a reference script + (eraOfScriptInEra sIne) -- Helpers diff --git a/cardano-api/internal/Cardano/Api/TxBody.hs b/cardano-api/internal/Cardano/Api/TxBody.hs index 51c4ceb994..5a5502f5d0 100644 --- a/cardano-api/internal/Cardano/Api/TxBody.hs +++ b/cardano-api/internal/Cardano/Api/TxBody.hs @@ -1463,11 +1463,11 @@ instance EraCast (TxOutDatum ctx) where Nothing -> Left $ EraCastError v (cardanoEra @fromEra) toEra Just sDatumsSupported -> Right $ TxOutDatumInTx' sDatumsSupported scriptData hash - TxOutDatumInline (_ :: BabbageEraOnwards fromEra) scriptData -> - case refInsScriptsAndInlineDatsSupportedInEra toEra of - Nothing -> Left $ EraCastError v (cardanoEra @fromEra) toEra - Just refInsAndInlineSupported -> - Right $ TxOutDatumInline refInsAndInlineSupported scriptData + TxOutDatumInline ws scriptData -> + caseByronToAlonzoOrBabbageEraOnwards + (const (Left $ EraCastError v (babbageEraOnwardsToCardanoEra ws) toEra)) + (\wt -> Right $ TxOutDatumInline wt scriptData) + toEra pattern TxOutDatumInTx :: ScriptDataSupportedInEra era @@ -2703,20 +2703,10 @@ fromLedgerTxInsCollateral sbe body = fromLedgerTxInsReference :: ShelleyBasedEra era -> Ledger.TxBody (ShelleyLedgerEra era) -> TxInsReference ViewTx era fromLedgerTxInsReference sbe txBody = - case refInsScriptsAndInlineDatsSupportedInEra $ shelleyBasedToCardanoEra sbe of - Nothing -> TxInsReferenceNone - Just suppInEra -> - let ledgerRefInputs = - obtainReferenceInputsHasFieldConstraint suppInEra $ txBody ^. L.referenceInputsTxBodyL - in TxInsReference suppInEra - $ map fromShelleyTxIn . Set.toList $ ledgerRefInputs - where - obtainReferenceInputsHasFieldConstraint - :: BabbageEraOnwards era - -> ((L.EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto, L.BabbageEraTxBody (ShelleyLedgerEra era)) => a) - -> a - obtainReferenceInputsHasFieldConstraint BabbageEraOnwardsBabbage f = f - obtainReferenceInputsHasFieldConstraint BabbageEraOnwardsConway f = f + caseShelleyToAlonzoOrBabbageEraOnwards + (const TxInsReferenceNone) + (\w -> TxInsReference w $ map fromShelleyTxIn . Set.toList $ txBody ^. L.referenceInputsTxBodyL) + sbe fromLedgerTxOuts :: forall era. diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index e6e90eb2de..c8242038eb 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -120,6 +120,7 @@ module Cardano.Api ( -- ** Case on ShelleyBasedEra caseByronToAllegraOrMaryEraOnwards, + caseByronToAlonzoOrBabbageEraOnwards, caseShelleyToAllegraOrMaryEraOnwards, caseShelleyToMaryOrAlonzoEraOnwards, caseShelleyToAlonzoOrBabbageEraOnwards, diff --git a/cardano-api/src/Cardano/Api/Shelley.hs b/cardano-api/src/Cardano/Api/Shelley.hs index 097e0a736c..26cfe350ff 100644 --- a/cardano-api/src/Cardano/Api/Shelley.hs +++ b/cardano-api/src/Cardano/Api/Shelley.hs @@ -153,7 +153,6 @@ module Cardano.Api.Shelley -- * Reference Scripts ReferenceScript(..), - refInsScriptsAndInlineDatsSupportedInEra, refScriptToShelleyScript, -- * Certificates From 45766383e060aac162db3fce437bcac969a47004 Mon Sep 17 00:00:00 2001 From: John Ky Date: Thu, 21 Sep 2023 22:32:04 +1000 Subject: [PATCH 11/14] Delete ScriptDataInAlonzoEra. Use AlonzoEraOnwardsAlonzo instead --- cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs | 22 ++-- cardano-api/internal/Cardano/Api/Tx.hs | 15 +-- cardano-api/internal/Cardano/Api/TxBody.hs | 112 ++++++++---------- cardano-api/src/Cardano/Api.hs | 1 - 4 files changed, 64 insertions(+), 86 deletions(-) diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index 12d59f2dcd..92d7a8cec2 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -98,7 +98,6 @@ module Test.Gen.Cardano.Api.Typed , genVerificationKeyHash , genUpdateProposal , genProtocolParametersUpdate - , genScriptDataSupportedInAlonzoEra , genTxOutDatumHashTxContext , genTxOutDatumHashUTxOContext , genTxOutValue @@ -1015,19 +1014,19 @@ genTxOutDatumHashTxContext era = case era of MaryEra -> pure TxOutDatumNone AlonzoEra -> Gen.choice [ pure TxOutDatumNone - , TxOutDatumHash ScriptDataInAlonzoEra <$> genHashScriptData - , TxOutDatumInTx ScriptDataInAlonzoEra <$> genHashableScriptData + , TxOutDatumHash AlonzoEraOnwardsAlonzo <$> genHashScriptData + , TxOutDatumInTx AlonzoEraOnwardsAlonzo <$> genHashableScriptData ] BabbageEra -> Gen.choice [ pure TxOutDatumNone - , TxOutDatumHash ScriptDataInBabbageEra <$> genHashScriptData - , TxOutDatumInTx ScriptDataInBabbageEra <$> genHashableScriptData + , TxOutDatumHash AlonzoEraOnwardsBabbage <$> genHashScriptData + , TxOutDatumInTx AlonzoEraOnwardsBabbage <$> genHashableScriptData , TxOutDatumInline BabbageEraOnwardsBabbage <$> genHashableScriptData ] ConwayEra -> Gen.choice [ pure TxOutDatumNone - , TxOutDatumHash ScriptDataInConwayEra <$> genHashScriptData - , TxOutDatumInTx ScriptDataInConwayEra <$> genHashableScriptData + , TxOutDatumHash AlonzoEraOnwardsConway <$> genHashScriptData + , TxOutDatumInTx AlonzoEraOnwardsConway <$> genHashableScriptData , TxOutDatumInline BabbageEraOnwardsConway <$> genHashableScriptData ] @@ -1039,16 +1038,16 @@ genTxOutDatumHashUTxOContext era = case era of MaryEra -> pure TxOutDatumNone AlonzoEra -> Gen.choice [ pure TxOutDatumNone - , TxOutDatumHash ScriptDataInAlonzoEra <$> genHashScriptData + , TxOutDatumHash AlonzoEraOnwardsAlonzo <$> genHashScriptData ] BabbageEra -> Gen.choice [ pure TxOutDatumNone - , TxOutDatumHash ScriptDataInBabbageEra <$> genHashScriptData + , TxOutDatumHash AlonzoEraOnwardsBabbage <$> genHashScriptData , TxOutDatumInline BabbageEraOnwardsBabbage <$> genHashableScriptData ] ConwayEra -> Gen.choice [ pure TxOutDatumNone - , TxOutDatumHash ScriptDataInConwayEra <$> genHashScriptData + , TxOutDatumHash AlonzoEraOnwardsConway <$> genHashScriptData , TxOutDatumInline BabbageEraOnwardsConway <$> genHashableScriptData ] @@ -1058,9 +1057,6 @@ mkDummyHash = coerce . CRYPTO.hashWithSerialiser @h CBOR.toCBOR genHashScriptData :: Gen (Cardano.Api.Hash ScriptData) genHashScriptData = ScriptDataHash . unsafeMakeSafeHash . mkDummyHash <$> Gen.int (Range.linear 0 10) -genScriptDataSupportedInAlonzoEra :: Gen (ScriptDataSupportedInEra AlonzoEra) -genScriptDataSupportedInAlonzoEra = pure ScriptDataInAlonzoEra - genGovernancePoll :: Gen GovernancePoll genGovernancePoll = GovernancePoll diff --git a/cardano-api/internal/Cardano/Api/Tx.hs b/cardano-api/internal/Cardano/Api/Tx.hs index 76045e873f..3619b60a76 100644 --- a/cardano-api/internal/Cardano/Api/Tx.hs +++ b/cardano-api/internal/Cardano/Api/Tx.hs @@ -449,12 +449,9 @@ getTxBody (ShelleyTx sbe tx') = ShelleyBasedEraShelley -> getShelleyTxBody tx' ShelleyBasedEraAllegra -> getShelleyTxBody tx' ShelleyBasedEraMary -> getShelleyTxBody tx' - ShelleyBasedEraAlonzo -> - getAlonzoTxBody ScriptDataInAlonzoEra TxScriptValiditySupportedInAlonzoEra tx' - ShelleyBasedEraBabbage -> - getAlonzoTxBody ScriptDataInBabbageEra TxScriptValiditySupportedInBabbageEra tx' - ShelleyBasedEraConway -> - getAlonzoTxBody ScriptDataInConwayEra TxScriptValiditySupportedInConwayEra tx' + ShelleyBasedEraAlonzo -> getAlonzoTxBody AlonzoEraOnwardsAlonzo TxScriptValiditySupportedInAlonzoEra tx' + ShelleyBasedEraBabbage -> getAlonzoTxBody AlonzoEraOnwardsBabbage TxScriptValiditySupportedInBabbageEra tx' + ShelleyBasedEraConway -> getAlonzoTxBody AlonzoEraOnwardsConway TxScriptValiditySupportedInConwayEra tx' where getShelleyTxBody :: forall ledgerera. ShelleyLedgerEra era ~ ledgerera @@ -474,11 +471,11 @@ getTxBody (ShelleyTx sbe tx') = getAlonzoTxBody :: forall ledgerera. ShelleyLedgerEra era ~ ledgerera => L.AlonzoEraTx ledgerera - => ScriptDataSupportedInEra era + => AlonzoEraOnwards era -> TxScriptValiditySupportedInEra era -> L.Tx ledgerera -> TxBody era - getAlonzoTxBody scriptDataInEra txScriptValidityInEra tx = + getAlonzoTxBody w txScriptValidityInEra tx = let txBody = tx ^. L.bodyTxL txAuxData = tx ^. L.auxDataTxL scriptWits = tx ^. L.witsTxL . L.scriptTxWitsL @@ -487,7 +484,7 @@ getTxBody (ShelleyTx sbe tx') = isValid = tx ^. L.isValidTxL in ShelleyTxBody sbe txBody (Map.elems scriptWits) - (TxBodyScriptData scriptDataInEra datsWits redeemerWits) + (TxBodyScriptData w datsWits redeemerWits) (strictMaybeToMaybe txAuxData) (TxScriptValidity txScriptValidityInEra (isValidToScriptValidity isValid)) diff --git a/cardano-api/internal/Cardano/Api/TxBody.hs b/cardano-api/internal/Cardano/Api/TxBody.hs index 5a5502f5d0..e02cd038df 100644 --- a/cardano-api/internal/Cardano/Api/TxBody.hs +++ b/cardano-api/internal/Cardano/Api/TxBody.hs @@ -121,7 +121,7 @@ module Cardano.Api.TxBody ( TxMetadataSupportedInEra(..), AuxScriptsSupportedInEra(..), TxExtraKeyWitnessesSupportedInEra(..), - ScriptDataSupportedInEra(..), + AlonzoEraOnwards(..), WithdrawalsSupportedInEra(..), CertificatesSupportedInEra(..), UpdateProposalSupportedInEra(..), @@ -180,6 +180,7 @@ module Cardano.Api.TxBody ( import Cardano.Api.Address import Cardano.Api.Certificate import Cardano.Api.Convenience.Constraints +import Cardano.Api.Eon.AlonzoEraOnwards import Cardano.Api.Eon.BabbageEraOnwards import Cardano.Api.Eon.ByronEraOnly import Cardano.Api.Eon.ByronToAllegraEra @@ -498,10 +499,10 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxTx era) where <*> o .: "value" <*> return TxOutDatumNone <*> return ReferenceScriptNone - ShelleyBasedEraAlonzo -> alonzoTxOutParser ScriptDataInAlonzoEra o + ShelleyBasedEraAlonzo -> alonzoTxOutParser AlonzoEraOnwardsAlonzo o ShelleyBasedEraBabbage -> do - alonzoTxOutInBabbage <- alonzoTxOutParser ScriptDataInBabbageEra o + alonzoTxOutInBabbage <- alonzoTxOutParser AlonzoEraOnwardsBabbage o -- We check for the existence of inline datums inlineDatumHash <- o .:? "inlineDatumhash" @@ -524,7 +525,7 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxTx era) where reconcileBabbage alonzoTxOutInBabbage mInlineDatum mReferenceScript ShelleyBasedEraConway -> do - alonzoTxOutInConway <- alonzoTxOutParser ScriptDataInConwayEra o + alonzoTxOutInConway <- alonzoTxOutParser AlonzoEraOnwardsConway o -- We check for the existence of inline datums inlineDatumHash <- o .:? "inlineDatumhash" @@ -589,8 +590,8 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxTx era) where return $ TxOut addr v finalDat finalRefScript alonzoTxOutParser - :: ScriptDataSupportedInEra era -> Aeson.Object -> Aeson.Parser (TxOut CtxTx era) - alonzoTxOutParser supp o = do + :: AlonzoEraOnwards era -> Aeson.Object -> Aeson.Parser (TxOut CtxTx era) + alonzoTxOutParser w o = do mDatumHash <- o .:? "datumhash" mDatumVal <- o .:? "datum" case (mDatumVal, mDatumHash) of @@ -604,12 +605,12 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxTx era) where Right hashableData -> TxOut <$> o .: "address" <*> o .: "value" - <*> return (TxOutDatumInTx' supp dHash hashableData) + <*> return (TxOutDatumInTx' w dHash hashableData) <*> return ReferenceScriptNone (Nothing, Just dHash) -> TxOut <$> o .: "address" <*> o .: "value" - <*> return (TxOutDatumHash supp dHash) + <*> return (TxOutDatumHash w dHash) <*> return ReferenceScriptNone (Just _dVal, Nothing) -> fail "Only datum JSON was found, this should not be possible." @@ -631,10 +632,10 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxUTxO era) where <*> o .: "value" <*> return TxOutDatumNone <*> return ReferenceScriptNone - ShelleyBasedEraAlonzo -> alonzoTxOutParser ScriptDataInAlonzoEra o + ShelleyBasedEraAlonzo -> alonzoTxOutParser AlonzoEraOnwardsAlonzo o ShelleyBasedEraBabbage -> do - alonzoTxOutInBabbage <- alonzoTxOutParser ScriptDataInBabbageEra o + alonzoTxOutInBabbage <- alonzoTxOutParser AlonzoEraOnwardsBabbage o -- We check for the existence of inline datums inlineDatumHash <- o .:? "inlineDatumhash" @@ -658,7 +659,7 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxUTxO era) where reconcileBabbage alonzoTxOutInBabbage mInlineDatum mReferenceScript ShelleyBasedEraConway -> do - alonzoTxOutInConway <- alonzoTxOutParser ScriptDataInConwayEra o + alonzoTxOutInConway <- alonzoTxOutParser AlonzoEraOnwardsConway o -- We check for the existence of inline datums inlineDatumHash <- o .:? "inlineDatumhash" @@ -717,8 +718,8 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxUTxO era) where return $ TxOut addr v finalDat finalRefScript - alonzoTxOutParser :: ScriptDataSupportedInEra era -> Aeson.Object -> Aeson.Parser (TxOut CtxUTxO era) - alonzoTxOutParser supp o = do + alonzoTxOutParser :: AlonzoEraOnwards era -> Aeson.Object -> Aeson.Parser (TxOut CtxUTxO era) + alonzoTxOutParser w o = do mDatumHash <- o .:? "datumhash" case mDatumHash of Nothing -> TxOut <$> o .: "address" @@ -728,7 +729,7 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxUTxO era) where Just dHash -> TxOut <$> o .: "address" <*> o .: "value" - <*> return (TxOutDatumHash supp dHash) + <*> return (TxOutDatumHash w dHash) <*> return ReferenceScriptNone fromByronTxOut :: Byron.TxOut -> TxOut ctx ByronEra @@ -813,7 +814,7 @@ fromShelleyTxOut sbe ledgerTxOut = do ShelleyBasedEraAlonzo -> TxOut addressInEra txOutValue - (fromAlonzoTxOutDataHash ScriptDataInAlonzoEra datahash) + (fromAlonzoTxOutDataHash AlonzoEraOnwardsAlonzo datahash) ReferenceScriptNone where datahash = ledgerTxOut ^. L.dataHashTxOutL @@ -822,7 +823,7 @@ fromShelleyTxOut sbe ledgerTxOut = do TxOut addressInEra txOutValue (fromBabbageTxOutDatum - ScriptDataInBabbageEra + AlonzoEraOnwardsBabbage BabbageEraOnwardsBabbage datum) (case mRefScript of @@ -837,7 +838,7 @@ fromShelleyTxOut sbe ledgerTxOut = do TxOut addressInEra txOutValue (fromBabbageTxOutDatum - ScriptDataInConwayEra + AlonzoEraOnwardsConway BabbageEraOnwardsConway datum) (case mRefScript of @@ -859,7 +860,7 @@ toAlonzoTxOutDataHash (TxOutDatumHash _ (ScriptDataHash dh)) = SJust dh toAlonzoTxOutDataHash (TxOutDatumInline inlineDatumSupp _sd) = case inlineDatumSupp :: BabbageEraOnwards AlonzoEra of {} -fromAlonzoTxOutDataHash :: ScriptDataSupportedInEra era +fromAlonzoTxOutDataHash :: AlonzoEraOnwards era -> StrictMaybe (L.DataHash StandardCrypto) -> TxOutDatum ctx era fromAlonzoTxOutDataHash _ SNothing = TxOutDatumNone @@ -876,15 +877,15 @@ toBabbageTxOutDatum (TxOutDatumInline _ sd) = scriptDataToInlineDatum sd fromBabbageTxOutDatum :: (L.Era ledgerera, Ledger.EraCrypto ledgerera ~ StandardCrypto) - => ScriptDataSupportedInEra era + => AlonzoEraOnwards era -> BabbageEraOnwards era -> Babbage.Datum ledgerera -> TxOutDatum ctx era fromBabbageTxOutDatum _ _ Babbage.NoDatum = TxOutDatumNone -fromBabbageTxOutDatum supp _ (Babbage.DatumHash dh) = - TxOutDatumHash supp $ ScriptDataHash dh -fromBabbageTxOutDatum _ supp (Babbage.Datum binData) = - TxOutDatumInline supp $ binaryDataToScriptData supp binData +fromBabbageTxOutDatum w _ (Babbage.DatumHash dh) = + TxOutDatumHash w $ ScriptDataHash dh +fromBabbageTxOutDatum _ w (Babbage.Datum binData) = + TxOutDatumInline w $ binaryDataToScriptData w binData @@ -1120,27 +1121,14 @@ extraKeyWitnessesSupportedInEra AlonzoEra = Just ExtraKeyWitnessesInAlonzoEra extraKeyWitnessesSupportedInEra BabbageEra = Just ExtraKeyWitnessesInBabbageEra extraKeyWitnessesSupportedInEra ConwayEra = Just ExtraKeyWitnessesInConwayEra - --- | A representation of whether the era supports script data in transactions. -data ScriptDataSupportedInEra era where - - -- | Script data is supported in transactions in the 'Alonzo' era. - ScriptDataInAlonzoEra :: ScriptDataSupportedInEra AlonzoEra - ScriptDataInBabbageEra :: ScriptDataSupportedInEra BabbageEra - ScriptDataInConwayEra :: ScriptDataSupportedInEra ConwayEra - -deriving instance Eq (ScriptDataSupportedInEra era) -deriving instance Show (ScriptDataSupportedInEra era) - -scriptDataSupportedInEra :: CardanoEra era - -> Maybe (ScriptDataSupportedInEra era) +scriptDataSupportedInEra :: CardanoEra era -> Maybe (AlonzoEraOnwards era) scriptDataSupportedInEra ByronEra = Nothing scriptDataSupportedInEra ShelleyEra = Nothing scriptDataSupportedInEra AllegraEra = Nothing scriptDataSupportedInEra MaryEra = Nothing -scriptDataSupportedInEra AlonzoEra = Just ScriptDataInAlonzoEra -scriptDataSupportedInEra BabbageEra = Just ScriptDataInBabbageEra -scriptDataSupportedInEra ConwayEra = Just ScriptDataInConwayEra +scriptDataSupportedInEra AlonzoEra = Just AlonzoEraOnwardsAlonzo +scriptDataSupportedInEra BabbageEra = Just AlonzoEraOnwardsBabbage +scriptDataSupportedInEra ConwayEra = Just AlonzoEraOnwardsConway -- | A representation of whether the era supports withdrawals from reward @@ -1426,7 +1414,7 @@ data TxOutDatum ctx era where -- | A transaction output that only specifies the hash of the datum, but -- not the full datum value. -- - TxOutDatumHash :: ScriptDataSupportedInEra era + TxOutDatumHash :: AlonzoEraOnwards era -> Hash ScriptData -> TxOutDatum ctx era @@ -1434,7 +1422,7 @@ data TxOutDatum ctx era where -- only be used in the context of the transaction body, and does not occur -- in the UTxO. The UTxO only contains the datum hash. -- - TxOutDatumInTx' :: ScriptDataSupportedInEra era + TxOutDatumInTx' :: AlonzoEraOnwards era -> Hash ScriptData -> HashableScriptData -> TxOutDatum CtxTx era @@ -1453,12 +1441,12 @@ deriving instance Show (TxOutDatum ctx era) instance EraCast (TxOutDatum ctx) where eraCast toEra v = case v of TxOutDatumNone -> pure TxOutDatumNone - TxOutDatumHash (_ :: ScriptDataSupportedInEra fromEra) hash -> + TxOutDatumHash (_ :: AlonzoEraOnwards fromEra) hash -> case scriptDataSupportedInEra toEra of Nothing -> Left $ EraCastError v (cardanoEra @fromEra) toEra Just sDatumsSupported -> Right $ TxOutDatumHash sDatumsSupported hash - TxOutDatumInTx' (_ :: ScriptDataSupportedInEra fromEra) scriptData hash -> + TxOutDatumInTx' (_ :: AlonzoEraOnwards fromEra) scriptData hash -> case scriptDataSupportedInEra toEra of Nothing -> Left $ EraCastError v (cardanoEra @fromEra) toEra Just sDatumsSupported -> @@ -1470,12 +1458,12 @@ instance EraCast (TxOutDatum ctx) where toEra pattern TxOutDatumInTx - :: ScriptDataSupportedInEra era + :: AlonzoEraOnwards era -> HashableScriptData -> TxOutDatum CtxTx era -pattern TxOutDatumInTx s d <- TxOutDatumInTx' s _ d +pattern TxOutDatumInTx w d <- TxOutDatumInTx' w _ d where - TxOutDatumInTx s d = TxOutDatumInTx' s (hashScriptDataBytes d) d + TxOutDatumInTx w d = TxOutDatumInTx' w (hashScriptDataBytes d) d {-# COMPLETE TxOutDatumNone, TxOutDatumHash, TxOutDatumInTx', TxOutDatumInline #-} {-# COMPLETE TxOutDatumNone, TxOutDatumHash, TxOutDatumInTx , TxOutDatumInline #-} @@ -1813,7 +1801,7 @@ data TxBody era where data TxBodyScriptData era where TxBodyNoScriptData :: TxBodyScriptData era - TxBodyScriptData :: ScriptDataSupportedInEra era + TxBodyScriptData :: AlonzoEraOnwards era -> Alonzo.TxDats (ShelleyLedgerEra era) -> Alonzo.Redeemers (ShelleyLedgerEra era) -> TxBodyScriptData era @@ -2728,7 +2716,7 @@ fromLedgerTxOuts sbe body scriptdata = ShelleyBasedEraAlonzo -> [ fromAlonzoTxOut MaryEraOnwardsAlonzo - ScriptDataInAlonzoEra + AlonzoEraOnwardsAlonzo txdatums txout | let txdatums = selectTxDatums scriptdata @@ -2737,7 +2725,7 @@ fromLedgerTxOuts sbe body scriptdata = ShelleyBasedEraBabbage -> [ fromBabbageTxOut MaryEraOnwardsBabbage - ScriptDataInBabbageEra + AlonzoEraOnwardsBabbage BabbageEraOnwardsBabbage txdatums txouts @@ -2748,7 +2736,7 @@ fromLedgerTxOuts sbe body scriptdata = ShelleyBasedEraConway -> [ fromBabbageTxOut MaryEraOnwardsConway - ScriptDataInConwayEra + AlonzoEraOnwardsConway BabbageEraOnwardsConway txdatums txouts @@ -2765,7 +2753,7 @@ fromAlonzoTxOut :: forall era ledgerera. => Ledger.EraCrypto ledgerera ~ StandardCrypto => Ledger.Value ledgerera ~ MaryValue StandardCrypto => MaryEraOnwards era - -> ScriptDataSupportedInEra era + -> AlonzoEraOnwards era -> Map (L.DataHash StandardCrypto) (L.Data ledgerera) -> L.TxOut ledgerera @@ -2776,15 +2764,13 @@ fromAlonzoTxOut multiAssetInEra scriptDataInEra txdatums txOut = (fromAlonzoTxOutDatum scriptDataInEra (txOut ^. L.dataHashTxOutL)) ReferenceScriptNone where - fromAlonzoTxOutDatum :: ScriptDataSupportedInEra era + fromAlonzoTxOutDatum :: AlonzoEraOnwards era -> StrictMaybe (L.DataHash StandardCrypto) -> TxOutDatum CtxTx era - fromAlonzoTxOutDatum _ SNothing = TxOutDatumNone - fromAlonzoTxOutDatum supported (SJust dh) - | Just d <- Map.lookup dh txdatums - = TxOutDatumInTx' supported (ScriptDataHash dh) - (fromAlonzoData d) - | otherwise = TxOutDatumHash supported (ScriptDataHash dh) + fromAlonzoTxOutDatum _ SNothing = TxOutDatumNone + fromAlonzoTxOutDatum w (SJust dh) + | Just d <- Map.lookup dh txdatums = TxOutDatumInTx' w (ScriptDataHash dh) (fromAlonzoData d) + | otherwise = TxOutDatumHash w (ScriptDataHash dh) fromBabbageTxOut :: forall ledgerera era. @@ -2794,7 +2780,7 @@ fromBabbageTxOut => Ledger.EraCrypto ledgerera ~ StandardCrypto => Ledger.Value ledgerera ~ MaryValue StandardCrypto => MaryEraOnwards era - -> ScriptDataSupportedInEra era + -> AlonzoEraOnwards era -> BabbageEraOnwards era -> Map (L.DataHash StandardCrypto) (L.Data ledgerera) @@ -3674,7 +3660,7 @@ makeShelleyTransactionBody sbe@ShelleyBasedEraAlonzo -- & L.networkIdTxBodyL .~ SNothing ) scripts - (TxBodyScriptData ScriptDataInAlonzoEra datums redeemers) + (TxBodyScriptData AlonzoEraOnwardsAlonzo datums redeemers) txAuxData txScriptValidity where @@ -3766,7 +3752,7 @@ makeShelleyTransactionBody sbe@ShelleyBasedEraBabbage -- & L.networkIdTxBodyL .~ SNothing ) scripts - (TxBodyScriptData ScriptDataInBabbageEra + (TxBodyScriptData AlonzoEraOnwardsBabbage datums redeemers) txAuxData txScriptValidity @@ -3867,7 +3853,7 @@ makeShelleyTransactionBody sbe@ShelleyBasedEraConway -- & L.networkIdTxBodyL .~ SNothing ) scripts - (TxBodyScriptData ScriptDataInConwayEra + (TxBodyScriptData AlonzoEraOnwardsConway datums redeemers) txAuxData txScriptValidity diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index c8242038eb..5993880df6 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -357,7 +357,6 @@ module Cardano.Api ( TxMetadataSupportedInEra(..), AuxScriptsSupportedInEra(..), TxExtraKeyWitnessesSupportedInEra(..), - ScriptDataSupportedInEra(..), WithdrawalsSupportedInEra(..), CertificatesSupportedInEra(..), UpdateProposalSupportedInEra(..), From d50df2c6da169fd56a44d3e7e47c1d04f3b295d2 Mon Sep 17 00:00:00 2001 From: John Ky Date: Thu, 21 Sep 2023 22:43:20 +1000 Subject: [PATCH 12/14] New ByronToMaryEra eon --- cardano-api/cardano-api.cabal | 1 + .../Cardano/Api/Eon/ByronToMaryEra.hs | 91 +++++++++++++++++++ cardano-api/src/Cardano/Api.hs | 14 +++ 3 files changed, 106 insertions(+) create mode 100644 cardano-api/internal/Cardano/Api/Eon/ByronToMaryEra.hs diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 908e8428e7..6175cddd57 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -61,6 +61,7 @@ library internal Cardano.Api.Eon.ByronEraOnly Cardano.Api.Eon.ByronToAllegraEra Cardano.Api.Eon.ByronToAlonzoEra + Cardano.Api.Eon.ByronToMaryEra Cardano.Api.Eon.ConwayEraOnwards Cardano.Api.Eon.MaryEraOnwards Cardano.Api.Eon.ShelleyBasedEra diff --git a/cardano-api/internal/Cardano/Api/Eon/ByronToMaryEra.hs b/cardano-api/internal/Cardano/Api/Eon/ByronToMaryEra.hs new file mode 100644 index 0000000000..877bb9add8 --- /dev/null +++ b/cardano-api/internal/Cardano/Api/Eon/ByronToMaryEra.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilies #-} + +module Cardano.Api.Eon.ByronToMaryEra + ( ByronToMaryEra(..) + , IsByronToMaryEra(..) + , AnyByronToMaryEra(..) + , byronToMaryEraConstraints + , byronToMaryEraToCardanoEra + + , ByronToMaryEraConstraints + ) where + +import Cardano.Api.Eras.Core + +import Data.Typeable (Typeable) + +class IsByronToMaryEra era where + byronToMaryEra :: ByronToMaryEra era + +data ByronToMaryEra era where + ByronToMaryEraByron :: ByronToMaryEra ByronEra + ByronToMaryEraShelley :: ByronToMaryEra ShelleyEra + ByronToMaryEraAllegra :: ByronToMaryEra AllegraEra + ByronToMaryEraMary :: ByronToMaryEra MaryEra + +deriving instance Show (ByronToMaryEra era) +deriving instance Eq (ByronToMaryEra era) + +instance IsByronToMaryEra ByronEra where + byronToMaryEra = ByronToMaryEraByron + +instance IsByronToMaryEra ShelleyEra where + byronToMaryEra = ByronToMaryEraShelley + +instance IsByronToMaryEra AllegraEra where + byronToMaryEra = ByronToMaryEraAllegra + +instance IsByronToMaryEra MaryEra where + byronToMaryEra = ByronToMaryEraMary + +instance Eon ByronToMaryEra where + inEonForEra no yes = \case + ByronEra -> yes ByronToMaryEraByron + ShelleyEra -> yes ByronToMaryEraShelley + AllegraEra -> yes ByronToMaryEraAllegra + MaryEra -> yes ByronToMaryEraMary + AlonzoEra -> no + BabbageEra -> no + ConwayEra -> no + +instance ToCardanoEra ByronToMaryEra where + toCardanoEra = \case + ByronToMaryEraByron -> ByronEra + ByronToMaryEraShelley -> ShelleyEra + ByronToMaryEraAllegra -> AllegraEra + ByronToMaryEraMary -> MaryEra + +type ByronToMaryEraConstraints era = + ( IsCardanoEra era + , IsByronToMaryEra era + , Typeable era + ) + +data AnyByronToMaryEra where + AnyByronToMaryEra :: ByronToMaryEra era -> AnyByronToMaryEra + +deriving instance Show AnyByronToMaryEra + +byronToMaryEraConstraints :: () + => ByronToMaryEra era + -> (ByronToMaryEraConstraints era => a) + -> a +byronToMaryEraConstraints = \case + ByronToMaryEraByron -> id + ByronToMaryEraShelley -> id + ByronToMaryEraAllegra -> id + ByronToMaryEraMary -> id + +byronToMaryEraToCardanoEra :: ByronToMaryEra era -> CardanoEra era +byronToMaryEraToCardanoEra = \case + ByronToMaryEraByron -> ByronEra + ByronToMaryEraShelley -> ShelleyEra + ByronToMaryEraAllegra -> AllegraEra + ByronToMaryEraMary -> MaryEra diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 5993880df6..b8dceae61e 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -54,6 +54,18 @@ module Cardano.Api ( byronToAllegraEraConstraints, byronToAllegraEraToCardanoEra, + ByronToMaryEra(..), + IsByronToMaryEra(..), + AnyByronToMaryEra(..), + byronToMaryEraConstraints, + byronToMaryEraToCardanoEra, + + ByronToAlonzoEra(..), + IsByronToAlonzoEra(..), + AnyByronToAlonzoEra(..), + byronToAlonzoEraConstraints, + byronToAlonzoEraToCardanoEra, + ShelleyToBabbageEra(..), AnyShelleyToBabbageEra(..), shelleyToBabbageEraConstraints, @@ -1012,6 +1024,8 @@ import Cardano.Api.Eon.AlonzoEraOnwards import Cardano.Api.Eon.BabbageEraOnwards import Cardano.Api.Eon.ByronEraOnly import Cardano.Api.Eon.ByronToAllegraEra +import Cardano.Api.Eon.ByronToAlonzoEra +import Cardano.Api.Eon.ByronToMaryEra import Cardano.Api.Eon.ConwayEraOnwards import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Eon.ShelleyToAllegraEra From fb45cf541512ff79880864d7a60905c2679b314a Mon Sep 17 00:00:00 2001 From: John Ky Date: Thu, 21 Sep 2023 17:40:45 +1000 Subject: [PATCH 13/14] Delete commented out code --- cardano-api/internal/Cardano/Api/TxBody.hs | 33 ---------------------- 1 file changed, 33 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/TxBody.hs b/cardano-api/internal/Cardano/Api/TxBody.hs index e02cd038df..1d45ecdbd7 100644 --- a/cardano-api/internal/Cardano/Api/TxBody.hs +++ b/cardano-api/internal/Cardano/Api/TxBody.hs @@ -917,39 +917,6 @@ collateralSupportedInEra AlonzoEra = Just CollateralInAlonzoEra collateralSupportedInEra BabbageEra = Just CollateralInBabbageEra collateralSupportedInEra ConwayEra = Just CollateralInConwayEra --- TxFeesExplicitInShelleyEra :: TxFeesExplicitInEra ShelleyEra --- TxFeesExplicitInAllegraEra :: TxFeesExplicitInEra AllegraEra --- TxFeesExplicitInMaryEra :: TxFeesExplicitInEra MaryEra --- TxFeesExplicitInAlonzoEra :: TxFeesExplicitInEra AlonzoEra --- TxFeesExplicitInBabbageEra :: TxFeesExplicitInEra BabbageEra --- TxFeesExplicitInConwayEra :: TxFeesExplicitInEra ConwayEra - --- deriving instance Eq (TxFeesExplicitInEra era) --- deriving instance Show (TxFeesExplicitInEra era) - --- -- | A representation of whether the era requires implicitly specified fees in --- -- transactions. --- -- --- -- This is the negation of 'TxFeesExplicitInEra'. --- -- --- data TxFeesImplicitInEra era where --- TxFeesImplicitInByronEra :: TxFeesImplicitInEra ByronEra - --- deriving instance Eq (TxFeesImplicitInEra era) --- deriving instance Show (TxFeesImplicitInEra era) - --- txFeesExplicitInEra :: CardanoEra era --- -> Either (TxFeesImplicitInEra era) --- (TxFeesExplicitInEra era) --- txFeesExplicitInEra ByronEra = Left TxFeesImplicitInByronEra --- txFeesExplicitInEra ShelleyEra = Right TxFeesExplicitInShelleyEra --- txFeesExplicitInEra AllegraEra = Right TxFeesExplicitInAllegraEra --- txFeesExplicitInEra MaryEra = Right TxFeesExplicitInMaryEra --- txFeesExplicitInEra AlonzoEra = Right TxFeesExplicitInAlonzoEra --- txFeesExplicitInEra BabbageEra = Right TxFeesExplicitInBabbageEra --- txFeesExplicitInEra ConwayEra = Right TxFeesExplicitInConwayEra - - -- | A representation of whether the era supports transactions with an upper -- bound on the range of slots in which they are valid. -- From 6c802c1cbc86546c4bb740c7e1240c252e276693 Mon Sep 17 00:00:00 2001 From: John Ky Date: Thu, 21 Sep 2023 23:08:26 +1000 Subject: [PATCH 14/14] Delete scriptDataSupportedInEra. Use caseByronToMaryOrAlonzoEraOnwards or forEraInEon instead. --- cardano-api/internal/Cardano/Api/Eras.hs | 1 + cardano-api/internal/Cardano/Api/Eras/Case.hs | 16 ++++++ cardano-api/internal/Cardano/Api/TxBody.hs | 56 ++++++++----------- cardano-api/src/Cardano/Api.hs | 2 +- 4 files changed, 42 insertions(+), 33 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/Eras.hs b/cardano-api/internal/Cardano/Api/Eras.hs index fc9e9be447..161676164f 100644 --- a/cardano-api/internal/Cardano/Api/Eras.hs +++ b/cardano-api/internal/Cardano/Api/Eras.hs @@ -38,6 +38,7 @@ module Cardano.Api.Eras -- ** Case on ShelleyBasedEra , caseByronToAllegraOrMaryEraOnwards + , caseByronToMaryOrAlonzoEraOnwards , caseByronToAlonzoOrBabbageEraOnwards , caseShelleyToAllegraOrMaryEraOnwards , caseShelleyToMaryOrAlonzoEraOnwards diff --git a/cardano-api/internal/Cardano/Api/Eras/Case.hs b/cardano-api/internal/Cardano/Api/Eras/Case.hs index ea0d2f1a6d..5f3e716f90 100644 --- a/cardano-api/internal/Cardano/Api/Eras/Case.hs +++ b/cardano-api/internal/Cardano/Api/Eras/Case.hs @@ -8,6 +8,7 @@ module Cardano.Api.Eras.Case ( -- Case on CardanoEra caseByronOrShelleyBasedEra , caseByronToAllegraOrMaryEraOnwards + , caseByronToMaryOrAlonzoEraOnwards , caseByronToAlonzoOrBabbageEraOnwards -- Case on ShelleyBasedEra @@ -27,6 +28,7 @@ import Cardano.Api.Eon.BabbageEraOnwards import Cardano.Api.Eon.ByronEraOnly import Cardano.Api.Eon.ByronToAllegraEra import Cardano.Api.Eon.ByronToAlonzoEra +import Cardano.Api.Eon.ByronToMaryEra import Cardano.Api.Eon.ConwayEraOnwards import Cardano.Api.Eon.MaryEraOnwards import Cardano.Api.Eon.ShelleyBasedEra @@ -65,6 +67,20 @@ caseByronToAllegraOrMaryEraOnwards l r = \case BabbageEra -> r MaryEraOnwardsBabbage ConwayEra -> r MaryEraOnwardsConway +caseByronToMaryOrAlonzoEraOnwards :: () + => (ByronToMaryEraConstraints era => ByronToMaryEra era -> a) + -> (AlonzoEraOnwardsConstraints era => AlonzoEraOnwards era -> a) + -> CardanoEra era + -> a +caseByronToMaryOrAlonzoEraOnwards l r = \case + ByronEra -> l ByronToMaryEraByron + ShelleyEra -> l ByronToMaryEraShelley + AllegraEra -> l ByronToMaryEraAllegra + MaryEra -> l ByronToMaryEraMary + AlonzoEra -> r AlonzoEraOnwardsAlonzo + BabbageEra -> r AlonzoEraOnwardsBabbage + ConwayEra -> r AlonzoEraOnwardsConway + caseByronToAlonzoOrBabbageEraOnwards :: () => (ByronToAlonzoEraConstraints era => ByronToAlonzoEra era -> a) -> (BabbageEraOnwardsConstraints era => BabbageEraOnwards era -> a) diff --git a/cardano-api/internal/Cardano/Api/TxBody.hs b/cardano-api/internal/Cardano/Api/TxBody.hs index 1d45ecdbd7..b02f2bcec7 100644 --- a/cardano-api/internal/Cardano/Api/TxBody.hs +++ b/cardano-api/internal/Cardano/Api/TxBody.hs @@ -135,7 +135,6 @@ module Cardano.Api.TxBody ( txMetadataSupportedInEra, auxScriptsSupportedInEra, extraKeyWitnessesSupportedInEra, - scriptDataSupportedInEra, withdrawalsSupportedInEra, certificatesSupportedInEra, updateProposalSupportedInEra, @@ -188,9 +187,9 @@ import Cardano.Api.Eon.ConwayEraOnwards import Cardano.Api.Eon.MaryEraOnwards import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.EraCast -import Cardano.Api.Eras import Cardano.Api.Eras.Case import Cardano.Api.Eras.Constraints +import Cardano.Api.Eras.Core import Cardano.Api.Error import Cardano.Api.Feature import Cardano.Api.Governance.Actions.ProposalProcedure @@ -1088,15 +1087,6 @@ extraKeyWitnessesSupportedInEra AlonzoEra = Just ExtraKeyWitnessesInAlonzoEra extraKeyWitnessesSupportedInEra BabbageEra = Just ExtraKeyWitnessesInBabbageEra extraKeyWitnessesSupportedInEra ConwayEra = Just ExtraKeyWitnessesInConwayEra -scriptDataSupportedInEra :: CardanoEra era -> Maybe (AlonzoEraOnwards era) -scriptDataSupportedInEra ByronEra = Nothing -scriptDataSupportedInEra ShelleyEra = Nothing -scriptDataSupportedInEra AllegraEra = Nothing -scriptDataSupportedInEra MaryEra = Nothing -scriptDataSupportedInEra AlonzoEra = Just AlonzoEraOnwardsAlonzo -scriptDataSupportedInEra BabbageEra = Just AlonzoEraOnwardsBabbage -scriptDataSupportedInEra ConwayEra = Just AlonzoEraOnwardsConway - -- | A representation of whether the era supports withdrawals from reward -- accounts. @@ -1408,16 +1398,16 @@ deriving instance Show (TxOutDatum ctx era) instance EraCast (TxOutDatum ctx) where eraCast toEra v = case v of TxOutDatumNone -> pure TxOutDatumNone - TxOutDatumHash (_ :: AlonzoEraOnwards fromEra) hash -> - case scriptDataSupportedInEra toEra of - Nothing -> Left $ EraCastError v (cardanoEra @fromEra) toEra - Just sDatumsSupported -> - Right $ TxOutDatumHash sDatumsSupported hash - TxOutDatumInTx' (_ :: AlonzoEraOnwards fromEra) scriptData hash -> - case scriptDataSupportedInEra toEra of - Nothing -> Left $ EraCastError v (cardanoEra @fromEra) toEra - Just sDatumsSupported -> - Right $ TxOutDatumInTx' sDatumsSupported scriptData hash + TxOutDatumHash ws hash -> + caseByronToMaryOrAlonzoEraOnwards + (const (Left $ EraCastError v (alonzoEraOnwardsToCardanoEra ws) toEra)) + (\wt -> Right $ TxOutDatumHash wt hash) + toEra + TxOutDatumInTx' ws scriptData hash -> + caseByronToMaryOrAlonzoEraOnwards + (const (Left $ EraCastError v (alonzoEraOnwardsToCardanoEra ws) toEra)) + (\wt -> Right $ TxOutDatumInTx' wt scriptData hash) + toEra TxOutDatumInline ws scriptData -> caseByronToAlonzoOrBabbageEraOnwards (const (Left $ EraCastError v (babbageEraOnwardsToCardanoEra ws) toEra)) @@ -2095,13 +2085,14 @@ deserialiseShelleyBasedTxBody sbe bs = (flip CBOR.runAnnotator fbs (return $ TxScriptValidity sValiditySupported scriptValidity)) 6 -> do sDataSupported <- - case scriptDataSupportedInEra (shelleyBasedToCardanoEra sbe) of - Nothing -> fail $ mconcat - [ "deserialiseShelleyBasedTxBody: Expected an era that supports script" - , " data but got: " - , show sbe - ] - Just supported -> return supported + forEraInEon (shelleyBasedToCardanoEra sbe) + ( fail $ mconcat + [ "deserialiseShelleyBasedTxBody: Expected an era that supports script" + , " data but got: " + , show sbe + ] + ) + pure sValiditySupported <- case txScriptValiditySupportedInShelleyBasedEra sbe of @@ -3369,9 +3360,9 @@ convScriptData -> [(ScriptWitnessIndex, AnyScriptWitness era)] -> TxBodyScriptData era convScriptData era txOuts scriptWitnesses = - case scriptDataSupportedInEra era of - Nothing -> TxBodyNoScriptData - Just scriptDataInEra -> + forEraInEon era + TxBodyNoScriptData + (\w -> let redeemers = Alonzo.Redeemers $ Map.fromList @@ -3394,7 +3385,8 @@ convScriptData era txOuts scriptWitnesses = (PlutusScriptWitness _ _ _ (ScriptDatumForTxIn d) _ _)) <- scriptWitnesses ] - in TxBodyScriptData scriptDataInEra datums redeemers + in TxBodyScriptData w datums redeemers + ) convPParamsToScriptIntegrityHash :: () => ShelleyBasedEra era diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index b8dceae61e..ae02ab5092 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -132,6 +132,7 @@ module Cardano.Api ( -- ** Case on ShelleyBasedEra caseByronToAllegraOrMaryEraOnwards, + caseByronToMaryOrAlonzoEraOnwards, caseByronToAlonzoOrBabbageEraOnwards, caseShelleyToAllegraOrMaryEraOnwards, caseShelleyToMaryOrAlonzoEraOnwards, @@ -385,7 +386,6 @@ module Cardano.Api ( withdrawalsSupportedInEra, certificatesSupportedInEra, updateProposalSupportedInEra, - scriptDataSupportedInEra, totalAndReturnCollateralSupportedInEra, -- ** Era-dependent protocol features