{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# LANGUAGE ViewPatterns #-}
module Cardano.Ledger.Api.Scripts (
module Cardano.Ledger.Api.Scripts.Data,
EraScript (Script, NativeScript),
ScriptHash,
scriptPrefixTag,
upgradeScript,
hashScript,
getNativeScript,
validateNativeScript,
isNativeScript,
ValidityInterval (..),
AnyEraScript (..),
pattern AnyEraSpendingPurpose,
pattern AnyEraMintingPurpose,
pattern AnyEraCertifyingPurpose,
pattern AnyEraRewardingPurpose,
pattern AnyEraVotingPurpose,
pattern AnyEraProposingPurpose,
pattern AnyEraGuardingPurpose,
AlonzoEraScript (
PlutusScript,
PlutusPurpose,
toSpendingPurpose,
toMintingPurpose,
toCertifyingPurpose,
toRewardingPurpose
),
isPlutusScript,
pattern SpendingPurpose,
pattern MintingPurpose,
pattern CertifyingPurpose,
pattern RewardingPurpose,
CostModels,
ConwayEraScript (
toVotingPurpose,
toProposingPurpose
),
pattern VotingPurpose,
pattern ProposingPurpose,
DijkstraEraScript (
toGuardingPurpose
),
pattern GuardingPurpose,
) where
import Cardano.Ledger.Address (RewardAccount)
import Cardano.Ledger.Allegra.Scripts (ValidityInterval (..))
import Cardano.Ledger.Alonzo.Scripts (
AlonzoEraScript (..),
CostModels,
isPlutusScript,
pattern CertifyingPurpose,
pattern MintingPurpose,
pattern RewardingPurpose,
pattern SpendingPurpose,
)
import Cardano.Ledger.Api.Era
import Cardano.Ledger.Api.Scripts.Data
import Cardano.Ledger.Conway.Governance (ProposalProcedure, Voter)
import Cardano.Ledger.Conway.Scripts (
ConwayEraScript (..),
pattern ProposingPurpose,
pattern VotingPurpose,
)
import Cardano.Ledger.Core (
EraScript (..),
TxCert,
hashScript,
isNativeScript,
validateNativeScript,
)
import Cardano.Ledger.Dijkstra.Scripts (
DijkstraEraScript (..),
pattern GuardingPurpose,
)
import Cardano.Ledger.Hashes (ScriptHash)
import Cardano.Ledger.Mary.Value (PolicyID)
import Cardano.Ledger.Plutus (Language)
import Cardano.Ledger.TxIn (TxIn)
import Data.Word (Word32)
class EraScript era => AnyEraScript era where
anyEraMaxLanguage :: Maybe Language
default anyEraMaxLanguage ::
AlonzoEraScript era => Maybe Language
anyEraMaxLanguage = Language -> Maybe Language
forall a. a -> Maybe a
Just (forall era. AlonzoEraScript era => Language
eraMaxLanguage @era)
anyEraToPlutusScript :: Script era -> Maybe (PlutusScript era)
default anyEraToPlutusScript ::
AlonzoEraScript era => Script era -> Maybe (PlutusScript era)
anyEraToPlutusScript = Script era -> Maybe (PlutusScript era)
forall era.
AlonzoEraScript era =>
Script era -> Maybe (PlutusScript era)
toPlutusScript
anyEraToSpendingPurpose :: PlutusPurpose f era -> Maybe (f Word32 TxIn)
default anyEraToSpendingPurpose ::
AlonzoEraScript era => PlutusPurpose f era -> Maybe (f Word32 TxIn)
anyEraToSpendingPurpose = PlutusPurpose f era -> Maybe (f Word32 TxIn)
forall era (f :: * -> * -> *).
AlonzoEraScript era =>
PlutusPurpose f era -> Maybe (f Word32 TxIn)
forall (f :: * -> * -> *).
PlutusPurpose f era -> Maybe (f Word32 TxIn)
toSpendingPurpose
anyEraToMintingPurpose :: PlutusPurpose f era -> Maybe (f Word32 PolicyID)
default anyEraToMintingPurpose ::
AlonzoEraScript era => PlutusPurpose f era -> Maybe (f Word32 PolicyID)
anyEraToMintingPurpose = PlutusPurpose f era -> Maybe (f Word32 PolicyID)
forall era (f :: * -> * -> *).
AlonzoEraScript era =>
PlutusPurpose f era -> Maybe (f Word32 PolicyID)
forall (f :: * -> * -> *).
PlutusPurpose f era -> Maybe (f Word32 PolicyID)
toMintingPurpose
anyEraToCertifyingPurpose :: PlutusPurpose f era -> Maybe (f Word32 (TxCert era))
default anyEraToCertifyingPurpose ::
AlonzoEraScript era => PlutusPurpose f era -> Maybe (f Word32 (TxCert era))
anyEraToCertifyingPurpose = PlutusPurpose f era -> Maybe (f Word32 (TxCert era))
forall era (f :: * -> * -> *).
AlonzoEraScript era =>
PlutusPurpose f era -> Maybe (f Word32 (TxCert era))
forall (f :: * -> * -> *).
PlutusPurpose f era -> Maybe (f Word32 (TxCert era))
toCertifyingPurpose
anyEraToRewardingPurpose :: PlutusPurpose f era -> Maybe (f Word32 RewardAccount)
default anyEraToRewardingPurpose ::
AlonzoEraScript era => PlutusPurpose f era -> Maybe (f Word32 RewardAccount)
anyEraToRewardingPurpose = PlutusPurpose f era -> Maybe (f Word32 RewardAccount)
forall era (f :: * -> * -> *).
AlonzoEraScript era =>
PlutusPurpose f era -> Maybe (f Word32 RewardAccount)
forall (f :: * -> * -> *).
PlutusPurpose f era -> Maybe (f Word32 RewardAccount)
toRewardingPurpose
anyEraToVotingPurpose :: PlutusPurpose f era -> Maybe (f Word32 Voter)
default anyEraToVotingPurpose ::
ConwayEraScript era => PlutusPurpose f era -> Maybe (f Word32 Voter)
anyEraToVotingPurpose = PlutusPurpose f era -> Maybe (f Word32 Voter)
forall era (f :: * -> * -> *).
ConwayEraScript era =>
PlutusPurpose f era -> Maybe (f Word32 Voter)
forall (f :: * -> * -> *).
PlutusPurpose f era -> Maybe (f Word32 Voter)
toVotingPurpose
anyEraToProposingPurpose :: PlutusPurpose f era -> Maybe (f Word32 (ProposalProcedure era))
default anyEraToProposingPurpose ::
ConwayEraScript era => PlutusPurpose f era -> Maybe (f Word32 (ProposalProcedure era))
anyEraToProposingPurpose = PlutusPurpose f era -> Maybe (f Word32 (ProposalProcedure era))
forall era (f :: * -> * -> *).
ConwayEraScript era =>
PlutusPurpose f era -> Maybe (f Word32 (ProposalProcedure era))
forall (f :: * -> * -> *).
PlutusPurpose f era -> Maybe (f Word32 (ProposalProcedure era))
toProposingPurpose
anyEraToGuardingPurpose :: PlutusPurpose f era -> Maybe (f Word32 ScriptHash)
default anyEraToGuardingPurpose ::
DijkstraEraScript era => PlutusPurpose f era -> Maybe (f Word32 ScriptHash)
anyEraToGuardingPurpose = PlutusPurpose f era -> Maybe (f Word32 ScriptHash)
forall era (f :: * -> * -> *).
DijkstraEraScript era =>
PlutusPurpose f era -> Maybe (f Word32 ScriptHash)
forall (f :: * -> * -> *).
PlutusPurpose f era -> Maybe (f Word32 ScriptHash)
toGuardingPurpose
instance AnyEraScript ShelleyEra where
anyEraMaxLanguage :: Maybe Language
anyEraMaxLanguage = Maybe Language
forall a. Maybe a
Nothing
anyEraToPlutusScript :: Script ShelleyEra -> Maybe (PlutusScript ShelleyEra)
anyEraToPlutusScript = Maybe (PlutusScript ShelleyEra)
-> MultiSig ShelleyEra -> Maybe (PlutusScript ShelleyEra)
forall a b. a -> b -> a
const Maybe (PlutusScript ShelleyEra)
forall a. Maybe a
Nothing
anyEraToSpendingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f ShelleyEra -> Maybe (f Word32 TxIn)
anyEraToSpendingPurpose = Maybe (f Word32 TxIn)
-> PlutusPurpose f ShelleyEra -> Maybe (f Word32 TxIn)
forall a b. a -> b -> a
const Maybe (f Word32 TxIn)
forall a. Maybe a
Nothing
anyEraToMintingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f ShelleyEra -> Maybe (f Word32 PolicyID)
anyEraToMintingPurpose = Maybe (f Word32 PolicyID)
-> PlutusPurpose f ShelleyEra -> Maybe (f Word32 PolicyID)
forall a b. a -> b -> a
const Maybe (f Word32 PolicyID)
forall a. Maybe a
Nothing
anyEraToCertifyingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f ShelleyEra -> Maybe (f Word32 (TxCert ShelleyEra))
anyEraToCertifyingPurpose = Maybe (f Word32 (ShelleyTxCert ShelleyEra))
-> PlutusPurpose f ShelleyEra
-> Maybe (f Word32 (ShelleyTxCert ShelleyEra))
forall a b. a -> b -> a
const Maybe (f Word32 (ShelleyTxCert ShelleyEra))
forall a. Maybe a
Nothing
anyEraToRewardingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f ShelleyEra -> Maybe (f Word32 RewardAccount)
anyEraToRewardingPurpose = Maybe (f Word32 RewardAccount)
-> PlutusPurpose f ShelleyEra -> Maybe (f Word32 RewardAccount)
forall a b. a -> b -> a
const Maybe (f Word32 RewardAccount)
forall a. Maybe a
Nothing
anyEraToVotingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f ShelleyEra -> Maybe (f Word32 Voter)
anyEraToVotingPurpose = Maybe (f Word32 Voter)
-> PlutusPurpose f ShelleyEra -> Maybe (f Word32 Voter)
forall a b. a -> b -> a
const Maybe (f Word32 Voter)
forall a. Maybe a
Nothing
anyEraToProposingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f ShelleyEra
-> Maybe (f Word32 (ProposalProcedure ShelleyEra))
anyEraToProposingPurpose = Maybe (f Word32 (ProposalProcedure ShelleyEra))
-> PlutusPurpose f ShelleyEra
-> Maybe (f Word32 (ProposalProcedure ShelleyEra))
forall a b. a -> b -> a
const Maybe (f Word32 (ProposalProcedure ShelleyEra))
forall a. Maybe a
Nothing
anyEraToGuardingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f ShelleyEra -> Maybe (f Word32 ScriptHash)
anyEraToGuardingPurpose = Maybe (f Word32 ScriptHash)
-> PlutusPurpose f ShelleyEra -> Maybe (f Word32 ScriptHash)
forall a b. a -> b -> a
const Maybe (f Word32 ScriptHash)
forall a. Maybe a
Nothing
instance AnyEraScript AllegraEra where
anyEraMaxLanguage :: Maybe Language
anyEraMaxLanguage = Maybe Language
forall a. Maybe a
Nothing
anyEraToPlutusScript :: Script AllegraEra -> Maybe (PlutusScript AllegraEra)
anyEraToPlutusScript = Maybe (PlutusScript AllegraEra)
-> Timelock AllegraEra -> Maybe (PlutusScript AllegraEra)
forall a b. a -> b -> a
const Maybe (PlutusScript AllegraEra)
forall a. Maybe a
Nothing
anyEraToSpendingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f AllegraEra -> Maybe (f Word32 TxIn)
anyEraToSpendingPurpose = Maybe (f Word32 TxIn)
-> PlutusPurpose f AllegraEra -> Maybe (f Word32 TxIn)
forall a b. a -> b -> a
const Maybe (f Word32 TxIn)
forall a. Maybe a
Nothing
anyEraToMintingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f AllegraEra -> Maybe (f Word32 PolicyID)
anyEraToMintingPurpose = Maybe (f Word32 PolicyID)
-> PlutusPurpose f AllegraEra -> Maybe (f Word32 PolicyID)
forall a b. a -> b -> a
const Maybe (f Word32 PolicyID)
forall a. Maybe a
Nothing
anyEraToCertifyingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f AllegraEra -> Maybe (f Word32 (TxCert AllegraEra))
anyEraToCertifyingPurpose = Maybe (f Word32 (ShelleyTxCert AllegraEra))
-> PlutusPurpose f AllegraEra
-> Maybe (f Word32 (ShelleyTxCert AllegraEra))
forall a b. a -> b -> a
const Maybe (f Word32 (ShelleyTxCert AllegraEra))
forall a. Maybe a
Nothing
anyEraToRewardingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f AllegraEra -> Maybe (f Word32 RewardAccount)
anyEraToRewardingPurpose = Maybe (f Word32 RewardAccount)
-> PlutusPurpose f AllegraEra -> Maybe (f Word32 RewardAccount)
forall a b. a -> b -> a
const Maybe (f Word32 RewardAccount)
forall a. Maybe a
Nothing
anyEraToVotingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f AllegraEra -> Maybe (f Word32 Voter)
anyEraToVotingPurpose = Maybe (f Word32 Voter)
-> PlutusPurpose f AllegraEra -> Maybe (f Word32 Voter)
forall a b. a -> b -> a
const Maybe (f Word32 Voter)
forall a. Maybe a
Nothing
anyEraToProposingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f AllegraEra
-> Maybe (f Word32 (ProposalProcedure AllegraEra))
anyEraToProposingPurpose = Maybe (f Word32 (ProposalProcedure AllegraEra))
-> PlutusPurpose f AllegraEra
-> Maybe (f Word32 (ProposalProcedure AllegraEra))
forall a b. a -> b -> a
const Maybe (f Word32 (ProposalProcedure AllegraEra))
forall a. Maybe a
Nothing
anyEraToGuardingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f AllegraEra -> Maybe (f Word32 ScriptHash)
anyEraToGuardingPurpose = Maybe (f Word32 ScriptHash)
-> PlutusPurpose f AllegraEra -> Maybe (f Word32 ScriptHash)
forall a b. a -> b -> a
const Maybe (f Word32 ScriptHash)
forall a. Maybe a
Nothing
instance AnyEraScript MaryEra where
anyEraMaxLanguage :: Maybe Language
anyEraMaxLanguage = Maybe Language
forall a. Maybe a
Nothing
anyEraToPlutusScript :: Script MaryEra -> Maybe (PlutusScript MaryEra)
anyEraToPlutusScript = Maybe (PlutusScript MaryEra)
-> Timelock MaryEra -> Maybe (PlutusScript MaryEra)
forall a b. a -> b -> a
const Maybe (PlutusScript MaryEra)
forall a. Maybe a
Nothing
anyEraToSpendingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f MaryEra -> Maybe (f Word32 TxIn)
anyEraToSpendingPurpose = Maybe (f Word32 TxIn)
-> PlutusPurpose f MaryEra -> Maybe (f Word32 TxIn)
forall a b. a -> b -> a
const Maybe (f Word32 TxIn)
forall a. Maybe a
Nothing
anyEraToMintingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f MaryEra -> Maybe (f Word32 PolicyID)
anyEraToMintingPurpose = Maybe (f Word32 PolicyID)
-> PlutusPurpose f MaryEra -> Maybe (f Word32 PolicyID)
forall a b. a -> b -> a
const Maybe (f Word32 PolicyID)
forall a. Maybe a
Nothing
anyEraToCertifyingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f MaryEra -> Maybe (f Word32 (TxCert MaryEra))
anyEraToCertifyingPurpose = Maybe (f Word32 (ShelleyTxCert MaryEra))
-> PlutusPurpose f MaryEra
-> Maybe (f Word32 (ShelleyTxCert MaryEra))
forall a b. a -> b -> a
const Maybe (f Word32 (ShelleyTxCert MaryEra))
forall a. Maybe a
Nothing
anyEraToRewardingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f MaryEra -> Maybe (f Word32 RewardAccount)
anyEraToRewardingPurpose = Maybe (f Word32 RewardAccount)
-> PlutusPurpose f MaryEra -> Maybe (f Word32 RewardAccount)
forall a b. a -> b -> a
const Maybe (f Word32 RewardAccount)
forall a. Maybe a
Nothing
anyEraToVotingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f MaryEra -> Maybe (f Word32 Voter)
anyEraToVotingPurpose = Maybe (f Word32 Voter)
-> PlutusPurpose f MaryEra -> Maybe (f Word32 Voter)
forall a b. a -> b -> a
const Maybe (f Word32 Voter)
forall a. Maybe a
Nothing
anyEraToProposingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f MaryEra
-> Maybe (f Word32 (ProposalProcedure MaryEra))
anyEraToProposingPurpose = Maybe (f Word32 (ProposalProcedure MaryEra))
-> PlutusPurpose f MaryEra
-> Maybe (f Word32 (ProposalProcedure MaryEra))
forall a b. a -> b -> a
const Maybe (f Word32 (ProposalProcedure MaryEra))
forall a. Maybe a
Nothing
anyEraToGuardingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f MaryEra -> Maybe (f Word32 ScriptHash)
anyEraToGuardingPurpose = Maybe (f Word32 ScriptHash)
-> PlutusPurpose f MaryEra -> Maybe (f Word32 ScriptHash)
forall a b. a -> b -> a
const Maybe (f Word32 ScriptHash)
forall a. Maybe a
Nothing
instance AnyEraScript AlonzoEra where
anyEraToVotingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f AlonzoEra -> Maybe (f Word32 Voter)
anyEraToVotingPurpose = Maybe (f Word32 Voter)
-> AlonzoPlutusPurpose f AlonzoEra -> Maybe (f Word32 Voter)
forall a b. a -> b -> a
const Maybe (f Word32 Voter)
forall a. Maybe a
Nothing
anyEraToProposingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f AlonzoEra
-> Maybe (f Word32 (ProposalProcedure AlonzoEra))
anyEraToProposingPurpose = Maybe (f Word32 (ProposalProcedure AlonzoEra))
-> AlonzoPlutusPurpose f AlonzoEra
-> Maybe (f Word32 (ProposalProcedure AlonzoEra))
forall a b. a -> b -> a
const Maybe (f Word32 (ProposalProcedure AlonzoEra))
forall a. Maybe a
Nothing
anyEraToGuardingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f AlonzoEra -> Maybe (f Word32 ScriptHash)
anyEraToGuardingPurpose = Maybe (f Word32 ScriptHash)
-> AlonzoPlutusPurpose f AlonzoEra -> Maybe (f Word32 ScriptHash)
forall a b. a -> b -> a
const Maybe (f Word32 ScriptHash)
forall a. Maybe a
Nothing
instance AnyEraScript BabbageEra where
anyEraToVotingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f BabbageEra -> Maybe (f Word32 Voter)
anyEraToVotingPurpose = Maybe (f Word32 Voter)
-> AlonzoPlutusPurpose f BabbageEra -> Maybe (f Word32 Voter)
forall a b. a -> b -> a
const Maybe (f Word32 Voter)
forall a. Maybe a
Nothing
anyEraToProposingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f BabbageEra
-> Maybe (f Word32 (ProposalProcedure BabbageEra))
anyEraToProposingPurpose = Maybe (f Word32 (ProposalProcedure BabbageEra))
-> AlonzoPlutusPurpose f BabbageEra
-> Maybe (f Word32 (ProposalProcedure BabbageEra))
forall a b. a -> b -> a
const Maybe (f Word32 (ProposalProcedure BabbageEra))
forall a. Maybe a
Nothing
anyEraToGuardingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f BabbageEra -> Maybe (f Word32 ScriptHash)
anyEraToGuardingPurpose = Maybe (f Word32 ScriptHash)
-> AlonzoPlutusPurpose f BabbageEra -> Maybe (f Word32 ScriptHash)
forall a b. a -> b -> a
const Maybe (f Word32 ScriptHash)
forall a. Maybe a
Nothing
instance AnyEraScript ConwayEra where
anyEraToGuardingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f ConwayEra -> Maybe (f Word32 ScriptHash)
anyEraToGuardingPurpose = Maybe (f Word32 ScriptHash)
-> ConwayPlutusPurpose f ConwayEra -> Maybe (f Word32 ScriptHash)
forall a b. a -> b -> a
const Maybe (f Word32 ScriptHash)
forall a. Maybe a
Nothing
instance AnyEraScript DijkstraEra
pattern AnyEraSpendingPurpose ::
AnyEraScript era => f Word32 TxIn -> PlutusPurpose f era
pattern $mAnyEraSpendingPurpose :: forall {r} {era} {f :: * -> * -> *}.
AnyEraScript era =>
PlutusPurpose f era -> (f Word32 TxIn -> r) -> ((# #) -> r) -> r
AnyEraSpendingPurpose c <- (anyEraToSpendingPurpose -> Just c)
pattern AnyEraMintingPurpose ::
AnyEraScript era => f Word32 PolicyID -> PlutusPurpose f era
pattern $mAnyEraMintingPurpose :: forall {r} {era} {f :: * -> * -> *}.
AnyEraScript era =>
PlutusPurpose f era
-> (f Word32 PolicyID -> r) -> ((# #) -> r) -> r
AnyEraMintingPurpose c <- (anyEraToMintingPurpose -> Just c)
pattern AnyEraCertifyingPurpose ::
AnyEraScript era => f Word32 (TxCert era) -> PlutusPurpose f era
pattern $mAnyEraCertifyingPurpose :: forall {r} {era} {f :: * -> * -> *}.
AnyEraScript era =>
PlutusPurpose f era
-> (f Word32 (TxCert era) -> r) -> ((# #) -> r) -> r
AnyEraCertifyingPurpose c <- (anyEraToCertifyingPurpose -> Just c)
pattern AnyEraRewardingPurpose ::
AnyEraScript era => f Word32 RewardAccount -> PlutusPurpose f era
pattern $mAnyEraRewardingPurpose :: forall {r} {era} {f :: * -> * -> *}.
AnyEraScript era =>
PlutusPurpose f era
-> (f Word32 RewardAccount -> r) -> ((# #) -> r) -> r
AnyEraRewardingPurpose c <- (anyEraToRewardingPurpose -> Just c)
pattern AnyEraVotingPurpose ::
AnyEraScript era => f Word32 Voter -> PlutusPurpose f era
pattern $mAnyEraVotingPurpose :: forall {r} {era} {f :: * -> * -> *}.
AnyEraScript era =>
PlutusPurpose f era -> (f Word32 Voter -> r) -> ((# #) -> r) -> r
AnyEraVotingPurpose c <- (anyEraToVotingPurpose -> Just c)
pattern AnyEraProposingPurpose ::
AnyEraScript era => f Word32 (ProposalProcedure era) -> PlutusPurpose f era
pattern $mAnyEraProposingPurpose :: forall {r} {era} {f :: * -> * -> *}.
AnyEraScript era =>
PlutusPurpose f era
-> (f Word32 (ProposalProcedure era) -> r) -> ((# #) -> r) -> r
AnyEraProposingPurpose c <- (anyEraToProposingPurpose -> Just c)
pattern AnyEraGuardingPurpose ::
AnyEraScript era => f Word32 ScriptHash -> PlutusPurpose f era
pattern $mAnyEraGuardingPurpose :: forall {r} {era} {f :: * -> * -> *}.
AnyEraScript era =>
PlutusPurpose f era
-> (f Word32 ScriptHash -> r) -> ((# #) -> r) -> r
AnyEraGuardingPurpose c <- (anyEraToGuardingPurpose -> Just c)
{-# COMPLETE
AnyEraSpendingPurpose
, AnyEraMintingPurpose
, AnyEraCertifyingPurpose
, AnyEraRewardingPurpose
, AnyEraVotingPurpose
, AnyEraProposingPurpose
, AnyEraGuardingPurpose
#-}