{-# 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 (..),

  -- * Any era
  AnyEraScript (..),
  pattern AnyEraSpendingPurpose,
  pattern AnyEraMintingPurpose,
  pattern AnyEraCertifyingPurpose,
  pattern AnyEraRewardingPurpose,
  pattern AnyEraVotingPurpose,
  pattern AnyEraProposingPurpose,
  pattern AnyEraGuardingPurpose,

  -- * Alonzo
  AlonzoEraScript (
    PlutusScript,
    PlutusPurpose,
    toSpendingPurpose,
    toMintingPurpose,
    toCertifyingPurpose,
    toRewardingPurpose
  ),
  isPlutusScript,
  pattern SpendingPurpose,
  pattern MintingPurpose,
  pattern CertifyingPurpose,
  pattern RewardingPurpose,
  CostModels,

  -- * Conway
  ConwayEraScript (
    toVotingPurpose,
    toProposingPurpose
  ),
  pattern VotingPurpose,
  pattern ProposingPurpose,

  -- * Dijkstra
  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
  #-}