{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Conway.Scripts (
  ConwayEraScript (..),
  AlonzoScript (..),
  PlutusScript (..),
  isPlutusScript,
  ConwayPlutusPurpose (..),
  pattern VotingPurpose,
  pattern ProposingPurpose,
)
where

import Cardano.Ledger.Address (RewardAccount)
import Cardano.Ledger.Allegra.Scripts
import Cardano.Ledger.Alonzo.Scripts (
  AlonzoPlutusPurpose (..),
  AlonzoScript (..),
  alonzoScriptPrefixTag,
  isPlutusScript,
 )
import Cardano.Ledger.Babbage.Core
import Cardano.Ledger.Babbage.Scripts (PlutusScript (..))
import Cardano.Ledger.BaseTypes (kindObject)
import Cardano.Ledger.Binary (
  CBORGroup (..),
  DecCBOR (decCBOR),
  DecCBORGroup (..),
  EncCBOR (..),
  EncCBORGroup (..),
  decodeWord8,
  encodeWord8,
 )
import Cardano.Ledger.Conway.Era
import Cardano.Ledger.Conway.Governance.Procedures
import Cardano.Ledger.Conway.TxCert ()
import Cardano.Ledger.Crypto
import Cardano.Ledger.Mary.Value (PolicyID)
import Cardano.Ledger.Plutus.Language
import Cardano.Ledger.SafeHash (SafeToHash (..))
import Cardano.Ledger.Shelley.Scripts (ShelleyEraScript (..))
import Cardano.Ledger.TxIn (TxIn)
import Control.DeepSeq (NFData (..), rwhnf)
import Data.Aeson (ToJSON (..), (.=))
import Data.Typeable
import Data.Word (Word16, Word32, Word8)
import GHC.Generics
import NoThunks.Class (NoThunks (..))

class AlonzoEraScript era => ConwayEraScript era where
  mkVotingPurpose :: f Word32 (Voter (EraCrypto era)) -> PlutusPurpose f era

  toVotingPurpose :: PlutusPurpose f era -> Maybe (f Word32 (Voter (EraCrypto era)))

  mkProposingPurpose :: f Word32 (ProposalProcedure era) -> PlutusPurpose f era

  toProposingPurpose :: PlutusPurpose f era -> Maybe (f Word32 (ProposalProcedure era))

instance Crypto c => EraScript (ConwayEra c) where
  type Script (ConwayEra c) = AlonzoScript (ConwayEra c)
  type NativeScript (ConwayEra c) = Timelock (ConwayEra c)

  upgradeScript :: EraScript (PreviousEra (ConwayEra c)) =>
Script (PreviousEra (ConwayEra c)) -> Script (ConwayEra c)
upgradeScript = \case
    TimelockScript Timelock (BabbageEra c)
ts -> forall era. Timelock era -> AlonzoScript era
TimelockScript forall a b. (a -> b) -> a -> b
$ forall era1 era2.
(Era era1, Era era2, EraCrypto era1 ~ EraCrypto era2) =>
Timelock era1 -> Timelock era2
translateTimelock Timelock (BabbageEra c)
ts
    PlutusScript (BabbagePlutusV1 Plutus 'PlutusV1
ps) -> forall era. PlutusScript era -> AlonzoScript era
PlutusScript forall a b. (a -> b) -> a -> b
$ forall c. Plutus 'PlutusV1 -> PlutusScript (ConwayEra c)
ConwayPlutusV1 Plutus 'PlutusV1
ps
    PlutusScript (BabbagePlutusV2 Plutus 'PlutusV2
ps) -> forall era. PlutusScript era -> AlonzoScript era
PlutusScript forall a b. (a -> b) -> a -> b
$ forall c. Plutus 'PlutusV2 -> PlutusScript (ConwayEra c)
ConwayPlutusV2 Plutus 'PlutusV2
ps

  scriptPrefixTag :: Script (ConwayEra c) -> ByteString
scriptPrefixTag = forall era.
(AlonzoEraScript era, AlonzoScript era ~ Script era) =>
Script era -> ByteString
alonzoScriptPrefixTag

  getNativeScript :: Script (ConwayEra c) -> Maybe (NativeScript (ConwayEra c))
getNativeScript = \case
    TimelockScript Timelock (ConwayEra c)
ts -> forall a. a -> Maybe a
Just Timelock (ConwayEra c)
ts
    Script (ConwayEra c)
_ -> forall a. Maybe a
Nothing

  fromNativeScript :: NativeScript (ConwayEra c) -> Script (ConwayEra c)
fromNativeScript = forall era. Timelock era -> AlonzoScript era
TimelockScript

instance Crypto c => AlonzoEraScript (ConwayEra c) where
  data PlutusScript (ConwayEra c)
    = ConwayPlutusV1 !(Plutus 'PlutusV1)
    | ConwayPlutusV2 !(Plutus 'PlutusV2)
    | ConwayPlutusV3 !(Plutus 'PlutusV3)
    deriving (PlutusScript (ConwayEra c) -> PlutusScript (ConwayEra c) -> Bool
forall c.
PlutusScript (ConwayEra c) -> PlutusScript (ConwayEra c) -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlutusScript (ConwayEra c) -> PlutusScript (ConwayEra c) -> Bool
$c/= :: forall c.
PlutusScript (ConwayEra c) -> PlutusScript (ConwayEra c) -> Bool
== :: PlutusScript (ConwayEra c) -> PlutusScript (ConwayEra c) -> Bool
$c== :: forall c.
PlutusScript (ConwayEra c) -> PlutusScript (ConwayEra c) -> Bool
Eq, PlutusScript (ConwayEra c) -> PlutusScript (ConwayEra c) -> Bool
PlutusScript (ConwayEra c)
-> PlutusScript (ConwayEra c) -> Ordering
forall c. Eq (PlutusScript (ConwayEra c))
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall c.
PlutusScript (ConwayEra c) -> PlutusScript (ConwayEra c) -> Bool
forall c.
PlutusScript (ConwayEra c)
-> PlutusScript (ConwayEra c) -> Ordering
forall c.
PlutusScript (ConwayEra c)
-> PlutusScript (ConwayEra c) -> PlutusScript (ConwayEra c)
min :: PlutusScript (ConwayEra c)
-> PlutusScript (ConwayEra c) -> PlutusScript (ConwayEra c)
$cmin :: forall c.
PlutusScript (ConwayEra c)
-> PlutusScript (ConwayEra c) -> PlutusScript (ConwayEra c)
max :: PlutusScript (ConwayEra c)
-> PlutusScript (ConwayEra c) -> PlutusScript (ConwayEra c)
$cmax :: forall c.
PlutusScript (ConwayEra c)
-> PlutusScript (ConwayEra c) -> PlutusScript (ConwayEra c)
>= :: PlutusScript (ConwayEra c) -> PlutusScript (ConwayEra c) -> Bool
$c>= :: forall c.
PlutusScript (ConwayEra c) -> PlutusScript (ConwayEra c) -> Bool
> :: PlutusScript (ConwayEra c) -> PlutusScript (ConwayEra c) -> Bool
$c> :: forall c.
PlutusScript (ConwayEra c) -> PlutusScript (ConwayEra c) -> Bool
<= :: PlutusScript (ConwayEra c) -> PlutusScript (ConwayEra c) -> Bool
$c<= :: forall c.
PlutusScript (ConwayEra c) -> PlutusScript (ConwayEra c) -> Bool
< :: PlutusScript (ConwayEra c) -> PlutusScript (ConwayEra c) -> Bool
$c< :: forall c.
PlutusScript (ConwayEra c) -> PlutusScript (ConwayEra c) -> Bool
compare :: PlutusScript (ConwayEra c)
-> PlutusScript (ConwayEra c) -> Ordering
$ccompare :: forall c.
PlutusScript (ConwayEra c)
-> PlutusScript (ConwayEra c) -> Ordering
Ord, Int -> PlutusScript (ConwayEra c) -> ShowS
forall c. Int -> PlutusScript (ConwayEra c) -> ShowS
forall c. [PlutusScript (ConwayEra c)] -> ShowS
forall c. PlutusScript (ConwayEra c) -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlutusScript (ConwayEra c)] -> ShowS
$cshowList :: forall c. [PlutusScript (ConwayEra c)] -> ShowS
show :: PlutusScript (ConwayEra c) -> String
$cshow :: forall c. PlutusScript (ConwayEra c) -> String
showsPrec :: Int -> PlutusScript (ConwayEra c) -> ShowS
$cshowsPrec :: forall c. Int -> PlutusScript (ConwayEra c) -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x.
Rep (PlutusScript (ConwayEra c)) x -> PlutusScript (ConwayEra c)
forall c x.
PlutusScript (ConwayEra c) -> Rep (PlutusScript (ConwayEra c)) x
$cto :: forall c x.
Rep (PlutusScript (ConwayEra c)) x -> PlutusScript (ConwayEra c)
$cfrom :: forall c x.
PlutusScript (ConwayEra c) -> Rep (PlutusScript (ConwayEra c)) x
Generic)

  type PlutusPurpose f (ConwayEra c) = ConwayPlutusPurpose f (ConwayEra c)

  eraMaxLanguage :: Language
eraMaxLanguage = Language
PlutusV3

  mkPlutusScript :: forall (l :: Language).
PlutusLanguage l =>
Plutus l -> Maybe (PlutusScript (ConwayEra c))
mkPlutusScript Plutus l
plutus =
    case forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> SLanguage l
plutusSLanguage Plutus l
plutus of
      SLanguage l
SPlutusV1 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c. Plutus 'PlutusV1 -> PlutusScript (ConwayEra c)
ConwayPlutusV1 Plutus l
plutus
      SLanguage l
SPlutusV2 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c. Plutus 'PlutusV2 -> PlutusScript (ConwayEra c)
ConwayPlutusV2 Plutus l
plutus
      SLanguage l
SPlutusV3 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c. Plutus 'PlutusV3 -> PlutusScript (ConwayEra c)
ConwayPlutusV3 Plutus l
plutus

  withPlutusScript :: forall a.
PlutusScript (ConwayEra c)
-> (forall (l :: Language). PlutusLanguage l => Plutus l -> a) -> a
withPlutusScript (ConwayPlutusV1 Plutus 'PlutusV1
plutus) forall (l :: Language). PlutusLanguage l => Plutus l -> a
f = forall (l :: Language). PlutusLanguage l => Plutus l -> a
f Plutus 'PlutusV1
plutus
  withPlutusScript (ConwayPlutusV2 Plutus 'PlutusV2
plutus) forall (l :: Language). PlutusLanguage l => Plutus l -> a
f = forall (l :: Language). PlutusLanguage l => Plutus l -> a
f Plutus 'PlutusV2
plutus
  withPlutusScript (ConwayPlutusV3 Plutus 'PlutusV3
plutus) forall (l :: Language). PlutusLanguage l => Plutus l -> a
f = forall (l :: Language). PlutusLanguage l => Plutus l -> a
f Plutus 'PlutusV3
plutus

  hoistPlutusPurpose :: forall (g :: * -> * -> *) (f :: * -> * -> *).
(forall ix it. g ix it -> f ix it)
-> PlutusPurpose g (ConwayEra c) -> PlutusPurpose f (ConwayEra c)
hoistPlutusPurpose forall ix it. g ix it -> f ix it
f = \case
    ConwaySpending g Word32 (TxIn (EraCrypto (ConwayEra c)))
x -> forall (f :: * -> * -> *) era.
f Word32 (TxIn (EraCrypto era)) -> ConwayPlutusPurpose f era
ConwaySpending forall a b. (a -> b) -> a -> b
$ forall ix it. g ix it -> f ix it
f g Word32 (TxIn (EraCrypto (ConwayEra c)))
x
    ConwayMinting g Word32 (PolicyID (EraCrypto (ConwayEra c)))
x -> forall (f :: * -> * -> *) era.
f Word32 (PolicyID (EraCrypto era)) -> ConwayPlutusPurpose f era
ConwayMinting forall a b. (a -> b) -> a -> b
$ forall ix it. g ix it -> f ix it
f g Word32 (PolicyID (EraCrypto (ConwayEra c)))
x
    ConwayCertifying g Word32 (TxCert (ConwayEra c))
x -> forall (f :: * -> * -> *) era.
f Word32 (TxCert era) -> ConwayPlutusPurpose f era
ConwayCertifying forall a b. (a -> b) -> a -> b
$ forall ix it. g ix it -> f ix it
f g Word32 (TxCert (ConwayEra c))
x
    ConwayRewarding g Word32 (RewardAccount (EraCrypto (ConwayEra c)))
x -> forall (f :: * -> * -> *) era.
f Word32 (RewardAccount (EraCrypto era))
-> ConwayPlutusPurpose f era
ConwayRewarding forall a b. (a -> b) -> a -> b
$ forall ix it. g ix it -> f ix it
f g Word32 (RewardAccount (EraCrypto (ConwayEra c)))
x
    ConwayVoting g Word32 (Voter (EraCrypto (ConwayEra c)))
x -> forall (f :: * -> * -> *) era.
f Word32 (Voter (EraCrypto era)) -> ConwayPlutusPurpose f era
ConwayVoting forall a b. (a -> b) -> a -> b
$ forall ix it. g ix it -> f ix it
f g Word32 (Voter (EraCrypto (ConwayEra c)))
x
    ConwayProposing g Word32 (ProposalProcedure (ConwayEra c))
x -> forall (f :: * -> * -> *) era.
f Word32 (ProposalProcedure era) -> ConwayPlutusPurpose f era
ConwayProposing forall a b. (a -> b) -> a -> b
$ forall ix it. g ix it -> f ix it
f g Word32 (ProposalProcedure (ConwayEra c))
x

  mkSpendingPurpose :: forall (f :: * -> * -> *).
f Word32 (TxIn (EraCrypto (ConwayEra c)))
-> PlutusPurpose f (ConwayEra c)
mkSpendingPurpose = forall (f :: * -> * -> *) era.
f Word32 (TxIn (EraCrypto era)) -> ConwayPlutusPurpose f era
ConwaySpending

  toSpendingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f (ConwayEra c)
-> Maybe (f Word32 (TxIn (EraCrypto (ConwayEra c))))
toSpendingPurpose (ConwaySpending f Word32 (TxIn (EraCrypto (ConwayEra c)))
i) = forall a. a -> Maybe a
Just f Word32 (TxIn (EraCrypto (ConwayEra c)))
i
  toSpendingPurpose PlutusPurpose f (ConwayEra c)
_ = forall a. Maybe a
Nothing

  mkMintingPurpose :: forall (f :: * -> * -> *).
f Word32 (PolicyID (EraCrypto (ConwayEra c)))
-> PlutusPurpose f (ConwayEra c)
mkMintingPurpose = forall (f :: * -> * -> *) era.
f Word32 (PolicyID (EraCrypto era)) -> ConwayPlutusPurpose f era
ConwayMinting

  toMintingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f (ConwayEra c)
-> Maybe (f Word32 (PolicyID (EraCrypto (ConwayEra c))))
toMintingPurpose (ConwayMinting f Word32 (PolicyID (EraCrypto (ConwayEra c)))
i) = forall a. a -> Maybe a
Just f Word32 (PolicyID (EraCrypto (ConwayEra c)))
i
  toMintingPurpose PlutusPurpose f (ConwayEra c)
_ = forall a. Maybe a
Nothing

  mkCertifyingPurpose :: forall (f :: * -> * -> *).
f Word32 (TxCert (ConwayEra c)) -> PlutusPurpose f (ConwayEra c)
mkCertifyingPurpose = forall (f :: * -> * -> *) era.
f Word32 (TxCert era) -> ConwayPlutusPurpose f era
ConwayCertifying

  toCertifyingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f (ConwayEra c)
-> Maybe (f Word32 (TxCert (ConwayEra c)))
toCertifyingPurpose (ConwayCertifying f Word32 (TxCert (ConwayEra c))
i) = forall a. a -> Maybe a
Just f Word32 (TxCert (ConwayEra c))
i
  toCertifyingPurpose PlutusPurpose f (ConwayEra c)
_ = forall a. Maybe a
Nothing

  mkRewardingPurpose :: forall (f :: * -> * -> *).
f Word32 (RewardAccount (EraCrypto (ConwayEra c)))
-> PlutusPurpose f (ConwayEra c)
mkRewardingPurpose = forall (f :: * -> * -> *) era.
f Word32 (RewardAccount (EraCrypto era))
-> ConwayPlutusPurpose f era
ConwayRewarding

  toRewardingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f (ConwayEra c)
-> Maybe (f Word32 (RewardAccount (EraCrypto (ConwayEra c))))
toRewardingPurpose (ConwayRewarding f Word32 (RewardAccount (EraCrypto (ConwayEra c)))
i) = forall a. a -> Maybe a
Just f Word32 (RewardAccount (EraCrypto (ConwayEra c)))
i
  toRewardingPurpose PlutusPurpose f (ConwayEra c)
_ = forall a. Maybe a
Nothing

  upgradePlutusPurposeAsIx :: AlonzoEraScript (PreviousEra (ConwayEra c)) =>
PlutusPurpose AsIx (PreviousEra (ConwayEra c))
-> PlutusPurpose AsIx (ConwayEra c)
upgradePlutusPurposeAsIx = \case
    AlonzoSpending (AsIx Word32
ix) -> forall (f :: * -> * -> *) era.
f Word32 (TxIn (EraCrypto era)) -> ConwayPlutusPurpose f era
ConwaySpending (forall ix it. ix -> AsIx ix it
AsIx Word32
ix)
    AlonzoMinting (AsIx Word32
ix) -> forall (f :: * -> * -> *) era.
f Word32 (PolicyID (EraCrypto era)) -> ConwayPlutusPurpose f era
ConwayMinting (forall ix it. ix -> AsIx ix it
AsIx Word32
ix)
    AlonzoCertifying (AsIx Word32
ix) -> forall (f :: * -> * -> *) era.
f Word32 (TxCert era) -> ConwayPlutusPurpose f era
ConwayCertifying (forall ix it. ix -> AsIx ix it
AsIx Word32
ix)
    AlonzoRewarding (AsIx Word32
ix) -> forall (f :: * -> * -> *) era.
f Word32 (RewardAccount (EraCrypto era))
-> ConwayPlutusPurpose f era
ConwayRewarding (forall ix it. ix -> AsIx ix it
AsIx Word32
ix)

instance Crypto c => ConwayEraScript (ConwayEra c) where
  {-# SPECIALIZE instance ConwayEraScript (ConwayEra StandardCrypto) #-}

  mkVotingPurpose :: forall (f :: * -> * -> *).
f Word32 (Voter (EraCrypto (ConwayEra c)))
-> PlutusPurpose f (ConwayEra c)
mkVotingPurpose = forall (f :: * -> * -> *) era.
f Word32 (Voter (EraCrypto era)) -> ConwayPlutusPurpose f era
ConwayVoting

  toVotingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f (ConwayEra c)
-> Maybe (f Word32 (Voter (EraCrypto (ConwayEra c))))
toVotingPurpose (ConwayVoting f Word32 (Voter (EraCrypto (ConwayEra c)))
i) = forall a. a -> Maybe a
Just f Word32 (Voter (EraCrypto (ConwayEra c)))
i
  toVotingPurpose PlutusPurpose f (ConwayEra c)
_ = forall a. Maybe a
Nothing

  mkProposingPurpose :: forall (f :: * -> * -> *).
f Word32 (ProposalProcedure (ConwayEra c))
-> PlutusPurpose f (ConwayEra c)
mkProposingPurpose = forall (f :: * -> * -> *) era.
f Word32 (ProposalProcedure era) -> ConwayPlutusPurpose f era
ConwayProposing

  toProposingPurpose :: forall (f :: * -> * -> *).
PlutusPurpose f (ConwayEra c)
-> Maybe (f Word32 (ProposalProcedure (ConwayEra c)))
toProposingPurpose (ConwayProposing f Word32 (ProposalProcedure (ConwayEra c))
i) = forall a. a -> Maybe a
Just f Word32 (ProposalProcedure (ConwayEra c))
i
  toProposingPurpose PlutusPurpose f (ConwayEra c)
_ = forall a. Maybe a
Nothing

instance Crypto c => ShelleyEraScript (ConwayEra c) where
  {-# SPECIALIZE instance ShelleyEraScript (ConwayEra StandardCrypto) #-}

  mkRequireSignature :: KeyHash 'Witness (EraCrypto (ConwayEra c))
-> NativeScript (ConwayEra c)
mkRequireSignature = forall era.
Era era =>
KeyHash 'Witness (EraCrypto era) -> Timelock era
mkRequireSignatureTimelock
  getRequireSignature :: NativeScript (ConwayEra c)
-> Maybe (KeyHash 'Witness (EraCrypto (ConwayEra c)))
getRequireSignature = forall era.
Era era =>
Timelock era -> Maybe (KeyHash 'Witness (EraCrypto era))
getRequireSignatureTimelock

  mkRequireAllOf :: StrictSeq (NativeScript (ConwayEra c))
-> NativeScript (ConwayEra c)
mkRequireAllOf = forall era. Era era => StrictSeq (Timelock era) -> Timelock era
mkRequireAllOfTimelock
  getRequireAllOf :: NativeScript (ConwayEra c)
-> Maybe (StrictSeq (NativeScript (ConwayEra c)))
getRequireAllOf = forall era.
Era era =>
Timelock era -> Maybe (StrictSeq (Timelock era))
getRequireAllOfTimelock

  mkRequireAnyOf :: StrictSeq (NativeScript (ConwayEra c))
-> NativeScript (ConwayEra c)
mkRequireAnyOf = forall era. Era era => StrictSeq (Timelock era) -> Timelock era
mkRequireAnyOfTimelock
  getRequireAnyOf :: NativeScript (ConwayEra c)
-> Maybe (StrictSeq (NativeScript (ConwayEra c)))
getRequireAnyOf = forall era.
Era era =>
Timelock era -> Maybe (StrictSeq (Timelock era))
getRequireAnyOfTimelock

  mkRequireMOf :: Int
-> StrictSeq (NativeScript (ConwayEra c))
-> NativeScript (ConwayEra c)
mkRequireMOf = forall era.
Era era =>
Int -> StrictSeq (Timelock era) -> Timelock era
mkRequireMOfTimelock
  getRequireMOf :: NativeScript (ConwayEra c)
-> Maybe (Int, StrictSeq (NativeScript (ConwayEra c)))
getRequireMOf = forall era.
Era era =>
Timelock era -> Maybe (Int, StrictSeq (Timelock era))
getRequireMOfTimelock

instance Crypto c => AllegraEraScript (ConwayEra c) where
  {-# SPECIALIZE instance AllegraEraScript (ConwayEra StandardCrypto) #-}

  mkTimeStart :: SlotNo -> NativeScript (ConwayEra c)
mkTimeStart = forall era. Era era => SlotNo -> Timelock era
mkTimeStartTimelock
  getTimeStart :: NativeScript (ConwayEra c) -> Maybe SlotNo
getTimeStart = forall era. Era era => Timelock era -> Maybe SlotNo
getTimeStartTimelock

  mkTimeExpire :: SlotNo -> NativeScript (ConwayEra c)
mkTimeExpire = forall era. Era era => SlotNo -> Timelock era
mkTimeExpireTimelock
  getTimeExpire :: NativeScript (ConwayEra c) -> Maybe SlotNo
getTimeExpire = forall era. Era era => Timelock era -> Maybe SlotNo
getTimeExpireTimelock

instance NFData (PlutusScript (ConwayEra c)) where
  rnf :: PlutusScript (ConwayEra c) -> ()
rnf = forall a. a -> ()
rwhnf
instance NoThunks (PlutusScript (ConwayEra c))
instance Crypto c => SafeToHash (PlutusScript (ConwayEra c)) where
  originalBytes :: PlutusScript (ConwayEra c) -> ByteString
originalBytes PlutusScript (ConwayEra c)
ps = forall era a.
AlonzoEraScript era =>
PlutusScript era
-> (forall (l :: Language). PlutusLanguage l => Plutus l -> a) -> a
withPlutusScript PlutusScript (ConwayEra c)
ps forall t. SafeToHash t => t -> ByteString
originalBytes

data ConwayPlutusPurpose f era
  = ConwaySpending !(f Word32 (TxIn (EraCrypto era)))
  | ConwayMinting !(f Word32 (PolicyID (EraCrypto era)))
  | ConwayCertifying !(f Word32 (TxCert era))
  | ConwayRewarding !(f Word32 (RewardAccount (EraCrypto era)))
  | ConwayVoting !(f Word32 (Voter (EraCrypto era)))
  | ConwayProposing !(f Word32 (ProposalProcedure era))
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> * -> *) era x.
Rep (ConwayPlutusPurpose f era) x -> ConwayPlutusPurpose f era
forall (f :: * -> * -> *) era x.
ConwayPlutusPurpose f era -> Rep (ConwayPlutusPurpose f era) x
$cto :: forall (f :: * -> * -> *) era x.
Rep (ConwayPlutusPurpose f era) x -> ConwayPlutusPurpose f era
$cfrom :: forall (f :: * -> * -> *) era x.
ConwayPlutusPurpose f era -> Rep (ConwayPlutusPurpose f era) x
Generic)

deriving instance Eq (ConwayPlutusPurpose AsIx era)
deriving instance Ord (ConwayPlutusPurpose AsIx era)
deriving instance Show (ConwayPlutusPurpose AsIx era)
instance NoThunks (ConwayPlutusPurpose AsIx era)

deriving instance (Eq (TxCert era), EraPParams era) => Eq (ConwayPlutusPurpose AsItem era)
deriving instance (Show (TxCert era), EraPParams era) => Show (ConwayPlutusPurpose AsItem era)
instance (NoThunks (TxCert era), EraPParams era) => NoThunks (ConwayPlutusPurpose AsItem era)
deriving via
  (CBORGroup (ConwayPlutusPurpose f era))
  instance
    ( forall a b. (EncCBOR a, EncCBOR b) => EncCBOR (f a b)
    , EraPParams era
    , Typeable f
    , EncCBOR (TxCert era)
    ) =>
    EncCBOR (ConwayPlutusPurpose f era)
deriving via
  (CBORGroup (ConwayPlutusPurpose f era))
  instance
    ( forall a b. (EncCBOR a, EncCBOR b) => EncCBOR (f a b)
    , forall a b. (DecCBOR a, DecCBOR b) => DecCBOR (f a b)
    , EraPParams era
    , Typeable f
    , EncCBOR (TxCert era)
    , DecCBOR (TxCert era)
    ) =>
    DecCBOR (ConwayPlutusPurpose f era)

deriving instance (Eq (TxCert era), EraPParams era) => Eq (ConwayPlutusPurpose AsIxItem era)
deriving instance (Show (TxCert era), EraPParams era) => Show (ConwayPlutusPurpose AsIxItem era)
instance (NoThunks (TxCert era), EraPParams era) => NoThunks (ConwayPlutusPurpose AsIxItem era)

instance
  (forall a b. (NFData a, NFData b) => NFData (f a b), NFData (TxCert era), EraPParams era) =>
  NFData (ConwayPlutusPurpose f era)
  where
  rnf :: ConwayPlutusPurpose f era -> ()
rnf = \case
    ConwaySpending f Word32 (TxIn (EraCrypto era))
x -> forall a. NFData a => a -> ()
rnf f Word32 (TxIn (EraCrypto era))
x
    ConwayMinting f Word32 (PolicyID (EraCrypto era))
x -> forall a. NFData a => a -> ()
rnf f Word32 (PolicyID (EraCrypto era))
x
    ConwayCertifying f Word32 (TxCert era)
x -> forall a. NFData a => a -> ()
rnf f Word32 (TxCert era)
x
    ConwayRewarding f Word32 (RewardAccount (EraCrypto era))
x -> forall a. NFData a => a -> ()
rnf f Word32 (RewardAccount (EraCrypto era))
x
    ConwayVoting f Word32 (Voter (EraCrypto era))
x -> forall a. NFData a => a -> ()
rnf f Word32 (Voter (EraCrypto era))
x
    ConwayProposing f Word32 (ProposalProcedure era)
x -> forall a. NFData a => a -> ()
rnf f Word32 (ProposalProcedure era)
x

instance
  ( forall a b. (EncCBOR a, EncCBOR b) => EncCBOR (f a b)
  , EraPParams era
  , Typeable f
  , EncCBOR (TxCert era)
  ) =>
  EncCBORGroup (ConwayPlutusPurpose f era)
  where
  listLen :: ConwayPlutusPurpose f era -> Word
listLen ConwayPlutusPurpose f era
_ = Word
2
  listLenBound :: Proxy (ConwayPlutusPurpose f era) -> Word
listLenBound Proxy (ConwayPlutusPurpose f era)
_ = Word
2
  encCBORGroup :: ConwayPlutusPurpose f era -> Encoding
encCBORGroup = \case
    ConwaySpending f Word32 (TxIn (EraCrypto era))
p -> Word8 -> Encoding
encodeWord8 Word8
0 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR f Word32 (TxIn (EraCrypto era))
p
    ConwayMinting f Word32 (PolicyID (EraCrypto era))
p -> Word8 -> Encoding
encodeWord8 Word8
1 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR f Word32 (PolicyID (EraCrypto era))
p
    ConwayCertifying f Word32 (TxCert era)
p -> Word8 -> Encoding
encodeWord8 Word8
2 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR f Word32 (TxCert era)
p
    ConwayRewarding f Word32 (RewardAccount (EraCrypto era))
p -> Word8 -> Encoding
encodeWord8 Word8
3 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR f Word32 (RewardAccount (EraCrypto era))
p
    ConwayVoting f Word32 (Voter (EraCrypto era))
p -> Word8 -> Encoding
encodeWord8 Word8
4 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR f Word32 (Voter (EraCrypto era))
p
    ConwayProposing f Word32 (ProposalProcedure era)
p -> Word8 -> Encoding
encodeWord8 Word8
5 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR f Word32 (ProposalProcedure era)
p
  encodedGroupSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (ConwayPlutusPurpose f era) -> Size
encodedGroupSizeExpr forall t. EncCBOR t => Proxy t -> Size
size_ Proxy (ConwayPlutusPurpose f era)
_proxy =
    forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size_ (forall {k} (t :: k). Proxy t
Proxy :: Proxy Word8)
      forall a. Num a => a -> a -> a
+ forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size_ (forall {k} (t :: k). Proxy t
Proxy :: Proxy Word16)

instance
  ( forall a b. (DecCBOR a, DecCBOR b) => DecCBOR (f a b)
  , EraPParams era
  , Typeable f
  , DecCBOR (TxCert era)
  ) =>
  DecCBORGroup (ConwayPlutusPurpose f era)
  where
  decCBORGroup :: forall s. Decoder s (ConwayPlutusPurpose f era)
decCBORGroup =
    forall s. Decoder s Word8
decodeWord8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Word8
0 -> forall (f :: * -> * -> *) era.
f Word32 (TxIn (EraCrypto era)) -> ConwayPlutusPurpose f era
ConwaySpending forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
      Word8
1 -> forall (f :: * -> * -> *) era.
f Word32 (PolicyID (EraCrypto era)) -> ConwayPlutusPurpose f era
ConwayMinting forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
      Word8
2 -> forall (f :: * -> * -> *) era.
f Word32 (TxCert era) -> ConwayPlutusPurpose f era
ConwayCertifying forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
      Word8
3 -> forall (f :: * -> * -> *) era.
f Word32 (RewardAccount (EraCrypto era))
-> ConwayPlutusPurpose f era
ConwayRewarding forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
      Word8
4 -> forall (f :: * -> * -> *) era.
f Word32 (Voter (EraCrypto era)) -> ConwayPlutusPurpose f era
ConwayVoting forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
      Word8
5 -> forall (f :: * -> * -> *) era.
f Word32 (ProposalProcedure era) -> ConwayPlutusPurpose f era
ConwayProposing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
      Word8
n -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unexpected tag for ConwayPlutusPurpose: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Word8
n

instance
  ( forall a b. (ToJSON a, ToJSON b) => ToJSON (f a b)
  , ToJSON (TxCert era)
  , EraPParams era
  ) =>
  ToJSON (ConwayPlutusPurpose f era)
  where
  toJSON :: ConwayPlutusPurpose f era -> Value
toJSON = \case
    ConwaySpending f Word32 (TxIn (EraCrypto era))
n -> forall {v}. ToJSON v => Text -> v -> Value
kindObjectWithValue Text
"ConwaySpending" f Word32 (TxIn (EraCrypto era))
n
    ConwayMinting f Word32 (PolicyID (EraCrypto era))
n -> forall {v}. ToJSON v => Text -> v -> Value
kindObjectWithValue Text
"ConwayMinting" f Word32 (PolicyID (EraCrypto era))
n
    ConwayCertifying f Word32 (TxCert era)
n -> forall {v}. ToJSON v => Text -> v -> Value
kindObjectWithValue Text
"ConwayCertifying" f Word32 (TxCert era)
n
    ConwayRewarding f Word32 (RewardAccount (EraCrypto era))
n -> forall {v}. ToJSON v => Text -> v -> Value
kindObjectWithValue Text
"ConwayRewarding" f Word32 (RewardAccount (EraCrypto era))
n
    ConwayVoting f Word32 (Voter (EraCrypto era))
n -> forall {v}. ToJSON v => Text -> v -> Value
kindObjectWithValue Text
"ConwayVoting" f Word32 (Voter (EraCrypto era))
n
    ConwayProposing f Word32 (ProposalProcedure era)
n -> forall {v}. ToJSON v => Text -> v -> Value
kindObjectWithValue Text
"ConwayProposing" f Word32 (ProposalProcedure era)
n
    where
      kindObjectWithValue :: Text -> v -> Value
kindObjectWithValue Text
name v
n = Text -> [Pair] -> Value
kindObject Text
name [Key
"value" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= v
n]

pattern VotingPurpose ::
  ConwayEraScript era => f Word32 (Voter (EraCrypto era)) -> PlutusPurpose f era
pattern $bVotingPurpose :: forall era (f :: * -> * -> *).
ConwayEraScript era =>
f Word32 (Voter (EraCrypto era)) -> PlutusPurpose f era
$mVotingPurpose :: forall {r} {era} {f :: * -> * -> *}.
ConwayEraScript era =>
PlutusPurpose f era
-> (f Word32 (Voter (EraCrypto era)) -> r) -> ((# #) -> r) -> r
VotingPurpose c <- (toVotingPurpose -> Just c)
  where
    VotingPurpose f Word32 (Voter (EraCrypto era))
c = forall era (f :: * -> * -> *).
ConwayEraScript era =>
f Word32 (Voter (EraCrypto era)) -> PlutusPurpose f era
mkVotingPurpose f Word32 (Voter (EraCrypto era))
c

pattern ProposingPurpose ::
  ConwayEraScript era => f Word32 (ProposalProcedure era) -> PlutusPurpose f era
pattern $bProposingPurpose :: forall era (f :: * -> * -> *).
ConwayEraScript era =>
f Word32 (ProposalProcedure era) -> PlutusPurpose f era
$mProposingPurpose :: forall {r} {era} {f :: * -> * -> *}.
ConwayEraScript era =>
PlutusPurpose f era
-> (f Word32 (ProposalProcedure era) -> r) -> ((# #) -> r) -> r
ProposingPurpose c <- (toProposingPurpose -> Just c)
  where
    ProposingPurpose f Word32 (ProposalProcedure era)
c = forall era (f :: * -> * -> *).
ConwayEraScript era =>
f Word32 (ProposalProcedure era) -> PlutusPurpose f era
mkProposingPurpose f Word32 (ProposalProcedure era)
c