diff --git a/.changes/20260720_remove_byrontoalonzoera_eon.yml b/.changes/20260720_remove_byrontoalonzoera_eon.yml new file mode 100644 index 0000000000..3222018e70 --- /dev/null +++ b/.changes/20260720_remove_byrontoalonzoera_eon.yml @@ -0,0 +1,5 @@ +project: cardano-api +pr: 1260 +kind: + - breaking +description: Remove the unused `ByronToAlonzoEra` eon (the `Cardano.Api.Era.Internal.Eon.ByronToAlonzoEra` module and its `Cardano.Api.Era` re-export); it had no consumers, and the same era-gating is available via `forEraInEon`/`inEonForEra` on `toCardanoEra era`. diff --git a/.changes/20260720_remove_closed_range_eons.yml b/.changes/20260720_remove_closed_range_eons.yml new file mode 100644 index 0000000000..ae922f1af1 --- /dev/null +++ b/.changes/20260720_remove_closed_range_eons.yml @@ -0,0 +1,5 @@ +project: cardano-api +pr: 1260 +kind: + - breaking +description: Remove the closed-range eons `ShelleyToAllegraEra`, `ShelleyToMaryEra` and `ShelleyToAlonzoEra` and their eliminators `caseShelleyToAllegraOrMaryEraOnwards`, `caseShelleyToMaryOrAlonzoEraOnwards` and `caseShelleyToAlonzoOrBabbageEraOnwards`; achieve the same era-gating with `forEraInEon` (or `inEonForEra`) on `toCardanoEra era`, keyed on the surviving `MaryEraOnwards`/`AlonzoEraOnwards`/`BabbageEraOnwards` eon. diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index ba8fa07847..ace0b6c570 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -218,16 +218,12 @@ library Cardano.Api.Era.Internal.Eon.AllegraEraOnwards Cardano.Api.Era.Internal.Eon.AlonzoEraOnwards Cardano.Api.Era.Internal.Eon.BabbageEraOnwards - Cardano.Api.Era.Internal.Eon.ByronToAlonzoEra Cardano.Api.Era.Internal.Eon.Convert Cardano.Api.Era.Internal.Eon.ConwayEraOnwards Cardano.Api.Era.Internal.Eon.MaryEraOnwards Cardano.Api.Era.Internal.Eon.ShelleyBasedEra Cardano.Api.Era.Internal.Eon.ShelleyEraOnly - Cardano.Api.Era.Internal.Eon.ShelleyToAllegraEra - Cardano.Api.Era.Internal.Eon.ShelleyToAlonzoEra Cardano.Api.Era.Internal.Eon.ShelleyToBabbageEra - Cardano.Api.Era.Internal.Eon.ShelleyToMaryEra Cardano.Api.Era.Internal.Feature Cardano.Api.Experimental.Plutus.Internal.IndexedPlutusScriptWitness Cardano.Api.Experimental.Plutus.Internal.Script diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index c7073a99df..c64649af1d 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -560,13 +560,13 @@ genLedgerValueForTxOut sbe = do ada <- A.mkAdaValue sbe . L.Coin <$> Gen.integral (Range.constant 1 2) -- Generate a potentially empty list with multi assets - caseShelleyToAllegraOrMaryEraOnwards - (const (pure ada)) - ( \w -> do + forEraInEon + (toCardanoEra sbe) + (pure ada) + ( \w -> maryEraOnwardsConstraints w $ do v <- Gen.list (Range.constant 0 5) $ genLedgerValue w genAssetId genPositiveQuantity pure $ ada <> mconcat v ) - sbe genLedgerMultiAssetValue :: Gen L.MultiAsset genLedgerMultiAssetValue = Q.arbitrary @@ -1065,9 +1065,10 @@ genTxInsReference :: Applicative (BuildTxWith build) => ShelleyBasedEra era -> Gen (TxInsReference build era) -genTxInsReference = - caseShelleyToAlonzoOrBabbageEraOnwards - (const (pure TxInsReferenceNone)) +genTxInsReference sbe = + forEraInEon + (toCardanoEra sbe) + (pure TxInsReferenceNone) ( \w -> do txIns <- Gen.list (Range.linear 0 10) genTxIn pure $ TxInsReference w txIns mempty diff --git a/cardano-api/src/Cardano/Api/Compatible/Tx.hs b/cardano-api/src/Cardano/Api/Compatible/Tx.hs index 16c24eb9ef..b18ea339e7 100644 --- a/cardano-api/src/Cardano/Api/Compatible/Tx.hs +++ b/cardano-api/src/Cardano/Api/Compatible/Tx.hs @@ -232,15 +232,16 @@ convScriptData' -> [(ScriptWitnessIndex, AnyWitness (ShelleyLedgerEra era))] -> TxBodyScriptData era convScriptData' sbe extraDatums scriptWitnesses = - caseShelleyToMaryOrAlonzoEraOnwards - (const TxBodyNoScriptData) + forEraInEon + (convert sbe) + TxBodyNoScriptData ( \w -> - let redeemers = getAnyPlutusScriptWitnessRedeemerPointerMap w scriptWitnesses - datums = mconcat [getAnyWitnessScriptData wit | (_, wit) <- scriptWitnesses] - supplementalDatums = alonzoEraOnwardsConstraints w $ Alonzo.TxDats extraDatums - in TxBodyScriptData w (datums <> supplementalDatums) redeemers + alonzoEraOnwardsConstraints w $ + let redeemers = getAnyPlutusScriptWitnessRedeemerPointerMap w scriptWitnesses + datums = mconcat [getAnyWitnessScriptData wit | (_, wit) <- scriptWitnesses] + supplementalDatums = Alonzo.TxDats extraDatums + in TxBodyScriptData w (datums <> supplementalDatums) redeemers ) - sbe getAnyPlutusScriptWitnessRedeemerPointerMap :: AlonzoEraOnwards era diff --git a/cardano-api/src/Cardano/Api/Era.hs b/cardano-api/src/Cardano/Api/Era.hs index 4655e612b2..8dd13e9c8b 100644 --- a/cardano-api/src/Cardano/Api/Era.hs +++ b/cardano-api/src/Cardano/Api/Era.hs @@ -14,13 +14,9 @@ module Cardano.Api.Era , module Cardano.Api.Era.Internal.Eon.ShelleyBasedEra , module Cardano.Api.Era.Internal.Eon.AllegraEraOnwards , module Cardano.Api.Era.Internal.Eon.BabbageEraOnwards - , module Cardano.Api.Era.Internal.Eon.ByronToAlonzoEra , module Cardano.Api.Era.Internal.Eon.MaryEraOnwards , module Cardano.Api.Era.Internal.Eon.ShelleyEraOnly - , module Cardano.Api.Era.Internal.Eon.ShelleyToAllegraEra - , module Cardano.Api.Era.Internal.Eon.ShelleyToAlonzoEra , module Cardano.Api.Era.Internal.Eon.ShelleyToBabbageEra - , module Cardano.Api.Era.Internal.Eon.ShelleyToMaryEra , module Cardano.Api.Era.Internal.Eon.ConwayEraOnwards , module Cardano.Api.Era.Internal.Eon.AlonzoEraOnwards @@ -69,9 +65,6 @@ module Cardano.Api.Era , caseByronOrShelleyBasedEra -- ** Case on ShelleyBasedEra - , caseShelleyToAllegraOrMaryEraOnwards - , caseShelleyToMaryOrAlonzoEraOnwards - , caseShelleyToAlonzoOrBabbageEraOnwards , caseShelleyToBabbageOrConwayEraOnwards ) where @@ -81,14 +74,10 @@ import Cardano.Api.Era.Internal.Core import Cardano.Api.Era.Internal.Eon.AllegraEraOnwards import Cardano.Api.Era.Internal.Eon.AlonzoEraOnwards import Cardano.Api.Era.Internal.Eon.BabbageEraOnwards -import Cardano.Api.Era.Internal.Eon.ByronToAlonzoEra import Cardano.Api.Era.Internal.Eon.Convert import Cardano.Api.Era.Internal.Eon.ConwayEraOnwards import Cardano.Api.Era.Internal.Eon.MaryEraOnwards import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra import Cardano.Api.Era.Internal.Eon.ShelleyEraOnly -import Cardano.Api.Era.Internal.Eon.ShelleyToAllegraEra -import Cardano.Api.Era.Internal.Eon.ShelleyToAlonzoEra import Cardano.Api.Era.Internal.Eon.ShelleyToBabbageEra -import Cardano.Api.Era.Internal.Eon.ShelleyToMaryEra import Cardano.Api.Era.Internal.Feature diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Case.hs b/cardano-api/src/Cardano/Api/Era/Internal/Case.hs index b72d885ee5..31605ace12 100644 --- a/cardano-api/src/Cardano/Api/Era/Internal/Case.hs +++ b/cardano-api/src/Cardano/Api/Era/Internal/Case.hs @@ -8,25 +8,16 @@ module Cardano.Api.Era.Internal.Case caseByronOrShelleyBasedEra -- Case on ShelleyBasedEra , caseShelleyEraOnlyOrAllegraEraOnwards - , caseShelleyToAllegraOrMaryEraOnwards - , caseShelleyToMaryOrAlonzoEraOnwards - , caseShelleyToAlonzoOrBabbageEraOnwards , caseShelleyToBabbageOrConwayEraOnwards ) where import Cardano.Api.Era.Internal.Core import Cardano.Api.Era.Internal.Eon.AllegraEraOnwards -import Cardano.Api.Era.Internal.Eon.AlonzoEraOnwards -import Cardano.Api.Era.Internal.Eon.BabbageEraOnwards import Cardano.Api.Era.Internal.Eon.ConwayEraOnwards -import Cardano.Api.Era.Internal.Eon.MaryEraOnwards import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra import Cardano.Api.Era.Internal.Eon.ShelleyEraOnly -import Cardano.Api.Era.Internal.Eon.ShelleyToAllegraEra -import Cardano.Api.Era.Internal.Eon.ShelleyToAlonzoEra import Cardano.Api.Era.Internal.Eon.ShelleyToBabbageEra -import Cardano.Api.Era.Internal.Eon.ShelleyToMaryEra -- | @caseByronOrShelleyBasedEra f g era@ returns @f@ in Byron and applies @g@ to Shelley-based eras. caseByronOrShelleyBasedEra @@ -64,57 +55,6 @@ caseShelleyEraOnlyOrAllegraEraOnwards l r = \case ShelleyBasedEraConway -> r AllegraEraOnwardsConway ShelleyBasedEraDijkstra -> error "TODO Dijkstra: caseShelleyEraOnlyOrAllegraEraOnwards: era not supported" --- | @caseShelleyToAllegraOrMaryEraOnwards f g era@ applies @f@ to shelley and allegra; --- and applies @g@ to mary and later eras. -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 - ShelleyBasedEraDijkstra -> error "TODO Dijkstra: caseShelleyToAllegraOrMaryEraOnwards: era not supported" - --- | @caseShelleyToMaryOrAlonzoEraOnwards f g era@ applies @f@ to shelley, allegra, and mary; --- and applies @g@ to alonzo and later eras. -caseShelleyToMaryOrAlonzoEraOnwards - :: () - => (ShelleyToMaryEraConstraints era => ShelleyToMaryEra era -> a) - -> (AlonzoEraOnwardsConstraints era => AlonzoEraOnwards era -> a) - -> ShelleyBasedEra era - -> a -caseShelleyToMaryOrAlonzoEraOnwards l r = \case - ShelleyBasedEraShelley -> l ShelleyToMaryEraShelley - ShelleyBasedEraAllegra -> l ShelleyToMaryEraAllegra - ShelleyBasedEraMary -> l ShelleyToMaryEraMary - ShelleyBasedEraAlonzo -> r AlonzoEraOnwardsAlonzo - ShelleyBasedEraBabbage -> r AlonzoEraOnwardsBabbage - ShelleyBasedEraConway -> r AlonzoEraOnwardsConway - ShelleyBasedEraDijkstra -> error "TODO Dijkstra: caseShelleyToMaryOrAlonzoEraOnwards: era not supported" - --- | @caseShelleyToAlonzoOrBabbageEraOnwards f g era@ applies @f@ to shelley, allegra, mary, and alonzo; --- and applies @g@ to babbage and later eras. -caseShelleyToAlonzoOrBabbageEraOnwards - :: () - => (ShelleyToAlonzoEraConstraints era => ShelleyToAlonzoEra era -> a) - -> (BabbageEraOnwardsConstraints era => BabbageEraOnwards era -> a) - -> ShelleyBasedEra era - -> a -caseShelleyToAlonzoOrBabbageEraOnwards l r = \case - ShelleyBasedEraShelley -> l ShelleyToAlonzoEraShelley - ShelleyBasedEraAllegra -> l ShelleyToAlonzoEraAllegra - ShelleyBasedEraMary -> l ShelleyToAlonzoEraMary - ShelleyBasedEraAlonzo -> l ShelleyToAlonzoEraAlonzo - ShelleyBasedEraBabbage -> r BabbageEraOnwardsBabbage - ShelleyBasedEraConway -> r BabbageEraOnwardsConway - ShelleyBasedEraDijkstra -> error "TODO Dijkstra: caseShelleyToAlonzoOrBabbageEraOnwards: era not supported" - -- | @caseShelleyToBabbageOrConwayEraOnwards f g era@ applies @f@ to eras before conway; -- and applies @g@ to conway and later eras. caseShelleyToBabbageOrConwayEraOnwards diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ByronToAlonzoEra.hs b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ByronToAlonzoEra.hs deleted file mode 100644 index 318ea303df..0000000000 --- a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ByronToAlonzoEra.hs +++ /dev/null @@ -1,71 +0,0 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TypeFamilies #-} - -module Cardano.Api.Era.Internal.Eon.ByronToAlonzoEra - ( ByronToAlonzoEra (..) - , byronToAlonzoEraConstraints - , ByronToAlonzoEraConstraints - ) -where - -import Cardano.Api.Era.Internal.Core -import Cardano.Api.Era.Internal.Eon.Convert - -import Data.Typeable (Typeable) - -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 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 - DijkstraEra -> no - -instance ToCardanoEra ByronToAlonzoEra where - toCardanoEra = \case - ByronToAlonzoEraByron -> ByronEra - ByronToAlonzoEraShelley -> ShelleyEra - ByronToAlonzoEraAllegra -> AllegraEra - ByronToAlonzoEraMary -> MaryEra - ByronToAlonzoEraAlonzo -> AlonzoEra - -instance Convert ByronToAlonzoEra CardanoEra where - convert = toCardanoEra - -type ByronToAlonzoEraConstraints era = - ( IsCardanoEra era - , Typeable era - ) - -byronToAlonzoEraConstraints - :: () - => ByronToAlonzoEra era - -> (ByronToAlonzoEraConstraints era => a) - -> a -byronToAlonzoEraConstraints = \case - ByronToAlonzoEraByron -> id - ByronToAlonzoEraShelley -> id - ByronToAlonzoEraAllegra -> id - ByronToAlonzoEraMary -> id - ByronToAlonzoEraAlonzo -> id diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToAllegraEra.hs b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToAllegraEra.hs deleted file mode 100644 index 8ddbade962..0000000000 --- a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToAllegraEra.hs +++ /dev/null @@ -1,114 +0,0 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} - -module Cardano.Api.Era.Internal.Eon.ShelleyToAllegraEra - ( ShelleyToAllegraEra (..) - , shelleyToAllegraEraConstraints - , ShelleyToAllegraEraConstraints - ) -where - -import Cardano.Api.Consensus.Internal.Mode -import Cardano.Api.Era.Internal.Core -import Cardano.Api.Era.Internal.Eon.Convert -import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra -import Cardano.Api.Query.Internal.Type.DebugLedgerState - -import Cardano.Binary -import Cardano.Crypto.Hash.Blake2b qualified as Blake2b -import Cardano.Crypto.Hash.Class qualified as C -import Cardano.Crypto.VRF qualified as C -import Cardano.Ledger.Api qualified as L -import Cardano.Ledger.BaseTypes qualified as L -import Cardano.Ledger.Coin qualified as L -import Cardano.Ledger.Core qualified as L -import Cardano.Ledger.Shelley.TxCert qualified as L -import Cardano.Ledger.State qualified as L -import Cardano.Protocol.Crypto qualified as L -import Ouroboros.Consensus.Protocol.Abstract qualified as Consensus -import Ouroboros.Consensus.Protocol.Praos.Common qualified as Consensus -import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus - -import Data.Aeson -import Data.Type.Equality -import Data.Typeable (Typeable) - -data ShelleyToAllegraEra era where - ShelleyToAllegraEraShelley :: ShelleyToAllegraEra ShelleyEra - ShelleyToAllegraEraAllegra :: ShelleyToAllegraEra AllegraEra - -deriving instance Show (ShelleyToAllegraEra era) - -deriving instance Eq (ShelleyToAllegraEra era) - -instance Eon ShelleyToAllegraEra where - inEonForEra no yes = \case - ByronEra -> no - ShelleyEra -> yes ShelleyToAllegraEraShelley - AllegraEra -> yes ShelleyToAllegraEraAllegra - MaryEra -> no - AlonzoEra -> no - BabbageEra -> no - ConwayEra -> no - DijkstraEra -> no - -instance ToCardanoEra ShelleyToAllegraEra where - toCardanoEra = \case - ShelleyToAllegraEraShelley -> ShelleyEra - ShelleyToAllegraEraAllegra -> AllegraEra - -instance Convert ShelleyToAllegraEra CardanoEra where - convert = toCardanoEra - -instance Convert ShelleyToAllegraEra ShelleyBasedEra where - convert = \case - ShelleyToAllegraEraShelley -> ShelleyBasedEraShelley - ShelleyToAllegraEraAllegra -> ShelleyBasedEraAllegra - -type ShelleyToAllegraEraConstraints era = - ( C.HashAlgorithm L.HASH - , C.Signable (L.VRF L.StandardCrypto) L.Seed - , Consensus.PraosProtocolSupportsNode (ConsensusProtocol era) - , Consensus.ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era) ~ ConsensusBlockForEra era - , Consensus.ShelleyCompatible (ConsensusProtocol era) (ShelleyLedgerEra era) - , L.ADDRHASH ~ Blake2b.Blake2b_224 - , L.Era (ShelleyLedgerEra era) - , L.EraPParams (ShelleyLedgerEra era) - , L.EraTx (ShelleyLedgerEra era) - , L.EraTxBody (ShelleyLedgerEra era) - , L.EraTxOut (ShelleyLedgerEra era) - , L.EraUTxO (ShelleyLedgerEra era) - , L.HashAnnotated (L.TxBody L.TopTx (ShelleyLedgerEra era)) L.EraIndependentTxBody - , L.ProtVerAtMost (ShelleyLedgerEra era) 4 - , L.ProtVerAtMost (ShelleyLedgerEra era) 6 - , L.ProtVerAtMost (ShelleyLedgerEra era) 8 - , 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) - , IsCardanoEra era - , IsShelleyBasedEra era - , ToJSON (Consensus.ChainDepState (ConsensusProtocol era)) - , ToJSON (DebugLedgerState era) - , Typeable era - , (era == ByronEra) ~ False - ) - -shelleyToAllegraEraConstraints - :: () - => ShelleyToAllegraEra era - -> (ShelleyToAllegraEraConstraints era => a) - -> a -shelleyToAllegraEraConstraints = \case - ShelleyToAllegraEraShelley -> id - ShelleyToAllegraEraAllegra -> id diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToAlonzoEra.hs b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToAlonzoEra.hs deleted file mode 100644 index df9f1eba90..0000000000 --- a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToAlonzoEra.hs +++ /dev/null @@ -1,121 +0,0 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} - -module Cardano.Api.Era.Internal.Eon.ShelleyToAlonzoEra - ( ShelleyToAlonzoEra (..) - , shelleyToAlonzoEraConstraints - , shelleyToAlonzoEraToShelleyBasedEra - , ShelleyToAlonzoEraConstraints - ) -where - -import Cardano.Api.Consensus.Internal.Mode -import Cardano.Api.Era.Internal.Core -import Cardano.Api.Era.Internal.Eon.Convert -import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra -import Cardano.Api.Query.Internal.Type.DebugLedgerState - -import Cardano.Binary -import Cardano.Crypto.Hash.Blake2b qualified as Blake2b -import Cardano.Crypto.Hash.Class qualified as C -import Cardano.Crypto.VRF qualified as C -import Cardano.Ledger.Api qualified as L -import Cardano.Ledger.BaseTypes qualified as L -import Cardano.Ledger.Core qualified as L -import Cardano.Ledger.Shelley.TxCert qualified as L -import Cardano.Protocol.Crypto qualified as L -import Ouroboros.Consensus.Protocol.Abstract qualified as Consensus -import Ouroboros.Consensus.Protocol.Praos.Common qualified as Consensus -import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus - -import Data.Aeson -import Data.Type.Equality -import Data.Typeable (Typeable) - -data ShelleyToAlonzoEra era where - ShelleyToAlonzoEraShelley :: ShelleyToAlonzoEra ShelleyEra - ShelleyToAlonzoEraAllegra :: ShelleyToAlonzoEra AllegraEra - ShelleyToAlonzoEraMary :: ShelleyToAlonzoEra MaryEra - ShelleyToAlonzoEraAlonzo :: ShelleyToAlonzoEra AlonzoEra - -deriving instance Show (ShelleyToAlonzoEra era) - -deriving instance Eq (ShelleyToAlonzoEra era) - -instance Eon ShelleyToAlonzoEra where - inEonForEra no yes = \case - ByronEra -> no - ShelleyEra -> yes ShelleyToAlonzoEraShelley - AllegraEra -> yes ShelleyToAlonzoEraAllegra - MaryEra -> yes ShelleyToAlonzoEraMary - AlonzoEra -> yes ShelleyToAlonzoEraAlonzo - BabbageEra -> no - ConwayEra -> no - DijkstraEra -> no - -instance ToCardanoEra ShelleyToAlonzoEra where - toCardanoEra = \case - ShelleyToAlonzoEraShelley -> ShelleyEra - ShelleyToAlonzoEraAllegra -> AllegraEra - ShelleyToAlonzoEraMary -> MaryEra - ShelleyToAlonzoEraAlonzo -> AlonzoEra - -instance Convert ShelleyToAlonzoEra CardanoEra where - convert = toCardanoEra - -instance Convert ShelleyToAlonzoEra ShelleyBasedEra where - convert = \case - ShelleyToAlonzoEraShelley -> ShelleyBasedEraShelley - ShelleyToAlonzoEraAllegra -> ShelleyBasedEraAllegra - ShelleyToAlonzoEraMary -> ShelleyBasedEraMary - ShelleyToAlonzoEraAlonzo -> ShelleyBasedEraAlonzo - -type ShelleyToAlonzoEraConstraints era = - ( C.HashAlgorithm L.HASH - , C.Signable (L.VRF L.StandardCrypto) L.Seed - , Consensus.PraosProtocolSupportsNode (ConsensusProtocol era) - , Consensus.ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era) ~ ConsensusBlockForEra era - , Consensus.ShelleyCompatible (ConsensusProtocol era) (ShelleyLedgerEra era) - , L.ADDRHASH ~ Blake2b.Blake2b_224 - , L.Era (ShelleyLedgerEra era) - , L.EraPParams (ShelleyLedgerEra era) - , L.EraTx (ShelleyLedgerEra era) - , L.EraTxBody (ShelleyLedgerEra era) - , L.EraTxOut (ShelleyLedgerEra era) - , L.HashAnnotated (L.TxBody L.TopTx (ShelleyLedgerEra era)) L.EraIndependentTxBody - , L.ProtVerAtMost (ShelleyLedgerEra era) 6 - , L.ProtVerAtMost (ShelleyLedgerEra era) 8 - , L.ShelleyEraTxBody (ShelleyLedgerEra era) - , L.ShelleyEraTxCert (ShelleyLedgerEra era) - , L.TxCert (ShelleyLedgerEra era) ~ L.ShelleyTxCert (ShelleyLedgerEra era) - , FromCBOR (Consensus.ChainDepState (ConsensusProtocol era)) - , FromCBOR (DebugLedgerState era) - , IsCardanoEra era - , IsShelleyBasedEra era - , ToJSON (Consensus.ChainDepState (ConsensusProtocol era)) - , ToJSON (DebugLedgerState era) - , Typeable era - , (era == ByronEra) ~ False - ) - -shelleyToAlonzoEraConstraints - :: () - => ShelleyToAlonzoEra era - -> (ShelleyToAlonzoEraConstraints era => a) - -> a -shelleyToAlonzoEraConstraints = \case - ShelleyToAlonzoEraShelley -> id - ShelleyToAlonzoEraAllegra -> id - ShelleyToAlonzoEraMary -> id - ShelleyToAlonzoEraAlonzo -> id - -shelleyToAlonzoEraToShelleyBasedEra :: ShelleyToAlonzoEra era -> ShelleyBasedEra era -shelleyToAlonzoEraToShelleyBasedEra = convert diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToMaryEra.hs b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToMaryEra.hs deleted file mode 100644 index b14d1ed227..0000000000 --- a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyToMaryEra.hs +++ /dev/null @@ -1,115 +0,0 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} - -module Cardano.Api.Era.Internal.Eon.ShelleyToMaryEra - ( ShelleyToMaryEra (..) - , shelleyToMaryEraConstraints - , ShelleyToMaryEraConstraints - ) -where - -import Cardano.Api.Consensus.Internal.Mode -import Cardano.Api.Era.Internal.Core -import Cardano.Api.Era.Internal.Eon.Convert -import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra -import Cardano.Api.Query.Internal.Type.DebugLedgerState - -import Cardano.Binary -import Cardano.Crypto.Hash.Blake2b qualified as Blake2b -import Cardano.Crypto.Hash.Class qualified as C -import Cardano.Crypto.VRF qualified as C -import Cardano.Ledger.Api qualified as L -import Cardano.Ledger.BaseTypes qualified as L -import Cardano.Ledger.Core qualified as L -import Cardano.Ledger.Shelley.TxCert qualified as L -import Cardano.Protocol.Crypto (StandardCrypto) -import Cardano.Protocol.Crypto qualified as L -import Ouroboros.Consensus.Protocol.Abstract qualified as Consensus -import Ouroboros.Consensus.Protocol.Praos.Common qualified as Consensus -import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus - -import Data.Aeson -import Data.Type.Equality -import Data.Typeable (Typeable) - -data ShelleyToMaryEra era where - ShelleyToMaryEraShelley :: ShelleyToMaryEra ShelleyEra - ShelleyToMaryEraAllegra :: ShelleyToMaryEra AllegraEra - ShelleyToMaryEraMary :: ShelleyToMaryEra MaryEra - -deriving instance Show (ShelleyToMaryEra era) - -deriving instance Eq (ShelleyToMaryEra era) - -instance Eon ShelleyToMaryEra where - inEonForEra no yes = \case - ByronEra -> no - ShelleyEra -> yes ShelleyToMaryEraShelley - AllegraEra -> yes ShelleyToMaryEraAllegra - MaryEra -> yes ShelleyToMaryEraMary - AlonzoEra -> no - BabbageEra -> no - ConwayEra -> no - DijkstraEra -> no - -instance ToCardanoEra ShelleyToMaryEra where - toCardanoEra = \case - ShelleyToMaryEraShelley -> ShelleyEra - ShelleyToMaryEraAllegra -> AllegraEra - ShelleyToMaryEraMary -> MaryEra - -instance Convert ShelleyToMaryEra CardanoEra where - convert = toCardanoEra - -instance Convert ShelleyToMaryEra ShelleyBasedEra where - convert = \case - ShelleyToMaryEraShelley -> ShelleyBasedEraShelley - ShelleyToMaryEraAllegra -> ShelleyBasedEraAllegra - ShelleyToMaryEraMary -> ShelleyBasedEraMary - -type ShelleyToMaryEraConstraints era = - ( C.HashAlgorithm L.HASH - , C.Signable (L.VRF StandardCrypto) L.Seed - , Consensus.PraosProtocolSupportsNode (ConsensusProtocol era) - , Consensus.ShelleyBlock (ConsensusProtocol era) (ShelleyLedgerEra era) ~ ConsensusBlockForEra era - , Consensus.ShelleyCompatible (ConsensusProtocol era) (ShelleyLedgerEra era) - , L.ADDRHASH ~ Blake2b.Blake2b_224 - , L.Era (ShelleyLedgerEra era) - , L.EraPParams (ShelleyLedgerEra era) - , L.EraTx (ShelleyLedgerEra era) - , L.EraTxBody (ShelleyLedgerEra era) - , L.EraTxOut (ShelleyLedgerEra era) - , L.HashAnnotated (L.TxBody L.TopTx (ShelleyLedgerEra era)) L.EraIndependentTxBody - , L.ProtVerAtMost (ShelleyLedgerEra era) 4 - , L.ProtVerAtMost (ShelleyLedgerEra era) 6 - , L.ProtVerAtMost (ShelleyLedgerEra era) 8 - , L.ShelleyEraTxBody (ShelleyLedgerEra era) - , L.ShelleyEraTxCert (ShelleyLedgerEra era) - , L.TxCert (ShelleyLedgerEra era) ~ L.ShelleyTxCert (ShelleyLedgerEra era) - , FromCBOR (Consensus.ChainDepState (ConsensusProtocol era)) - , FromCBOR (DebugLedgerState era) - , IsCardanoEra era - , IsShelleyBasedEra era - , ToJSON (Consensus.ChainDepState (ConsensusProtocol era)) - , ToJSON (DebugLedgerState era) - , Typeable era - , (era == ByronEra) ~ False - ) - -shelleyToMaryEraConstraints - :: () - => ShelleyToMaryEra era - -> (ShelleyToMaryEraConstraints era => a) - -> a -shelleyToMaryEraConstraints = \case - ShelleyToMaryEraShelley -> id - ShelleyToMaryEraAllegra -> id - ShelleyToMaryEraMary -> id diff --git a/cardano-api/src/Cardano/Api/LedgerState.hs b/cardano-api/src/Cardano/Api/LedgerState.hs index 5aa05eaefe..ac2fa7d125 100644 --- a/cardano-api/src/Cardano/Api/LedgerState.hs +++ b/cardano-api/src/Cardano/Api/LedgerState.hs @@ -107,7 +107,8 @@ import Cardano.Api.Certificate.Internal import Cardano.Api.Consensus.Internal.Mode import Cardano.Api.Consensus.Internal.Mode qualified as Api import Cardano.Api.Era.Internal.Case -import Cardano.Api.Era.Internal.Core (forEraMaybeEon) +import Cardano.Api.Era.Internal.Core (forEraInEon, forEraMaybeEon, toCardanoEra) +import Cardano.Api.Era.Internal.Eon.BabbageEraOnwards import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra import Cardano.Api.Error as Api import Cardano.Api.Genesis.Internal @@ -2079,12 +2080,17 @@ nextEpochEligibleLeadershipSlots sbe sGen serCurrEpochState ptclState poolid (Vr let previousLabNonce = Consensus.previousLabNonce (Consensus.getPraosNonces (Proxy @(Api.ConsensusProtocol era)) chainDepState) + -- 'ppExtraEntropyL' requires 'ProtVerAtMost 6' (Shelley to Alonzo), evidence + -- that 'forEraInEon' cannot provide in its negative branch, so we match on + -- 'ShelleyBasedEra' directly to obtain it for the pre-Babbage eras. extraEntropy :: Nonce - extraEntropy = - caseShelleyToAlonzoOrBabbageEraOnwards - (const (pp ^. Core.ppExtraEntropyL)) - (const Ledger.NeutralNonce) - sbe + extraEntropy = case sbe of + ShelleyBasedEraShelley -> pp ^. Core.ppExtraEntropyL + ShelleyBasedEraAllegra -> pp ^. Core.ppExtraEntropyL + ShelleyBasedEraMary -> pp ^. Core.ppExtraEntropyL + ShelleyBasedEraAlonzo -> pp ^. Core.ppExtraEntropyL + ShelleyBasedEraBabbage -> Ledger.NeutralNonce + ShelleyBasedEraConway -> Ledger.NeutralNonce nextEpochsNonce = candidateNonce ⭒ previousLabNonce ⭒ extraEntropy @@ -2108,14 +2114,15 @@ nextEpochEligibleLeadershipSlots sbe sGen serCurrEpochState ptclState poolid (Vr (not . Ledger.isOverlaySlot firstSlotOfEpoch (pp' ^. Core.ppDG)) $ fromList [firstSlotOfEpoch .. lastSlotofEpoch] - caseShelleyToAlonzoOrBabbageEraOnwards - ( const - (isLeadingSlotsTPraos (slotRangeOfInterest pp) poolid markSnapshotPoolDistr nextEpochsNonce vrfSkey f) + forEraInEon + (toCardanoEra sbe) + ( shelleyBasedEraConstraints sbe $ + isLeadingSlotsTPraos (slotRangeOfInterest pp) poolid markSnapshotPoolDistr nextEpochsNonce vrfSkey f ) - ( const - (isLeadingSlotsPraos (slotRangeOfInterest pp) poolid markSnapshotPoolDistr nextEpochsNonce vrfSkey f) + ( \w -> + babbageEraOnwardsConstraints w $ + isLeadingSlotsPraos (slotRangeOfInterest pp) poolid markSnapshotPoolDistr nextEpochsNonce vrfSkey f ) - sbe where globals = shelleyBasedEraConstraints sbe $ constructGlobals sGen eInfo @@ -2223,14 +2230,15 @@ currentEpochEligibleLeadershipSlots sbe sGen eInfo pp ptclState poolid (VrfSigni (not . Ledger.isOverlaySlot firstSlotOfEpoch (pp' ^. Core.ppDG)) $ fromList [firstSlotOfEpoch .. lastSlotofEpoch] - caseShelleyToAlonzoOrBabbageEraOnwards - ( const - (isLeadingSlotsTPraos (slotRangeOfInterest pp) poolid setSnapshotPoolDistr epochNonce vrkSkey f) + forEraInEon + (toCardanoEra sbe) + ( shelleyBasedEraConstraints sbe $ + isLeadingSlotsTPraos (slotRangeOfInterest pp) poolid setSnapshotPoolDistr epochNonce vrkSkey f ) - ( const - (isLeadingSlotsPraos (slotRangeOfInterest pp) poolid setSnapshotPoolDistr epochNonce vrkSkey f) + ( \w -> + babbageEraOnwardsConstraints w $ + isLeadingSlotsPraos (slotRangeOfInterest pp) poolid setSnapshotPoolDistr epochNonce vrkSkey f ) - sbe where globals = shelleyBasedEraConstraints sbe $ constructGlobals sGen eInfo diff --git a/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs b/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs index 45c235bc31..06b9a38477 100644 --- a/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs +++ b/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs @@ -121,7 +121,6 @@ module Cardano.Api.Plutus.Internal.Script ) where -import Cardano.Api.Era.Internal.Case import Cardano.Api.Era.Internal.Core import Cardano.Api.Era.Internal.Eon.BabbageEraOnwards import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra @@ -1670,10 +1669,10 @@ instance IsShelleyBasedEra era => ToJSON (ReferenceScript era) where -- entire module in favour of the experimental api is the long term solution to this problem. instance IsShelleyBasedEra era => FromJSON (ReferenceScript era) where parseJSON = Aeson.withObject "ReferenceScript" $ \o -> - caseShelleyToAlonzoOrBabbageEraOnwards - (const (pure ReferenceScriptNone)) + forEraInEon + (toCardanoEra (shelleyBasedEra :: ShelleyBasedEra era)) + (pure ReferenceScriptNone) (\w -> ReferenceScript w <$> o .: "referenceScript") - (shelleyBasedEra :: ShelleyBasedEra era) refScriptToShelleyScript :: ShelleyBasedEra era @@ -1692,10 +1691,10 @@ fromShelleyScriptToReferenceScript sbe script = scriptInEraToRefScript :: ScriptInEra era -> ReferenceScript era scriptInEraToRefScript sIne@(ScriptInEra _ s) = - caseShelleyToAlonzoOrBabbageEraOnwards - (const ReferenceScriptNone) + forEraInEon + (toCardanoEra (eraOfScriptInEra sIne)) + ReferenceScriptNone (\w -> ReferenceScript w $ toScriptInAnyLang s) -- Any script can be a reference script - (eraOfScriptInEra sIne) -- Helpers diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Body.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Body.hs index f70fdd302e..9cd5910c68 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Body.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/Body.hs @@ -1265,17 +1265,18 @@ createTransactionBody createTransactionBody sbe bc = shelleyBasedEraConstraints sbe $ do (sData, mScriptIntegrityHash, scripts) <- - caseShelleyToMaryOrAlonzoEraOnwards - ( \eon -> do + forEraInEon + (convert sbe) + ( do let scripts = catMaybes [ toShelleyScript <$> getScriptWitnessScript scriptwitness | (_, AnyScriptWitness scriptwitness) <- - collectTxBodyScriptWitnesses (convert eon) bc + collectTxBodyScriptWitnesses sbe bc ] return (TxBodyNoScriptData, SNothing, scripts) ) - ( \aeon -> do + ( \aeon -> alonzoEraOnwardsConstraints aeon $ do TxScriptWitnessRequirements languages scripts dats redeemers <- collectTxBodyScriptWitnessRequirements aeon bc @@ -1288,7 +1289,6 @@ createTransactionBody sbe bc = , scripts ) ) - sbe let era = toCardanoEra sbe apiScriptValidity = txScriptValidity bc @@ -1557,48 +1557,57 @@ fromLedgerTxInsCollateral -> Ledger.TxBody Ledger.TopTx (ShelleyLedgerEra era) -> TxInsCollateral era fromLedgerTxInsCollateral sbe body = - caseShelleyToMaryOrAlonzoEraOnwards - (const TxInsCollateralNone) - (\w -> TxInsCollateral w $ map fromShelleyTxIn $ toList $ body ^. L.collateralInputsTxBodyL) - sbe + forEraInEon + (convert sbe) + TxInsCollateralNone + ( \w -> + alonzoEraOnwardsConstraints w $ + TxInsCollateral w $ + map fromShelleyTxIn $ + toList $ + body ^. L.collateralInputsTxBodyL + ) fromLedgerTxInsReference :: ShelleyBasedEra era -> Ledger.TxBody Ledger.TopTx (ShelleyLedgerEra era) -> TxInsReference ViewTx era fromLedgerTxInsReference sbe txBody = - caseShelleyToAlonzoOrBabbageEraOnwards - (const TxInsReferenceNone) - (\w -> TxInsReference w (map fromShelleyTxIn . toList $ txBody ^. L.referenceInputsTxBodyL) ViewTx) - sbe + forEraInEon + (convert sbe) + TxInsReferenceNone + ( \w -> + babbageEraOnwardsConstraints w $ + TxInsReference w (map fromShelleyTxIn . toList $ txBody ^. L.referenceInputsTxBodyL) ViewTx + ) fromLedgerTxTotalCollateral :: ShelleyBasedEra era -> Ledger.TxBody Ledger.TopTx (ShelleyLedgerEra era) -> TxTotalCollateral era fromLedgerTxTotalCollateral sbe txbody = - caseShelleyToAlonzoOrBabbageEraOnwards - (const TxTotalCollateralNone) - ( \w -> + forEraInEon + (convert sbe) + TxTotalCollateralNone + ( \w -> babbageEraOnwardsConstraints w $ case txbody ^. L.totalCollateralTxBodyL of SNothing -> TxTotalCollateralNone SJust totColl -> TxTotalCollateral w totColl ) - sbe fromLedgerTxReturnCollateral :: ShelleyBasedEra era -> Ledger.TxBody Ledger.TopTx (ShelleyLedgerEra era) -> TxReturnCollateral CtxTx era fromLedgerTxReturnCollateral sbe txbody = - caseShelleyToAlonzoOrBabbageEraOnwards - (const TxReturnCollateralNone) - ( \w -> + forEraInEon + (convert sbe) + TxReturnCollateralNone + ( \w -> babbageEraOnwardsConstraints w $ case txbody ^. L.collateralReturnTxBodyL of SNothing -> TxReturnCollateralNone SJust collReturnOut -> TxReturnCollateral w $ fromShelleyTxOut sbe collReturnOut ) - sbe fromLedgerTxFee :: ShelleyBasedEra era -> Ledger.TxBody Ledger.TopTx (ShelleyLedgerEra era) -> TxFee era @@ -1691,20 +1700,21 @@ fromLedgerTxExtraKeyWitnesses -> Ledger.TxBody Ledger.TopTx (ShelleyLedgerEra era) -> TxExtraKeyWitnesses era fromLedgerTxExtraKeyWitnesses sbe body = - caseShelleyToMaryOrAlonzoEraOnwards - (const TxExtraKeyWitnessesNone) + forEraInEon + (convert sbe) + TxExtraKeyWitnessesNone ( \w -> - let keyhashes = body ^. L.reqSignerHashesTxBodyG - in if Set.null keyhashes - then TxExtraKeyWitnessesNone - else - TxExtraKeyWitnesses - w - [ PaymentKeyHash (Shelley.coerceKeyRole keyhash) - | keyhash <- toList $ body ^. L.reqSignerHashesTxBodyG - ] + alonzoEraOnwardsConstraints w $ + let keyhashes = body ^. L.reqSignerHashesTxBodyG + in if Set.null keyhashes + then TxExtraKeyWitnessesNone + else + TxExtraKeyWitnesses + w + [ PaymentKeyHash (Shelley.coerceKeyRole keyhash) + | keyhash <- toList $ body ^. L.reqSignerHashesTxBodyG + ] ) - sbe fromLedgerTxWithdrawals :: ShelleyBasedEra era @@ -1890,49 +1900,50 @@ convScriptData -> [(ScriptWitnessIndex, AnyScriptWitness era)] -> TxBodyScriptData era convScriptData sbe txOuts scriptWitnesses = - caseShelleyToMaryOrAlonzoEraOnwards - (const TxBodyNoScriptData) + forEraInEon + (convert sbe) + TxBodyNoScriptData ( \w -> - let redeemers = - Alonzo.Redeemers $ - fromList - [ (i, (toAlonzoData d, toAlonzoExUnits e)) - | ( idx - , AnyScriptWitness - (PlutusScriptWitness _ _ _ _ d e) - ) <- - scriptWitnesses - , Just i <- [fromScriptWitnessIndex w idx] - ] + alonzoEraOnwardsConstraints w $ + let redeemers = + Alonzo.Redeemers $ + fromList + [ (i, (toAlonzoData d, toAlonzoExUnits e)) + | ( idx + , AnyScriptWitness + (PlutusScriptWitness _ _ _ _ d e) + ) <- + scriptWitnesses + , Just i <- [fromScriptWitnessIndex w idx] + ] - datums = - Alonzo.TxDats $ - fromList - [ (L.hashData d', d') - | d <- scriptdata - , let d' = toAlonzoData d - ] + datums = + Alonzo.TxDats $ + fromList + [ (L.hashData d', d') + | d <- scriptdata + , let d' = toAlonzoData d + ] - scriptdata :: [HashableScriptData] - scriptdata = - [d | TxOut _ _ (TxOutSupplementalDatum _ d) _ <- txOuts] - ++ [ d - | ( _ - , AnyScriptWitness - ( PlutusScriptWitness - _ - _ - _ - (ScriptDatumForTxIn (Just d)) - _ - _ - ) - ) <- - scriptWitnesses - ] - in TxBodyScriptData w datums redeemers + scriptdata :: [HashableScriptData] + scriptdata = + [d | TxOut _ _ (TxOutSupplementalDatum _ d) _ <- txOuts] + ++ [ d + | ( _ + , AnyScriptWitness + ( PlutusScriptWitness + _ + _ + _ + (ScriptDatumForTxIn (Just d)) + _ + _ + ) + ) <- + scriptWitnesses + ] + in TxBodyScriptData w datums redeemers ) - sbe convPParamsToScriptIntegrityHash :: () diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Fee.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Fee.hs index 6548b832ed..c989edf4ee 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Fee.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/Fee.hs @@ -58,7 +58,6 @@ where import Cardano.Api.Address import Cardano.Api.Certificate.Internal -import Cardano.Api.Era.Internal.Case import Cardano.Api.Era.Internal.Core import Cardano.Api.Era.Internal.Eon.AlonzoEraOnwards import Cardano.Api.Era.Internal.Eon.BabbageEraOnwards @@ -328,21 +327,22 @@ estimateBalancedTxBody -- Step 4. We use the fee to calculate the required collateral (retColl, reqCol) <- - caseShelleyToAlonzoOrBabbageEraOnwards - (const $ pure (TxReturnCollateralNone, TxTotalCollateralNone)) + forEraInEon + (convert sbe) + (pure (TxReturnCollateralNone, TxTotalCollateralNone)) ( \w' -> - first (TxFeeEstimationBalanceError . TxBodyErrorCollateral) $ - calcReturnAndTotalCollateral - w' - fee - pparams - (txInsCollateral txbodycontent) - (txReturnCollateral txbodycontent) - (txTotalCollateral txbodycontent) - changeaddr - (A.mkAdaValue sbe totalPotentialCollateral) + babbageEraOnwardsConstraints w' $ + first (TxFeeEstimationBalanceError . TxBodyErrorCollateral) $ + calcReturnAndTotalCollateral + w' + fee + pparams + (txInsCollateral txbodycontent) + (txReturnCollateral txbodycontent) + (txTotalCollateral txbodycontent) + changeaddr + (A.mkAdaValue sbe totalPotentialCollateral) ) - sbe -- Step 5. Now we can calculate the balance of the tx. What matter here are: -- 1. The original outputs @@ -675,14 +675,14 @@ evaluateTransactionExecutionUnitsShelley -> L.Tx L.TopTx (ShelleyLedgerEra era) -> Map ScriptWitnessIndex (Either ScriptExecutionError (EvalTxExecutionUnitsLog, ExecutionUnits)) evaluateTransactionExecutionUnitsShelley sbe systemstart epochInfo (LedgerProtocolParameters pp) utxo tx = - caseShelleyToMaryOrAlonzoEraOnwards - (const Map.empty) + forEraInEon + (convert sbe) + Map.empty ( \w -> - fromLedgerScriptExUnitsMap w $ - alonzoEraOnwardsConstraints w $ + alonzoEraOnwardsConstraints w $ + fromLedgerScriptExUnitsMap w $ L.evalTxExUnitsWithLogs pp tx (toLedgerUTxO sbe utxo) ledgerEpochInfo systemstart ) - sbe where LedgerEpochInfo ledgerEpochInfo = epochInfo @@ -1107,9 +1107,10 @@ makeTransactionBodyAutoBalance mnkeys fee = calculateMinTxFee sbe pp utxo txbody1 nkeys (retColl, reqCol) <- - caseShelleyToAlonzoOrBabbageEraOnwards - (const $ pure (TxReturnCollateralNone, TxTotalCollateralNone)) - ( \w -> do + forEraInEon + (convert sbe) + (pure (TxReturnCollateralNone, TxTotalCollateralNone)) + ( \w -> babbageEraOnwardsConstraints w $ do let totalPotentialCollateral = mconcat [ txOutValue @@ -1128,7 +1129,6 @@ makeTransactionBodyAutoBalance changeaddr totalPotentialCollateral ) - sbe -- Make a txbody for calculating the balance. For this the size of the tx -- does not matter, instead it's just the values of the fee and outputs. diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Output.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Output.hs index b22fec6205..7bc12fc9a0 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Output.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/Output.hs @@ -58,12 +58,12 @@ module Cardano.Api.Tx.Internal.Output where import Cardano.Api.Address -import Cardano.Api.Era.Internal.Case import Cardano.Api.Era.Internal.Core import Cardano.Api.Era.Internal.Eon.AlonzoEraOnwards import Cardano.Api.Era.Internal.Eon.BabbageEraOnwards import Cardano.Api.Era.Internal.Eon.Convert import Cardano.Api.Era.Internal.Eon.ConwayEraOnwards +import Cardano.Api.Era.Internal.Eon.MaryEraOnwards import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra import Cardano.Api.Error (Error (..), displayError) import Cardano.Api.HasTypeProxy qualified as HTP @@ -793,8 +793,9 @@ toShelleyTxOut -> L.TxOut ledgerera toShelleyTxOut sbe = shelleyBasedEraConstraints sbe $ \case TxOut addr (TxOutValueShelleyBased _ value) txoutdata refScript -> - caseShelleyToMaryOrAlonzoEraOnwards - (const $ L.mkBasicTxOut (toShelleyAddr addr) value) + forEraInEon + (convert sbe) + (L.mkBasicTxOut (toShelleyAddr addr) value) ( \case AlonzoEraOnwardsAlonzo -> L.mkBasicTxOut (toShelleyAddr addr) value @@ -813,7 +814,6 @@ toShelleyTxOut sbe = shelleyBasedEraConstraints sbe $ \case & L.referenceScriptTxOutL .~ refScriptToShelleyScript sbe refScript ) - sbe -- | A variant of 'toShelleyTxOutAny that is used only internally to this module -- that works with a 'TxOut' in any context (including CtxTx) by ignoring @@ -827,8 +827,9 @@ toShelleyTxOutAny -> L.TxOut ledgerera toShelleyTxOutAny sbe = shelleyBasedEraConstraints sbe $ \case TxOut addr (TxOutValueShelleyBased _ value) txoutdata refScript -> - caseShelleyToMaryOrAlonzoEraOnwards - (const $ L.mkBasicTxOut (toShelleyAddr addr) value) + forEraInEon + (convert sbe) + (L.mkBasicTxOut (toShelleyAddr addr) value) ( \case AlonzoEraOnwardsAlonzo -> L.mkBasicTxOut (toShelleyAddr addr) value @@ -847,7 +848,6 @@ toShelleyTxOutAny sbe = shelleyBasedEraConstraints sbe $ \case & L.referenceScriptTxOutL .~ refScriptToShelleyScript sbe refScript ) - sbe fromShelleyTxOut :: forall era ctx @@ -938,18 +938,18 @@ instance IsCardanoEra era => ToJSON (TxOutValue era) where instance IsShelleyBasedEra era => FromJSON (TxOutValue era) where parseJSON = withObject "TxOutValue" $ \o -> - caseShelleyToAllegraOrMaryEraOnwards - ( \shelleyToAlleg -> do + forEraInEon @MaryEraOnwards + (convert (shelleyBasedEra @era)) + ( shelleyBasedEraConstraints (shelleyBasedEra @era) $ do ll <- o .: "lovelace" - let sbe = convert shelleyToAlleg + let sbe = shelleyBasedEra @era pure $ - shelleyBasedEraConstraints sbe $ - TxOutValueShelleyBased sbe $ - A.mkAdaValue sbe ll + TxOutValueShelleyBased sbe $ + A.mkAdaValue sbe ll ) ( \w -> do let l = toList o - sbe = convert w + sbe = shelleyBasedEra @era vals <- mapM decodeAssetId l pure $ shelleyBasedEraConstraints sbe $ @@ -957,7 +957,6 @@ instance IsShelleyBasedEra era => FromJSON (TxOutValue era) where toLedgerValue w $ mconcat vals ) - (shelleyBasedEra @era) where decodeAssetId :: (Aeson.Key, Aeson.Value) -> Aeson.Parser Value decodeAssetId (polid, Aeson.Object assetNameHm) = do diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Sign.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Sign.hs index 331bdc822d..15abff6f32 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Sign.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/Sign.hs @@ -249,8 +249,9 @@ deserialiseShelleyBasedTx mkTx bs = {-# DEPRECATED getTxBody "Use 'UnsignedTx' from 'Cardano.Api.Experimental' instead." #-} getTxBody :: Tx era -> TxBody era getTxBody (ShelleyTx sbe tx) = - caseShelleyToMaryOrAlonzoEraOnwards - ( const $ + forEraInEon + (convert sbe) + ( shelleyBasedEraConstraints sbe $ let txBody = tx ^. L.bodyTxL txAuxData = tx ^. L.auxDataTxL scriptWits = tx ^. L.witsTxL . L.scriptTxWitsL @@ -263,21 +264,21 @@ getTxBody (ShelleyTx sbe tx) = TxScriptValidityNone ) ( \w -> - let txBody = tx ^. L.bodyTxL - txAuxData = tx ^. L.auxDataTxL - scriptWits = tx ^. L.witsTxL . L.scriptTxWitsL - datsWits = tx ^. L.witsTxL . L.datsTxWitsL - redeemerWits = tx ^. L.witsTxL . L.rdmrsTxWitsL - isValid = tx ^. L.isValidTxL - in ShelleyTxBody - sbe - txBody - (Map.elems scriptWits) - (TxBodyScriptData w datsWits redeemerWits) - (strictMaybeToMaybe txAuxData) - (TxScriptValidity w (isValidToScriptValidity isValid)) + alonzoEraOnwardsConstraints w $ + let txBody = tx ^. L.bodyTxL + txAuxData = tx ^. L.auxDataTxL + scriptWits = tx ^. L.witsTxL . L.scriptTxWitsL + datsWits = tx ^. L.witsTxL . L.datsTxWitsL + redeemerWits = tx ^. L.witsTxL . L.rdmrsTxWitsL + isValid = tx ^. L.isValidTxL + in ShelleyTxBody + sbe + txBody + (Map.elems scriptWits) + (TxBodyScriptData w datsWits redeemerWits) + (strictMaybeToMaybe txAuxData) + (TxScriptValidity w (isValidToScriptValidity isValid)) ) - sbe instance IsShelleyBasedEra era => HasTextEnvelope (Tx era) where textEnvelopeType _ = @@ -333,20 +334,21 @@ instance Eq (TxBody era) where (==) (ShelleyTxBody sbe txbodyA txscriptsA redeemersA txmetadataA scriptValidityA) (ShelleyTxBody _ txbodyB txscriptsB redeemersB txmetadataB scriptValidityB) = - caseShelleyToMaryOrAlonzoEraOnwards - ( const $ + forEraInEon + (convert sbe) + ( shelleyBasedEraConstraints sbe $ txbodyA == txbodyB && txscriptsA == txscriptsB && txmetadataA == txmetadataB ) - ( const $ - txbodyA == txbodyB - && txscriptsA == txscriptsB - && redeemersA == redeemersB - && txmetadataA == txmetadataB - && scriptValidityA == scriptValidityB + ( \w -> + alonzoEraOnwardsConstraints w $ + txbodyA == txbodyB + && txscriptsA == txscriptsB + && redeemersA == redeemersB + && txmetadataA == txmetadataB + && scriptValidityA == scriptValidityB ) - sbe -- The GADT in the ShelleyTxBody case requires a custom instance instance Show (TxBody era) where @@ -951,10 +953,10 @@ getTxWitnessesByron (Byron.ATxAux{Byron.aTaWitness = witnesses}) = getTxWitnesses :: forall era. Tx era -> [KeyWitness era] getTxWitnesses (ShelleyTx sbe tx') = - caseShelleyToMaryOrAlonzoEraOnwards - (const (getShelleyTxWitnesses tx')) - (const (getAlonzoTxWitnesses tx')) - sbe + forEraInEon + (convert sbe) + (shelleyBasedEraConstraints sbe $ getShelleyTxWitnesses tx') + (\w -> alonzoEraOnwardsConstraints w $ getAlonzoTxWitnesses tx') where getShelleyTxWitnesses :: forall ledgerera diff --git a/cardano-api/src/Cardano/Api/Value/Internal.hs b/cardano-api/src/Cardano/Api/Value/Internal.hs index 64c3aef2f6..493626ab7c 100644 --- a/cardano-api/src/Cardano/Api/Value/Internal.hs +++ b/cardano-api/src/Cardano/Api/Value/Internal.hs @@ -70,7 +70,7 @@ module Cardano.Api.Value.Internal ) where -import Cardano.Api.Era.Internal.Case +import Cardano.Api.Era.Internal.Core (forEraInEon, toCardanoEra) import Cardano.Api.Era.Internal.Eon.MaryEraOnwards import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra import Cardano.Api.HasTypeProxy @@ -336,10 +336,10 @@ toLedgerValue w = maryEraOnwardsConstraints w toMaryValue fromLedgerValue :: ShelleyBasedEra era -> L.Value (ShelleyLedgerEra era) -> Value fromLedgerValue sbe v = - caseShelleyToAllegraOrMaryEraOnwards - (const (lovelaceToValue v)) - (const (fromMaryValue v)) - sbe + forEraInEon + (toCardanoEra sbe) + (shelleyBasedEraConstraints sbe $ lovelaceToValue $ L.coin v) + (\w -> maryEraOnwardsConstraints w $ fromMaryValue v) fromMaryValue :: MaryValue -> Value fromMaryValue (MaryValue (L.Coin lovelace) multiAsset) =