diff --git a/cardano-api/internal/Cardano/Api/Eon/ShelleyBasedEra.hs b/cardano-api/internal/Cardano/Api/Eon/ShelleyBasedEra.hs index 1cdedaefc0..7cb2ee7a2c 100644 --- a/cardano-api/internal/Cardano/Api/Eon/ShelleyBasedEra.hs +++ b/cardano-api/internal/Cardano/Api/Eon/ShelleyBasedEra.hs @@ -15,10 +15,11 @@ module Cardano.Api.Eon.ShelleyBasedEra , AnyShelleyBasedEra(..) , InAnyShelleyBasedEra(..) , shelleyBasedToCardanoEra - , eonInShelleyBasedEra - , inShelleyBasedEraEon - , inShelleyBasedEraEonMaybe - , maybeEonInShelleyBasedEra + , inEonForShelleyBasedEra + , inEonForShelleyBasedEraMaybe + , forShelleyBasedEraInEon + , forShelleyBasedEraInEonMaybe + , forShelleyBasedEraMaybeEon -- * Cardano eras, as Byron vs Shelley-based , CardanoEraStyle(..) @@ -45,38 +46,46 @@ import qualified Data.Text as Text import Data.Type.Equality (TestEquality (..), (:~:) (Refl)) -- | Determine the value to use for a feature in a given 'ShelleyBasedEra'. -eonInShelleyBasedEra :: () +inEonForShelleyBasedEra :: () => Eon eon => a -> (eon era -> a) -> ShelleyBasedEra era -> a -eonInShelleyBasedEra no yes = +inEonForShelleyBasedEra no yes = inEonForEra no yes . shelleyBasedToCardanoEra -maybeEonInShelleyBasedEra :: () +inEonForShelleyBasedEraMaybe :: () + => Eon eon + => (eon era -> a) + -> ShelleyBasedEra era + -> Maybe a +inEonForShelleyBasedEraMaybe yes = + inEonForShelleyBasedEra Nothing (Just . yes) + +forShelleyBasedEraMaybeEon :: () => Eon eon => ShelleyBasedEra era -> Maybe (eon era) -maybeEonInShelleyBasedEra = +forShelleyBasedEraMaybeEon = inEonForEra Nothing Just . shelleyBasedToCardanoEra -inShelleyBasedEraEon :: () +forShelleyBasedEraInEon :: () => Eon eon => ShelleyBasedEra era -> a -> (eon era -> a) -> a -inShelleyBasedEraEon era no yes = - eonInShelleyBasedEra no yes era +forShelleyBasedEraInEon era no yes = + inEonForShelleyBasedEra no yes era -inShelleyBasedEraEonMaybe :: () +forShelleyBasedEraInEonMaybe :: () => Eon eon => ShelleyBasedEra era -> (eon era -> a) -> Maybe a -inShelleyBasedEraEonMaybe era yes = - inShelleyBasedEraEon era Nothing (Just . yes) +forShelleyBasedEraInEonMaybe era yes = + forShelleyBasedEraInEon era Nothing (Just . yes) -- ---------------------------------------------------------------------------- -- Shelley-based eras diff --git a/cardano-api/internal/Cardano/Api/Eras.hs b/cardano-api/internal/Cardano/Api/Eras.hs index a21be76aa0..5e3dc610b3 100644 --- a/cardano-api/internal/Cardano/Api/Eras.hs +++ b/cardano-api/internal/Cardano/Api/Eras.hs @@ -23,9 +23,11 @@ module Cardano.Api.Eras -- * IsEon , Eon(..) , AnyEraInEon(..) + + , inEonForEraMaybe , forEraInEon - , inEraEonMaybe - , maybeEonInEra + , forEraInEonMaybe + , forEraMaybeEon -- * Data family instances , AsType(AsByronEra, AsShelleyEra, AsAllegraEra, AsMaryEra, AsAlonzoEra, AsBabbageEra, AsConwayEra) diff --git a/cardano-api/internal/Cardano/Api/Eras/Core.hs b/cardano-api/internal/Cardano/Api/Eras/Core.hs index 89b88ed55e..a9ebe88665 100644 --- a/cardano-api/internal/Cardano/Api/Eras/Core.hs +++ b/cardano-api/internal/Cardano/Api/Eras/Core.hs @@ -31,9 +31,10 @@ module Cardano.Api.Eras.Core -- * IsEon , Eon(..) , AnyEraInEon(..) + , inEonForEraMaybe , forEraInEon - , inEraEonMaybe - , maybeEonInEra + , forEraInEonMaybe + , forEraMaybeEon -- * Data family instances , AsType(AsByronEra, AsShelleyEra, AsAllegraEra, AsMaryEra, AsAlonzoEra, AsBabbageEra, AsConwayEra) @@ -116,6 +117,14 @@ class Eon (eon :: Type -> Type) where -> CardanoEra era -- ^ Era to check -> a -- ^ The value to use +inEonForEraMaybe :: () + => Eon eon + => (eon era -> a) -- ^ Function to get the value to use if the eon includes the era + -> CardanoEra era -- ^ Era to check + -> Maybe a -- ^ The value to use +inEonForEraMaybe yes = + inEonForEra Nothing (Just . yes) + forEraInEon :: () => Eon eon => CardanoEra era -- ^ Era to check @@ -125,19 +134,19 @@ forEraInEon :: () forEraInEon era no yes = inEonForEra no yes era -inEraEonMaybe :: () +forEraInEonMaybe :: () => Eon eon => CardanoEra era -- ^ Era to check -> (eon era -> a) -- ^ Function to get the value to use if the eon includes the era -> Maybe a -- ^ The value to use -inEraEonMaybe era yes = +forEraInEonMaybe era yes = forEraInEon era Nothing (Just . yes) -maybeEonInEra :: () +forEraMaybeEon :: () => Eon eon => CardanoEra era -- ^ Era to check -> Maybe (eon era) -- ^ The eon if supported in the era -maybeEonInEra = +forEraMaybeEon = inEonForEra Nothing Just -- ---------------------------------------------------------------------------- diff --git a/cardano-api/internal/Cardano/Api/TxBody.hs b/cardano-api/internal/Cardano/Api/TxBody.hs index e19eff759f..7a39429027 100644 --- a/cardano-api/internal/Cardano/Api/TxBody.hs +++ b/cardano-api/internal/Cardano/Api/TxBody.hs @@ -308,7 +308,7 @@ txScriptValidityToScriptValidity (TxScriptValidity _ scriptValidity) = scriptVal scriptValidityToTxScriptValidity :: ShelleyBasedEra era -> ScriptValidity -> TxScriptValidity era scriptValidityToTxScriptValidity sbe scriptValidity = - inShelleyBasedEraEon sbe TxScriptValidityNone $ \w -> TxScriptValidity w scriptValidity + forShelleyBasedEraInEon sbe TxScriptValidityNone $ \w -> TxScriptValidity w scriptValidity txScriptValidityToIsValid :: TxScriptValidity era -> L.IsValid txScriptValidityToIsValid = scriptValidityToIsValid . txScriptValidityToScriptValidity @@ -1751,7 +1751,7 @@ deserialiseShelleyBasedTxBody sbe bs = (flip CBOR.runAnnotator fbs (return TxScriptValidityNone)) 4 -> do sValiditySupported <- - inShelleyBasedEraEon sbe + forShelleyBasedEraInEon sbe ( fail $ mconcat [ "deserialiseShelleyBasedTxBody: Expected an era that supports the " , "script validity flag but got: " @@ -1783,7 +1783,7 @@ deserialiseShelleyBasedTxBody sbe bs = pure sValiditySupported <- - inShelleyBasedEraEon sbe + forShelleyBasedEraInEon sbe ( fail $ mconcat [ "deserialiseShelleyBasedTxBody: Expected an era that supports the " , "script validity flag but got: " @@ -2278,7 +2278,7 @@ fromLedgerProposalProcedures -> Ledger.TxBody (ShelleyLedgerEra era) -> Maybe (Featured ConwayEraOnwards era [Proposal era]) fromLedgerProposalProcedures sbe body = - inShelleyBasedEraEonMaybe sbe $ \w -> + forShelleyBasedEraInEonMaybe sbe $ \w -> conwayEraOnwardsConstraints w $ Featured w $ fmap Proposal @@ -2290,7 +2290,7 @@ fromLedgerVotingProcedures :: () -> Ledger.TxBody (ShelleyLedgerEra era) -> Maybe (Featured ConwayEraOnwards era (VotingProcedures era)) fromLedgerVotingProcedures sbe body = - inShelleyBasedEraEonMaybe sbe $ \w -> + forShelleyBasedEraInEonMaybe sbe $ \w -> conwayEraOnwardsConstraints w $ Featured w $ VotingProcedures diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index fb67112025..813dacdeea 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -27,17 +27,20 @@ module Cardano.Api ( InAnyCardanoEra(..), ToCardanoEra(..), - -- * Feature support + -- * Eon support Eon(..), AnyEraInEon(..), - forEraInEon, - inEraEonMaybe, - maybeEonInEra, - eonInShelleyBasedEra, - inShelleyBasedEraEon, - inShelleyBasedEraEonMaybe, - maybeEonInShelleyBasedEra, + inEonForEraMaybe, + forEraInEon, + forEraInEonMaybe, + forEraMaybeEon, + + inEonForShelleyBasedEra, + inEonForShelleyBasedEraMaybe, + forShelleyBasedEraInEon, + forShelleyBasedEraInEonMaybe, + forShelleyBasedEraMaybeEon, Featured(..), asFeaturedInEra,