{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Alonzo.Scripts (
  PlutusBinary (..),
  AlonzoScript (TimelockScript, PlutusScript),
  Script,
  isPlutusScript,
  validScript,
  eqAlonzoScriptRaw,
  AlonzoEraScript (..),
  eraLanguages,
  PlutusScript (..),
  withPlutusScriptLanguage,
  plutusScriptLanguage,
  decodePlutusScript,
  plutusScriptBinary,
  mkBinaryPlutusScript,
  isValidPlutusScript,
  toPlutusSLanguage,
  alonzoScriptPrefixTag,
  lookupPlutusScript,

  -- ** Plutus Purpose
  pattern SpendingPurpose,
  pattern MintingPurpose,
  pattern CertifyingPurpose,
  pattern RewardingPurpose,
  AlonzoPlutusPurpose (..),
  AsItem (..),
  AsIx (..),
  AsIxItem (..),
  toAsItem,
  toAsIx,

  -- * Re-exports
  module Cardano.Ledger.Plutus.CostModels,
  module Cardano.Ledger.Plutus.ExUnits,
)
where

import Cardano.Ledger.Address (RewardAccount)
import Cardano.Ledger.Allegra.Scripts
import Cardano.Ledger.Alonzo.Era (AlonzoEra)
import Cardano.Ledger.Alonzo.TxCert ()
import Cardano.Ledger.BaseTypes (ProtVer (..), kindObject)
import Cardano.Ledger.Binary (
  Annotator,
  DecCBOR (decCBOR),
  DecCBORGroup (..),
  Decoder,
  EncCBOR (..),
  EncCBORGroup (..),
  ToCBOR (toCBOR),
  Version,
  decodeWord8,
  encodeWord8,
 )
import Cardano.Ledger.Binary.Coders (
  Decode (Ann, D, From, Invalid, SumD, Summands),
  Encode (Sum, To),
  Wrapped (..),
  decode,
  encode,
  (!>),
  (<!),
  (<*!),
 )
import Cardano.Ledger.Binary.Plain (serializeAsHexText)
import Cardano.Ledger.Core
import Cardano.Ledger.Crypto (Crypto, StandardCrypto)
import Cardano.Ledger.Mary.Value (PolicyID)
import Cardano.Ledger.MemoBytes (EqRaw (..))
import Cardano.Ledger.Plutus.CostModels
import Cardano.Ledger.Plutus.ExUnits
import Cardano.Ledger.Plutus.Language (
  Language (..),
  Plutus (..),
  PlutusBinary (..),
  PlutusLanguage (..),
  SLanguage (..),
  asSLanguage,
  isValidPlutus,
  plutusLanguage,
  plutusSLanguage,
  withSLanguage,
 )
import Cardano.Ledger.SafeHash (SafeToHash (..))
import Cardano.Ledger.Shelley.Scripts (ShelleyEraScript (..), nativeMultiSigTag)
import Cardano.Ledger.TxIn (TxIn)
import Control.DeepSeq (NFData (..), deepseq)
import Control.Monad (guard, (>=>))
import Data.Aeson (ToJSON (..), Value (String), object, (.=))
import qualified Data.ByteString as BS
import Data.Kind (Type)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromJust, isJust)
import Data.Typeable
import Data.Word (Word16, Word32, Word8)
import GHC.Generics (Generic)
import GHC.Stack
import NoThunks.Class (NoThunks (..))

class
  ( EraScript era
  , Eq (PlutusScript era)
  , Ord (PlutusScript era)
  , Show (PlutusScript era)
  , NoThunks (PlutusScript era)
  , NFData (PlutusScript era)
  , SafeToHash (PlutusScript era)
  , Eq (PlutusPurpose AsItem era)
  , Show (PlutusPurpose AsItem era)
  , EncCBOR (PlutusPurpose AsItem era)
  , DecCBOR (PlutusPurpose AsItem era)
  , NoThunks (PlutusPurpose AsItem era)
  , NFData (PlutusPurpose AsItem era)
  , Eq (PlutusPurpose AsIx era)
  , Ord (PlutusPurpose AsIx era)
  , Show (PlutusPurpose AsIx era)
  , EncCBOR (PlutusPurpose AsIx era)
  , DecCBOR (PlutusPurpose AsIx era)
  , EncCBORGroup (PlutusPurpose AsIx era)
  , DecCBORGroup (PlutusPurpose AsIx era)
  , NoThunks (PlutusPurpose AsIx era)
  , NFData (PlutusPurpose AsIx era)
  , Eq (PlutusPurpose AsIxItem era)
  , Show (PlutusPurpose AsIxItem era)
  , NoThunks (PlutusPurpose AsIxItem era)
  , NFData (PlutusPurpose AsIxItem era)
  , AllegraEraScript era
  ) =>
  AlonzoEraScript era
  where
  data PlutusScript era :: Type

  type PlutusPurpose (f :: Type -> Type -> Type) era = (r :: Type) | r -> era

  -- | Highest supported Plutus language version for this era.
  eraMaxLanguage :: Language

  -- | Attempt to extract a `PlutusScript` from a wrapper type family `Script`. Whenevr
  -- `Script` is a native script `Nothing` will be returned
  toPlutusScript :: Script era -> Maybe (PlutusScript era)
  default toPlutusScript :: Script era ~ AlonzoScript era => Script era -> Maybe (PlutusScript era)
  toPlutusScript = \case
    PlutusScript PlutusScript era
ps -> forall a. a -> Maybe a
Just PlutusScript era
ps
    Script era
_ -> forall a. Maybe a
Nothing

  -- | Convert a `PlutusScript` to a wrapper type family `Script`
  fromPlutusScript :: PlutusScript era -> Script era
  default fromPlutusScript :: Script era ~ AlonzoScript era => PlutusScript era -> Script era
  fromPlutusScript = forall era. PlutusScript era -> AlonzoScript era
PlutusScript

  -- | Returns Nothing, whenver plutus language is not supported for this era.
  mkPlutusScript :: PlutusLanguage l => Plutus l -> Maybe (PlutusScript era)

  -- | Give a `PlutusScript` apply a function that can handle `Plutus` scripts of all
  -- known versions.
  withPlutusScript ::
    PlutusScript era ->
    (forall l. PlutusLanguage l => Plutus l -> a) ->
    a

  hoistPlutusPurpose ::
    (forall ix it. g ix it -> f ix it) ->
    PlutusPurpose g era ->
    PlutusPurpose f era

  mkSpendingPurpose :: f Word32 (TxIn (EraCrypto era)) -> PlutusPurpose f era

  toSpendingPurpose :: PlutusPurpose f era -> Maybe (f Word32 (TxIn (EraCrypto era)))

  mkMintingPurpose :: f Word32 (PolicyID (EraCrypto era)) -> PlutusPurpose f era

  toMintingPurpose :: PlutusPurpose f era -> Maybe (f Word32 (PolicyID (EraCrypto era)))

  mkCertifyingPurpose :: f Word32 (TxCert era) -> PlutusPurpose f era

  toCertifyingPurpose :: PlutusPurpose f era -> Maybe (f Word32 (TxCert era))

  mkRewardingPurpose :: f Word32 (RewardAccount (EraCrypto era)) -> PlutusPurpose f era

  toRewardingPurpose :: PlutusPurpose f era -> Maybe (f Word32 (RewardAccount (EraCrypto era)))

  upgradePlutusPurposeAsIx ::
    AlonzoEraScript (PreviousEra era) =>
    PlutusPurpose AsIx (PreviousEra era) ->
    PlutusPurpose AsIx era

mkBinaryPlutusScript :: AlonzoEraScript era => Language -> PlutusBinary -> Maybe (PlutusScript era)
mkBinaryPlutusScript :: forall era.
AlonzoEraScript era =>
Language -> PlutusBinary -> Maybe (PlutusScript era)
mkBinaryPlutusScript Language
lang PlutusBinary
pb = forall a.
Language
-> (forall (l :: Language). PlutusLanguage l => SLanguage l -> a)
-> a
withSLanguage Language
lang (forall era (l :: Language).
(AlonzoEraScript era, PlutusLanguage l) =>
Plutus l -> Maybe (PlutusScript era)
mkPlutusScript forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (l :: Language) (proxy :: Language -> *).
SLanguage l -> proxy l -> proxy l
`asSLanguage` forall (l :: Language). PlutusBinary -> Plutus l
Plutus PlutusBinary
pb))

-- | Apply a function to a plutus script, but only if it is of expected language version,
-- otherwise it will return Nothing.
withPlutusScriptLanguage ::
  AlonzoEraScript era =>
  Language ->
  PlutusScript era ->
  (forall l. PlutusLanguage l => Plutus l -> a) ->
  Maybe a
withPlutusScriptLanguage :: forall era a.
AlonzoEraScript era =>
Language
-> PlutusScript era
-> (forall (l :: Language). PlutusLanguage l => Plutus l -> a)
-> Maybe a
withPlutusScriptLanguage Language
lang PlutusScript era
ps forall (l :: Language). PlutusLanguage l => Plutus l -> a
f =
  forall era a.
AlonzoEraScript era =>
PlutusScript era
-> (forall (l :: Language). PlutusLanguage l => Plutus l -> a) -> a
withPlutusScript PlutusScript era
ps forall a b. (a -> b) -> a -> b
$ \Plutus l
plutus ->
    forall (l :: Language). PlutusLanguage l => Plutus l -> a
f Plutus l
plutus forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage Plutus l
plutus forall a. Eq a => a -> a -> Bool
== Language
lang)

-- | Attempt to extract the version aware `Plutus` script, but only if it matches the
-- language version supplied. This is useful whenever the version is known by some other
-- means.
toPlutusSLanguage ::
  forall l era.
  (PlutusLanguage l, AlonzoEraScript era) =>
  SLanguage l ->
  PlutusScript era ->
  Maybe (Plutus l)
toPlutusSLanguage :: forall (l :: Language) era.
(PlutusLanguage l, AlonzoEraScript era) =>
SLanguage l -> PlutusScript era -> Maybe (Plutus l)
toPlutusSLanguage SLanguage l
_ PlutusScript era
ps = forall era a.
AlonzoEraScript era =>
PlutusScript era
-> (forall (l :: Language). PlutusLanguage l => Plutus l -> a) -> a
withPlutusScript PlutusScript era
ps forall {k} (a :: k) (b :: k) (c :: k -> *).
(Typeable a, Typeable b) =>
c a -> Maybe (c b)
gcast

-- | Get value level plutus language of the plutus script
plutusScriptLanguage :: AlonzoEraScript era => PlutusScript era -> Language
plutusScriptLanguage :: forall era. AlonzoEraScript era => PlutusScript era -> Language
plutusScriptLanguage PlutusScript era
ps = forall era a.
AlonzoEraScript era =>
PlutusScript era
-> (forall (l :: Language). PlutusLanguage l => Plutus l -> a) -> a
withPlutusScript PlutusScript era
ps forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage

-- | Extract binary representation of the script.
plutusScriptBinary :: AlonzoEraScript era => PlutusScript era -> PlutusBinary
plutusScriptBinary :: forall era. AlonzoEraScript era => PlutusScript era -> PlutusBinary
plutusScriptBinary PlutusScript era
ps = forall era a.
AlonzoEraScript era =>
PlutusScript era
-> (forall (l :: Language). PlutusLanguage l => Plutus l -> a) -> a
withPlutusScript PlutusScript era
ps forall (l :: Language). Plutus l -> PlutusBinary
plutusBinary

-- | Verifies whether Plutus script is well formed or not, which simply means whether it
-- deserializes successfully or not.
isValidPlutusScript :: AlonzoEraScript era => Version -> PlutusScript era -> Bool
isValidPlutusScript :: forall era.
AlonzoEraScript era =>
Version -> PlutusScript era -> Bool
isValidPlutusScript Version
pv PlutusScript era
ps = forall era a.
AlonzoEraScript era =>
PlutusScript era
-> (forall (l :: Language). PlutusLanguage l => Plutus l -> a) -> a
withPlutusScript PlutusScript era
ps (forall (l :: Language).
PlutusLanguage l =>
Version -> Plutus l -> Bool
isValidPlutus Version
pv)

-- Alonzo Plutus Purpose =======================================================

newtype AsIx ix it = AsIx {forall ix it. AsIx ix it -> ix
unAsIx :: ix}
  deriving stock (Int -> AsIx ix it -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ix it. Show ix => Int -> AsIx ix it -> ShowS
forall ix it. Show ix => [AsIx ix it] -> ShowS
forall ix it. Show ix => AsIx ix it -> String
showList :: [AsIx ix it] -> ShowS
$cshowList :: forall ix it. Show ix => [AsIx ix it] -> ShowS
show :: AsIx ix it -> String
$cshow :: forall ix it. Show ix => AsIx ix it -> String
showsPrec :: Int -> AsIx ix it -> ShowS
$cshowsPrec :: forall ix it. Show ix => Int -> AsIx ix it -> ShowS
Show)
  deriving newtype (AsIx ix it -> AsIx ix it -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall ix it. Eq ix => AsIx ix it -> AsIx ix it -> Bool
/= :: AsIx ix it -> AsIx ix it -> Bool
$c/= :: forall ix it. Eq ix => AsIx ix it -> AsIx ix it -> Bool
== :: AsIx ix it -> AsIx ix it -> Bool
$c== :: forall ix it. Eq ix => AsIx ix it -> AsIx ix it -> Bool
Eq, AsIx ix it -> AsIx ix it -> Bool
AsIx ix it -> AsIx ix it -> Ordering
AsIx ix it -> AsIx ix it -> AsIx ix it
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 {ix} {it}. Ord ix => Eq (AsIx ix it)
forall ix it. Ord ix => AsIx ix it -> AsIx ix it -> Bool
forall ix it. Ord ix => AsIx ix it -> AsIx ix it -> Ordering
forall ix it. Ord ix => AsIx ix it -> AsIx ix it -> AsIx ix it
min :: AsIx ix it -> AsIx ix it -> AsIx ix it
$cmin :: forall ix it. Ord ix => AsIx ix it -> AsIx ix it -> AsIx ix it
max :: AsIx ix it -> AsIx ix it -> AsIx ix it
$cmax :: forall ix it. Ord ix => AsIx ix it -> AsIx ix it -> AsIx ix it
>= :: AsIx ix it -> AsIx ix it -> Bool
$c>= :: forall ix it. Ord ix => AsIx ix it -> AsIx ix it -> Bool
> :: AsIx ix it -> AsIx ix it -> Bool
$c> :: forall ix it. Ord ix => AsIx ix it -> AsIx ix it -> Bool
<= :: AsIx ix it -> AsIx ix it -> Bool
$c<= :: forall ix it. Ord ix => AsIx ix it -> AsIx ix it -> Bool
< :: AsIx ix it -> AsIx ix it -> Bool
$c< :: forall ix it. Ord ix => AsIx ix it -> AsIx ix it -> Bool
compare :: AsIx ix it -> AsIx ix it -> Ordering
$ccompare :: forall ix it. Ord ix => AsIx ix it -> AsIx ix it -> Ordering
Ord, AsIx ix it -> ()
forall a. (a -> ()) -> NFData a
forall ix it. NFData ix => AsIx ix it -> ()
rnf :: AsIx ix it -> ()
$crnf :: forall ix it. NFData ix => AsIx ix it -> ()
NFData, Context -> AsIx ix it -> IO (Maybe ThunkInfo)
Proxy (AsIx ix it) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall ix it.
NoThunks ix =>
Context -> AsIx ix it -> IO (Maybe ThunkInfo)
forall ix it. NoThunks ix => Proxy (AsIx ix it) -> String
showTypeOf :: Proxy (AsIx ix it) -> String
$cshowTypeOf :: forall ix it. NoThunks ix => Proxy (AsIx ix it) -> String
wNoThunks :: Context -> AsIx ix it -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall ix it.
NoThunks ix =>
Context -> AsIx ix it -> IO (Maybe ThunkInfo)
noThunks :: Context -> AsIx ix it -> IO (Maybe ThunkInfo)
$cnoThunks :: forall ix it.
NoThunks ix =>
Context -> AsIx ix it -> IO (Maybe ThunkInfo)
NoThunks, AsIx ix it -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [AsIx ix it] -> Size
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (AsIx ix it) -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
forall {ix} {it}.
(Typeable it, EncCBOR ix) =>
Typeable (AsIx ix it)
forall ix it. (Typeable it, EncCBOR ix) => AsIx ix it -> Encoding
forall ix it.
(Typeable it, EncCBOR ix) =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [AsIx ix it] -> Size
forall ix it.
(Typeable it, EncCBOR ix) =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (AsIx ix it) -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [AsIx ix it] -> Size
$cencodedListSizeExpr :: forall ix it.
(Typeable it, EncCBOR ix) =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [AsIx ix it] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (AsIx ix it) -> Size
$cencodedSizeExpr :: forall ix it.
(Typeable it, EncCBOR ix) =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (AsIx ix it) -> Size
encCBOR :: AsIx ix it -> Encoding
$cencCBOR :: forall ix it. (Typeable it, EncCBOR ix) => AsIx ix it -> Encoding
EncCBOR, Proxy (AsIx ix it) -> Text
forall s. Decoder s (AsIx ix it)
forall a.
Typeable a
-> (forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy (AsIx ix it) -> Decoder s ()
forall {ix} {it}.
(Typeable it, DecCBOR ix) =>
Typeable (AsIx ix it)
forall ix it.
(Typeable it, DecCBOR ix) =>
Proxy (AsIx ix it) -> Text
forall ix it s. (Typeable it, DecCBOR ix) => Decoder s (AsIx ix it)
forall ix it s.
(Typeable it, DecCBOR ix) =>
Proxy (AsIx ix it) -> Decoder s ()
label :: Proxy (AsIx ix it) -> Text
$clabel :: forall ix it.
(Typeable it, DecCBOR ix) =>
Proxy (AsIx ix it) -> Text
dropCBOR :: forall s. Proxy (AsIx ix it) -> Decoder s ()
$cdropCBOR :: forall ix it s.
(Typeable it, DecCBOR ix) =>
Proxy (AsIx ix it) -> Decoder s ()
decCBOR :: forall s. Decoder s (AsIx ix it)
$cdecCBOR :: forall ix it s. (Typeable it, DecCBOR ix) => Decoder s (AsIx ix it)
DecCBOR, forall x. Rep (AsIx ix it) x -> AsIx ix it
forall x. AsIx ix it -> Rep (AsIx ix it) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ix it x. Generic ix => Rep (AsIx ix it) x -> AsIx ix it
forall ix it x. Generic ix => AsIx ix it -> Rep (AsIx ix it) x
to :: forall x. Rep (AsIx ix it) x -> AsIx ix it
$cto :: forall ix it x. Generic ix => Rep (AsIx ix it) x -> AsIx ix it
from :: forall x. AsIx ix it -> Rep (AsIx ix it) x
$cfrom :: forall ix it x. Generic ix => AsIx ix it -> Rep (AsIx ix it) x
Generic)

newtype AsItem ix it = AsItem {forall ix it. AsItem ix it -> it
unAsItem :: it}
  deriving stock (Int -> AsItem ix it -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ix it. Show it => Int -> AsItem ix it -> ShowS
forall ix it. Show it => [AsItem ix it] -> ShowS
forall ix it. Show it => AsItem ix it -> String
showList :: [AsItem ix it] -> ShowS
$cshowList :: forall ix it. Show it => [AsItem ix it] -> ShowS
show :: AsItem ix it -> String
$cshow :: forall ix it. Show it => AsItem ix it -> String
showsPrec :: Int -> AsItem ix it -> ShowS
$cshowsPrec :: forall ix it. Show it => Int -> AsItem ix it -> ShowS
Show)
  deriving newtype (AsItem ix it -> AsItem ix it -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall ix it. Eq it => AsItem ix it -> AsItem ix it -> Bool
/= :: AsItem ix it -> AsItem ix it -> Bool
$c/= :: forall ix it. Eq it => AsItem ix it -> AsItem ix it -> Bool
== :: AsItem ix it -> AsItem ix it -> Bool
$c== :: forall ix it. Eq it => AsItem ix it -> AsItem ix it -> Bool
Eq, AsItem ix it -> AsItem ix it -> Bool
AsItem ix it -> AsItem ix it -> Ordering
AsItem ix it -> AsItem ix it -> AsItem ix it
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 {ix} {it}. Ord it => Eq (AsItem ix it)
forall ix it. Ord it => AsItem ix it -> AsItem ix it -> Bool
forall ix it. Ord it => AsItem ix it -> AsItem ix it -> Ordering
forall ix it.
Ord it =>
AsItem ix it -> AsItem ix it -> AsItem ix it
min :: AsItem ix it -> AsItem ix it -> AsItem ix it
$cmin :: forall ix it.
Ord it =>
AsItem ix it -> AsItem ix it -> AsItem ix it
max :: AsItem ix it -> AsItem ix it -> AsItem ix it
$cmax :: forall ix it.
Ord it =>
AsItem ix it -> AsItem ix it -> AsItem ix it
>= :: AsItem ix it -> AsItem ix it -> Bool
$c>= :: forall ix it. Ord it => AsItem ix it -> AsItem ix it -> Bool
> :: AsItem ix it -> AsItem ix it -> Bool
$c> :: forall ix it. Ord it => AsItem ix it -> AsItem ix it -> Bool
<= :: AsItem ix it -> AsItem ix it -> Bool
$c<= :: forall ix it. Ord it => AsItem ix it -> AsItem ix it -> Bool
< :: AsItem ix it -> AsItem ix it -> Bool
$c< :: forall ix it. Ord it => AsItem ix it -> AsItem ix it -> Bool
compare :: AsItem ix it -> AsItem ix it -> Ordering
$ccompare :: forall ix it. Ord it => AsItem ix it -> AsItem ix it -> Ordering
Ord, AsItem ix it -> ()
forall a. (a -> ()) -> NFData a
forall ix it. NFData it => AsItem ix it -> ()
rnf :: AsItem ix it -> ()
$crnf :: forall ix it. NFData it => AsItem ix it -> ()
NFData, Context -> AsItem ix it -> IO (Maybe ThunkInfo)
Proxy (AsItem ix it) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall ix it.
NoThunks it =>
Context -> AsItem ix it -> IO (Maybe ThunkInfo)
forall ix it. NoThunks it => Proxy (AsItem ix it) -> String
showTypeOf :: Proxy (AsItem ix it) -> String
$cshowTypeOf :: forall ix it. NoThunks it => Proxy (AsItem ix it) -> String
wNoThunks :: Context -> AsItem ix it -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall ix it.
NoThunks it =>
Context -> AsItem ix it -> IO (Maybe ThunkInfo)
noThunks :: Context -> AsItem ix it -> IO (Maybe ThunkInfo)
$cnoThunks :: forall ix it.
NoThunks it =>
Context -> AsItem ix it -> IO (Maybe ThunkInfo)
NoThunks, AsItem ix it -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [AsItem ix it] -> Size
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (AsItem ix it) -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
forall {ix} {it}.
(Typeable ix, EncCBOR it) =>
Typeable (AsItem ix it)
forall ix it. (Typeable ix, EncCBOR it) => AsItem ix it -> Encoding
forall ix it.
(Typeable ix, EncCBOR it) =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [AsItem ix it] -> Size
forall ix it.
(Typeable ix, EncCBOR it) =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (AsItem ix it) -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [AsItem ix it] -> Size
$cencodedListSizeExpr :: forall ix it.
(Typeable ix, EncCBOR it) =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [AsItem ix it] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (AsItem ix it) -> Size
$cencodedSizeExpr :: forall ix it.
(Typeable ix, EncCBOR it) =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (AsItem ix it) -> Size
encCBOR :: AsItem ix it -> Encoding
$cencCBOR :: forall ix it. (Typeable ix, EncCBOR it) => AsItem ix it -> Encoding
EncCBOR, Proxy (AsItem ix it) -> Text
forall s. Decoder s (AsItem ix it)
forall a.
Typeable a
-> (forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy (AsItem ix it) -> Decoder s ()
forall {ix} {it}.
(Typeable ix, DecCBOR it) =>
Typeable (AsItem ix it)
forall ix it.
(Typeable ix, DecCBOR it) =>
Proxy (AsItem ix it) -> Text
forall ix it s.
(Typeable ix, DecCBOR it) =>
Decoder s (AsItem ix it)
forall ix it s.
(Typeable ix, DecCBOR it) =>
Proxy (AsItem ix it) -> Decoder s ()
label :: Proxy (AsItem ix it) -> Text
$clabel :: forall ix it.
(Typeable ix, DecCBOR it) =>
Proxy (AsItem ix it) -> Text
dropCBOR :: forall s. Proxy (AsItem ix it) -> Decoder s ()
$cdropCBOR :: forall ix it s.
(Typeable ix, DecCBOR it) =>
Proxy (AsItem ix it) -> Decoder s ()
decCBOR :: forall s. Decoder s (AsItem ix it)
$cdecCBOR :: forall ix it s.
(Typeable ix, DecCBOR it) =>
Decoder s (AsItem ix it)
DecCBOR, forall x. Rep (AsItem ix it) x -> AsItem ix it
forall x. AsItem ix it -> Rep (AsItem ix it) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ix it x. Generic it => Rep (AsItem ix it) x -> AsItem ix it
forall ix it x. Generic it => AsItem ix it -> Rep (AsItem ix it) x
to :: forall x. Rep (AsItem ix it) x -> AsItem ix it
$cto :: forall ix it x. Generic it => Rep (AsItem ix it) x -> AsItem ix it
from :: forall x. AsItem ix it -> Rep (AsItem ix it) x
$cfrom :: forall ix it x. Generic it => AsItem ix it -> Rep (AsItem ix it) x
Generic)

data AsIxItem ix it = AsIxItem
  { forall ix it. AsIxItem ix it -> ix
asIndex :: !ix
  , forall ix it. AsIxItem ix it -> it
asItem :: !it
  }
  deriving (AsIxItem ix it -> AsIxItem ix it -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall ix it.
(Eq ix, Eq it) =>
AsIxItem ix it -> AsIxItem ix it -> Bool
/= :: AsIxItem ix it -> AsIxItem ix it -> Bool
$c/= :: forall ix it.
(Eq ix, Eq it) =>
AsIxItem ix it -> AsIxItem ix it -> Bool
== :: AsIxItem ix it -> AsIxItem ix it -> Bool
$c== :: forall ix it.
(Eq ix, Eq it) =>
AsIxItem ix it -> AsIxItem ix it -> Bool
Eq, AsIxItem ix it -> AsIxItem ix it -> Bool
AsIxItem ix it -> AsIxItem ix it -> Ordering
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 {ix} {it}. (Ord ix, Ord it) => Eq (AsIxItem ix it)
forall ix it.
(Ord ix, Ord it) =>
AsIxItem ix it -> AsIxItem ix it -> Bool
forall ix it.
(Ord ix, Ord it) =>
AsIxItem ix it -> AsIxItem ix it -> Ordering
forall ix it.
(Ord ix, Ord it) =>
AsIxItem ix it -> AsIxItem ix it -> AsIxItem ix it
min :: AsIxItem ix it -> AsIxItem ix it -> AsIxItem ix it
$cmin :: forall ix it.
(Ord ix, Ord it) =>
AsIxItem ix it -> AsIxItem ix it -> AsIxItem ix it
max :: AsIxItem ix it -> AsIxItem ix it -> AsIxItem ix it
$cmax :: forall ix it.
(Ord ix, Ord it) =>
AsIxItem ix it -> AsIxItem ix it -> AsIxItem ix it
>= :: AsIxItem ix it -> AsIxItem ix it -> Bool
$c>= :: forall ix it.
(Ord ix, Ord it) =>
AsIxItem ix it -> AsIxItem ix it -> Bool
> :: AsIxItem ix it -> AsIxItem ix it -> Bool
$c> :: forall ix it.
(Ord ix, Ord it) =>
AsIxItem ix it -> AsIxItem ix it -> Bool
<= :: AsIxItem ix it -> AsIxItem ix it -> Bool
$c<= :: forall ix it.
(Ord ix, Ord it) =>
AsIxItem ix it -> AsIxItem ix it -> Bool
< :: AsIxItem ix it -> AsIxItem ix it -> Bool
$c< :: forall ix it.
(Ord ix, Ord it) =>
AsIxItem ix it -> AsIxItem ix it -> Bool
compare :: AsIxItem ix it -> AsIxItem ix it -> Ordering
$ccompare :: forall ix it.
(Ord ix, Ord it) =>
AsIxItem ix it -> AsIxItem ix it -> Ordering
Ord, Int -> AsIxItem ix it -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ix it. (Show ix, Show it) => Int -> AsIxItem ix it -> ShowS
forall ix it. (Show ix, Show it) => [AsIxItem ix it] -> ShowS
forall ix it. (Show ix, Show it) => AsIxItem ix it -> String
showList :: [AsIxItem ix it] -> ShowS
$cshowList :: forall ix it. (Show ix, Show it) => [AsIxItem ix it] -> ShowS
show :: AsIxItem ix it -> String
$cshow :: forall ix it. (Show ix, Show it) => AsIxItem ix it -> String
showsPrec :: Int -> AsIxItem ix it -> ShowS
$cshowsPrec :: forall ix it. (Show ix, Show it) => Int -> AsIxItem ix it -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ix it x. Rep (AsIxItem ix it) x -> AsIxItem ix it
forall ix it x. AsIxItem ix it -> Rep (AsIxItem ix it) x
$cto :: forall ix it x. Rep (AsIxItem ix it) x -> AsIxItem ix it
$cfrom :: forall ix it x. AsIxItem ix it -> Rep (AsIxItem ix it) x
Generic)

instance (NoThunks ix, NoThunks it) => NoThunks (AsIxItem ix it)

instance (NFData ix, NFData it) => NFData (AsIxItem ix it) where
  rnf :: AsIxItem ix it -> ()
rnf (AsIxItem ix
ix it
it) = ix
ix forall a b. NFData a => a -> b -> b
`deepseq` forall a. NFData a => a -> ()
rnf it
it

instance ToJSON ix => ToJSON (AsIx ix it) where
  toJSON :: AsIx ix it -> Value
toJSON (AsIx ix
i) = [Pair] -> Value
object [Key
"index" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON ix
i]

instance ToJSON it => ToJSON (AsItem ix it) where
  toJSON :: AsItem ix it -> Value
toJSON (AsItem it
i) = [Pair] -> Value
object [Key
"item" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON it
i]

instance (ToJSON ix, ToJSON it) => ToJSON (AsIxItem ix it) where
  toJSON :: AsIxItem ix it -> Value
toJSON (AsIxItem ix
ix it
it) =
    [Pair] -> Value
object
      [ Key
"index" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON ix
ix
      , Key
"item" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON it
it
      ]

toAsItem :: AsIxItem ix it -> AsItem ix it
toAsItem :: forall ix it. AsIxItem ix it -> AsItem ix it
toAsItem (AsIxItem ix
_ it
it) = forall ix it. it -> AsItem ix it
AsItem it
it

toAsIx :: AsIxItem ix it -> AsIx ix it
toAsIx :: forall ix it. AsIxItem ix it -> AsIx ix it
toAsIx (AsIxItem ix
ix it
_) = forall ix it. ix -> AsIx ix it
AsIx ix
ix

data AlonzoPlutusPurpose f era
  = AlonzoSpending !(f Word32 (TxIn (EraCrypto era)))
  | AlonzoMinting !(f Word32 (PolicyID (EraCrypto era)))
  | AlonzoCertifying !(f Word32 (TxCert era))
  | AlonzoRewarding !(f Word32 (RewardAccount (EraCrypto era)))
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> * -> *) era x.
Rep (AlonzoPlutusPurpose f era) x -> AlonzoPlutusPurpose f era
forall (f :: * -> * -> *) era x.
AlonzoPlutusPurpose f era -> Rep (AlonzoPlutusPurpose f era) x
$cto :: forall (f :: * -> * -> *) era x.
Rep (AlonzoPlutusPurpose f era) x -> AlonzoPlutusPurpose f era
$cfrom :: forall (f :: * -> * -> *) era x.
AlonzoPlutusPurpose f era -> Rep (AlonzoPlutusPurpose f era) x
Generic)

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

deriving instance Eq (TxCert era) => Eq (AlonzoPlutusPurpose AsItem era)
deriving instance Show (TxCert era) => Show (AlonzoPlutusPurpose AsItem era)
instance NoThunks (TxCert era) => NoThunks (AlonzoPlutusPurpose AsItem era)

deriving instance Eq (TxCert era) => Eq (AlonzoPlutusPurpose AsIxItem era)
deriving instance Show (TxCert era) => Show (AlonzoPlutusPurpose AsIxItem era)
instance NoThunks (TxCert era) => NoThunks (AlonzoPlutusPurpose AsIxItem era)

instance
  (forall a b. (NFData a, NFData b) => NFData (f a b), NFData (TxCert era), Era era) =>
  NFData (AlonzoPlutusPurpose f era)
  where
  rnf :: AlonzoPlutusPurpose f era -> ()
rnf = \case
    AlonzoSpending f Word32 (TxIn (EraCrypto era))
x -> forall a. NFData a => a -> ()
rnf f Word32 (TxIn (EraCrypto era))
x
    AlonzoMinting f Word32 (PolicyID (EraCrypto era))
x -> forall a. NFData a => a -> ()
rnf f Word32 (PolicyID (EraCrypto era))
x
    AlonzoCertifying f Word32 (TxCert era)
x -> forall a. NFData a => a -> ()
rnf f Word32 (TxCert era)
x
    AlonzoRewarding f Word32 (RewardAccount (EraCrypto era))
x -> forall a. NFData a => a -> ()
rnf f Word32 (RewardAccount (EraCrypto era))
x

instance Era era => EncCBORGroup (AlonzoPlutusPurpose AsIx era) where
  listLen :: AlonzoPlutusPurpose AsIx era -> Word
listLen AlonzoPlutusPurpose AsIx era
_ = Word
2
  listLenBound :: Proxy (AlonzoPlutusPurpose AsIx era) -> Word
listLenBound Proxy (AlonzoPlutusPurpose AsIx era)
_ = Word
2
  encCBORGroup :: AlonzoPlutusPurpose AsIx era -> Encoding
encCBORGroup = \case
    AlonzoSpending (AsIx Word32
redeemerIx) -> Word8 -> Encoding
encodeWord8 Word8
0 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Word32
redeemerIx
    AlonzoMinting (AsIx Word32
redeemerIx) -> Word8 -> Encoding
encodeWord8 Word8
1 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Word32
redeemerIx
    AlonzoCertifying (AsIx Word32
redeemerIx) -> Word8 -> Encoding
encodeWord8 Word8
2 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Word32
redeemerIx
    AlonzoRewarding (AsIx Word32
redeemerIx) -> Word8 -> Encoding
encodeWord8 Word8
3 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Word32
redeemerIx
  encodedGroupSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (AlonzoPlutusPurpose AsIx era) -> Size
encodedGroupSizeExpr forall t. EncCBOR t => Proxy t -> Size
size_ Proxy (AlonzoPlutusPurpose AsIx 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 Era era => DecCBORGroup (AlonzoPlutusPurpose AsIx era) where
  decCBORGroup :: forall s. Decoder s (AlonzoPlutusPurpose AsIx 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)) -> AlonzoPlutusPurpose f era
AlonzoSpending forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ix it. ix -> AsIx ix it
AsIx 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)) -> AlonzoPlutusPurpose f era
AlonzoMinting forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ix it. ix -> AsIx ix it
AsIx 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) -> AlonzoPlutusPurpose f era
AlonzoCertifying forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ix it. ix -> AsIx ix it
AsIx 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))
-> AlonzoPlutusPurpose f era
AlonzoRewarding forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ix it. ix -> AsIx ix it
AsIx 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 AlonzoPlutusPurpose: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Word8
n

-- | Incorrect CBOR implementation. Missing length encoding. Must keep it for backwards
-- compatibility
instance Era era => EncCBOR (AlonzoPlutusPurpose AsIx era) where
  encCBOR :: AlonzoPlutusPurpose AsIx era -> Encoding
encCBOR = forall a. EncCBORGroup a => a -> Encoding
encCBORGroup

-- | Incorrect CBOR implementation. Missing length encoding. Must keep it for backwards
-- compatibility
instance Era era => DecCBOR (AlonzoPlutusPurpose AsIx era) where
  decCBOR :: forall s. Decoder s (AlonzoPlutusPurpose AsIx era)
decCBOR = forall a s. DecCBORGroup a => Decoder s a
decCBORGroup

instance
  ( forall a b. (ToJSON a, ToJSON b) => ToJSON (f a b)
  , ToJSON (TxCert era)
  , Era era
  ) =>
  ToJSON (AlonzoPlutusPurpose f era)
  where
  toJSON :: AlonzoPlutusPurpose f era -> Value
toJSON = \case
    AlonzoSpending f Word32 (TxIn (EraCrypto era))
n -> forall {v}. ToJSON v => Text -> v -> Value
kindObjectWithValue Text
"AlonzoSpending" f Word32 (TxIn (EraCrypto era))
n
    AlonzoMinting f Word32 (PolicyID (EraCrypto era))
n -> forall {v}. ToJSON v => Text -> v -> Value
kindObjectWithValue Text
"AlonzoMinting" f Word32 (PolicyID (EraCrypto era))
n
    AlonzoCertifying f Word32 (TxCert era)
n -> forall {v}. ToJSON v => Text -> v -> Value
kindObjectWithValue Text
"AlonzoCertifying" f Word32 (TxCert era)
n
    AlonzoRewarding f Word32 (RewardAccount (EraCrypto era))
n -> forall {v}. ToJSON v => Text -> v -> Value
kindObjectWithValue Text
"AlonzoRewarding" f Word32 (RewardAccount (EraCrypto 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]

-- | /Note/ - serialization of `AlonzoPlutusPurpose` `AsItem`
--
-- * Tags do not match the `AlonzoPlutusPurpose` `AsIx`. Unfortunate inconsistency
--
-- * It is only used for predicate failures. Thus we can change it after Conway to be
--   consistent with `AlonzoPlutusPurpose` `AsIx`
instance (Era era, EncCBOR (TxCert era)) => EncCBOR (AlonzoPlutusPurpose AsItem era) where
  encCBOR :: AlonzoPlutusPurpose AsItem era -> Encoding
encCBOR = \case
    AlonzoSpending (AsItem TxIn (EraCrypto era)
x) -> forall (w :: Wrapped) t. Encode w t -> Encoding
encode (forall t. t -> Word -> Encode 'Open t
Sum (forall (f :: * -> * -> *) era.
f Word32 (TxIn (EraCrypto era)) -> AlonzoPlutusPurpose f era
AlonzoSpending @_ @era forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ix it. it -> AsItem ix it
AsItem) Word
1 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To TxIn (EraCrypto era)
x)
    AlonzoMinting (AsItem PolicyID (EraCrypto era)
x) -> forall (w :: Wrapped) t. Encode w t -> Encoding
encode (forall t. t -> Word -> Encode 'Open t
Sum (forall (f :: * -> * -> *) era.
f Word32 (PolicyID (EraCrypto era)) -> AlonzoPlutusPurpose f era
AlonzoMinting @_ @era forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ix it. it -> AsItem ix it
AsItem) Word
0 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PolicyID (EraCrypto era)
x)
    AlonzoCertifying (AsItem TxCert era
x) -> forall (w :: Wrapped) t. Encode w t -> Encoding
encode (forall t. t -> Word -> Encode 'Open t
Sum (forall (f :: * -> * -> *) era.
f Word32 (TxCert era) -> AlonzoPlutusPurpose f era
AlonzoCertifying forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ix it. it -> AsItem ix it
AsItem) Word
3 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To TxCert era
x)
    AlonzoRewarding (AsItem RewardAccount (EraCrypto era)
x) -> forall (w :: Wrapped) t. Encode w t -> Encoding
encode (forall t. t -> Word -> Encode 'Open t
Sum (forall (f :: * -> * -> *) era.
f Word32 (RewardAccount (EraCrypto era))
-> AlonzoPlutusPurpose f era
AlonzoRewarding @_ @era forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ix it. it -> AsItem ix it
AsItem) Word
2 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To RewardAccount (EraCrypto era)
x)

-- | See note on the `EncCBOR` instace.
instance (Era era, DecCBOR (TxCert era)) => DecCBOR (AlonzoPlutusPurpose AsItem era) where
  decCBOR :: forall s. Decoder s (AlonzoPlutusPurpose AsItem era)
decCBOR = forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode (forall t.
Text -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands Text
"AlonzoPlutusPurpose" forall {era}.
(Crypto (EraCrypto era), DecCBOR (TxCert era)) =>
Word -> Decode 'Open (AlonzoPlutusPurpose AsItem era)
dec)
    where
      dec :: Word -> Decode 'Open (AlonzoPlutusPurpose AsItem era)
dec Word
1 = forall t. t -> Decode 'Open t
SumD (forall (f :: * -> * -> *) era.
f Word32 (TxIn (EraCrypto era)) -> AlonzoPlutusPurpose f era
AlonzoSpending forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ix it. it -> AsItem ix it
AsItem) forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      dec Word
0 = forall t. t -> Decode 'Open t
SumD (forall (f :: * -> * -> *) era.
f Word32 (PolicyID (EraCrypto era)) -> AlonzoPlutusPurpose f era
AlonzoMinting forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ix it. it -> AsItem ix it
AsItem) forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      dec Word
3 = forall t. t -> Decode 'Open t
SumD (forall (f :: * -> * -> *) era.
f Word32 (TxCert era) -> AlonzoPlutusPurpose f era
AlonzoCertifying forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ix it. it -> AsItem ix it
AsItem) forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      dec Word
2 = forall t. t -> Decode 'Open t
SumD (forall (f :: * -> * -> *) era.
f Word32 (RewardAccount (EraCrypto era))
-> AlonzoPlutusPurpose f era
AlonzoRewarding forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ix it. it -> AsItem ix it
AsItem) forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      dec Word
n = forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n

pattern SpendingPurpose ::
  AlonzoEraScript era => f Word32 (TxIn (EraCrypto era)) -> PlutusPurpose f era
pattern $bSpendingPurpose :: forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 (TxIn (EraCrypto era)) -> PlutusPurpose f era
$mSpendingPurpose :: forall {r} {era} {f :: * -> * -> *}.
AlonzoEraScript era =>
PlutusPurpose f era
-> (f Word32 (TxIn (EraCrypto era)) -> r) -> ((# #) -> r) -> r
SpendingPurpose c <- (toSpendingPurpose -> Just c)
  where
    SpendingPurpose f Word32 (TxIn (EraCrypto era))
c = forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 (TxIn (EraCrypto era)) -> PlutusPurpose f era
mkSpendingPurpose f Word32 (TxIn (EraCrypto era))
c

pattern MintingPurpose ::
  AlonzoEraScript era => f Word32 (PolicyID (EraCrypto era)) -> PlutusPurpose f era
pattern $bMintingPurpose :: forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 (PolicyID (EraCrypto era)) -> PlutusPurpose f era
$mMintingPurpose :: forall {r} {era} {f :: * -> * -> *}.
AlonzoEraScript era =>
PlutusPurpose f era
-> (f Word32 (PolicyID (EraCrypto era)) -> r) -> ((# #) -> r) -> r
MintingPurpose c <- (toMintingPurpose -> Just c)
  where
    MintingPurpose f Word32 (PolicyID (EraCrypto era))
c = forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 (PolicyID (EraCrypto era)) -> PlutusPurpose f era
mkMintingPurpose f Word32 (PolicyID (EraCrypto era))
c

pattern CertifyingPurpose ::
  AlonzoEraScript era => f Word32 (TxCert era) -> PlutusPurpose f era
pattern $bCertifyingPurpose :: forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 (TxCert era) -> PlutusPurpose f era
$mCertifyingPurpose :: forall {r} {era} {f :: * -> * -> *}.
AlonzoEraScript era =>
PlutusPurpose f era
-> (f Word32 (TxCert era) -> r) -> ((# #) -> r) -> r
CertifyingPurpose c <- (toCertifyingPurpose -> Just c)
  where
    CertifyingPurpose f Word32 (TxCert era)
c = forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 (TxCert era) -> PlutusPurpose f era
mkCertifyingPurpose f Word32 (TxCert era)
c

pattern RewardingPurpose ::
  AlonzoEraScript era => f Word32 (RewardAccount (EraCrypto era)) -> PlutusPurpose f era
pattern $bRewardingPurpose :: forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 (RewardAccount (EraCrypto era)) -> PlutusPurpose f era
$mRewardingPurpose :: forall {r} {era} {f :: * -> * -> *}.
AlonzoEraScript era =>
PlutusPurpose f era
-> (f Word32 (RewardAccount (EraCrypto era)) -> r)
-> ((# #) -> r)
-> r
RewardingPurpose c <- (toRewardingPurpose -> Just c)
  where
    RewardingPurpose f Word32 (RewardAccount (EraCrypto era))
c = forall era (f :: * -> * -> *).
AlonzoEraScript era =>
f Word32 (RewardAccount (EraCrypto era)) -> PlutusPurpose f era
mkRewardingPurpose f Word32 (RewardAccount (EraCrypto era))
c

-- Alonzo Script ===============================================================

-- | Scripts in the Alonzo Era, Either a Timelock script or a Plutus script.
data AlonzoScript era
  = TimelockScript !(Timelock era)
  | PlutusScript !(PlutusScript era)
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (AlonzoScript era) x -> AlonzoScript era
forall era x. AlonzoScript era -> Rep (AlonzoScript era) x
$cto :: forall era x. Rep (AlonzoScript era) x -> AlonzoScript era
$cfrom :: forall era x. AlonzoScript era -> Rep (AlonzoScript era) x
Generic)

deriving instance Eq (PlutusScript era) => Eq (AlonzoScript era)

instance (Era era, NoThunks (PlutusScript era)) => NoThunks (AlonzoScript era)

instance NFData (PlutusScript era) => NFData (AlonzoScript era) where
  rnf :: AlonzoScript era -> ()
rnf = \case
    TimelockScript Timelock era
ts -> forall a. NFData a => a -> ()
rnf Timelock era
ts
    PlutusScript PlutusScript era
ps -> forall a. NFData a => a -> ()
rnf PlutusScript era
ps

instance (AlonzoEraScript era, Script era ~ AlonzoScript era) => Show (AlonzoScript era) where
  show :: AlonzoScript era -> String
show (TimelockScript Timelock era
x) = String
"TimelockScript " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Timelock era
x
  show s :: AlonzoScript era
s@(PlutusScript PlutusScript era
plutus) =
    String
"PlutusScript " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall era. AlonzoEraScript era => PlutusScript era -> Language
plutusScriptLanguage PlutusScript era
plutus) forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @era AlonzoScript era
s)

-- | Both constructors know their original bytes
instance SafeToHash (PlutusScript era) => SafeToHash (AlonzoScript era) where
  originalBytes :: AlonzoScript era -> ByteString
originalBytes (TimelockScript Timelock era
t) = forall t. SafeToHash t => t -> ByteString
originalBytes Timelock era
t
  originalBytes (PlutusScript PlutusScript era
plutus) = forall t. SafeToHash t => t -> ByteString
originalBytes PlutusScript era
plutus

isPlutusScript :: AlonzoEraScript era => Script era -> Bool
isPlutusScript :: forall era. AlonzoEraScript era => Script era -> Bool
isPlutusScript = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
AlonzoEraScript era =>
Script era -> Maybe (PlutusScript era)
toPlutusScript

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

  upgradeScript :: EraScript (PreviousEra (AlonzoEra c)) =>
Script (PreviousEra (AlonzoEra c)) -> Script (AlonzoEra c)
upgradeScript = forall era. Timelock era -> AlonzoScript era
TimelockScript forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era1 era2.
(Era era1, Era era2, EraCrypto era1 ~ EraCrypto era2) =>
Timelock era1 -> Timelock era2
translateTimelock

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

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

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

alonzoScriptPrefixTag ::
  (AlonzoEraScript era, AlonzoScript era ~ Script era) =>
  Script era ->
  BS.ByteString
alonzoScriptPrefixTag :: forall era.
(AlonzoEraScript era, AlonzoScript era ~ Script era) =>
Script era -> ByteString
alonzoScriptPrefixTag = \case
  TimelockScript Timelock era
_ -> ByteString
nativeMultiSigTag -- "\x00"
  PlutusScript PlutusScript era
plutusScript -> Word8 -> ByteString
BS.singleton (forall era a.
AlonzoEraScript era =>
PlutusScript era
-> (forall (l :: Language). PlutusLanguage l => Plutus l -> a) -> a
withPlutusScript PlutusScript era
plutusScript forall (l :: Language). PlutusLanguage l => Plutus l -> Word8
plutusLanguageTag)

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

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

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

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

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

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

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

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

instance Crypto c => AlonzoEraScript (AlonzoEra c) where
  {-# SPECIALIZE instance AlonzoEraScript (AlonzoEra StandardCrypto) #-}

  newtype PlutusScript (AlonzoEra c) = AlonzoPlutusV1 (Plutus 'PlutusV1)
    deriving newtype (PlutusScript (AlonzoEra c) -> PlutusScript (AlonzoEra c) -> Bool
forall c.
PlutusScript (AlonzoEra c) -> PlutusScript (AlonzoEra c) -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlutusScript (AlonzoEra c) -> PlutusScript (AlonzoEra c) -> Bool
$c/= :: forall c.
PlutusScript (AlonzoEra c) -> PlutusScript (AlonzoEra c) -> Bool
== :: PlutusScript (AlonzoEra c) -> PlutusScript (AlonzoEra c) -> Bool
$c== :: forall c.
PlutusScript (AlonzoEra c) -> PlutusScript (AlonzoEra c) -> Bool
Eq, PlutusScript (AlonzoEra c) -> PlutusScript (AlonzoEra c) -> Bool
PlutusScript (AlonzoEra c)
-> PlutusScript (AlonzoEra c) -> Ordering
PlutusScript (AlonzoEra c)
-> PlutusScript (AlonzoEra c) -> PlutusScript (AlonzoEra c)
forall c. Eq (PlutusScript (AlonzoEra 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 (AlonzoEra c) -> PlutusScript (AlonzoEra c) -> Bool
forall c.
PlutusScript (AlonzoEra c)
-> PlutusScript (AlonzoEra c) -> Ordering
forall c.
PlutusScript (AlonzoEra c)
-> PlutusScript (AlonzoEra c) -> PlutusScript (AlonzoEra c)
min :: PlutusScript (AlonzoEra c)
-> PlutusScript (AlonzoEra c) -> PlutusScript (AlonzoEra c)
$cmin :: forall c.
PlutusScript (AlonzoEra c)
-> PlutusScript (AlonzoEra c) -> PlutusScript (AlonzoEra c)
max :: PlutusScript (AlonzoEra c)
-> PlutusScript (AlonzoEra c) -> PlutusScript (AlonzoEra c)
$cmax :: forall c.
PlutusScript (AlonzoEra c)
-> PlutusScript (AlonzoEra c) -> PlutusScript (AlonzoEra c)
>= :: PlutusScript (AlonzoEra c) -> PlutusScript (AlonzoEra c) -> Bool
$c>= :: forall c.
PlutusScript (AlonzoEra c) -> PlutusScript (AlonzoEra c) -> Bool
> :: PlutusScript (AlonzoEra c) -> PlutusScript (AlonzoEra c) -> Bool
$c> :: forall c.
PlutusScript (AlonzoEra c) -> PlutusScript (AlonzoEra c) -> Bool
<= :: PlutusScript (AlonzoEra c) -> PlutusScript (AlonzoEra c) -> Bool
$c<= :: forall c.
PlutusScript (AlonzoEra c) -> PlutusScript (AlonzoEra c) -> Bool
< :: PlutusScript (AlonzoEra c) -> PlutusScript (AlonzoEra c) -> Bool
$c< :: forall c.
PlutusScript (AlonzoEra c) -> PlutusScript (AlonzoEra c) -> Bool
compare :: PlutusScript (AlonzoEra c)
-> PlutusScript (AlonzoEra c) -> Ordering
$ccompare :: forall c.
PlutusScript (AlonzoEra c)
-> PlutusScript (AlonzoEra c) -> Ordering
Ord, Int -> PlutusScript (AlonzoEra c) -> ShowS
[PlutusScript (AlonzoEra c)] -> ShowS
PlutusScript (AlonzoEra c) -> String
forall c. Int -> PlutusScript (AlonzoEra c) -> ShowS
forall c. [PlutusScript (AlonzoEra c)] -> ShowS
forall c. PlutusScript (AlonzoEra c) -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlutusScript (AlonzoEra c)] -> ShowS
$cshowList :: forall c. [PlutusScript (AlonzoEra c)] -> ShowS
show :: PlutusScript (AlonzoEra c) -> String
$cshow :: forall c. PlutusScript (AlonzoEra c) -> String
showsPrec :: Int -> PlutusScript (AlonzoEra c) -> ShowS
$cshowsPrec :: forall c. Int -> PlutusScript (AlonzoEra c) -> ShowS
Show, PlutusScript (AlonzoEra c) -> ()
forall c. PlutusScript (AlonzoEra c) -> ()
forall a. (a -> ()) -> NFData a
rnf :: PlutusScript (AlonzoEra c) -> ()
$crnf :: forall c. PlutusScript (AlonzoEra c) -> ()
NFData, Context -> PlutusScript (AlonzoEra c) -> IO (Maybe ThunkInfo)
Proxy (PlutusScript (AlonzoEra c)) -> String
forall c.
Context -> PlutusScript (AlonzoEra c) -> IO (Maybe ThunkInfo)
forall c. Proxy (PlutusScript (AlonzoEra c)) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (PlutusScript (AlonzoEra c)) -> String
$cshowTypeOf :: forall c. Proxy (PlutusScript (AlonzoEra c)) -> String
wNoThunks :: Context -> PlutusScript (AlonzoEra c) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall c.
Context -> PlutusScript (AlonzoEra c) -> IO (Maybe ThunkInfo)
noThunks :: Context -> PlutusScript (AlonzoEra c) -> IO (Maybe ThunkInfo)
$cnoThunks :: forall c.
Context -> PlutusScript (AlonzoEra c) -> IO (Maybe ThunkInfo)
NoThunks, PlutusScript (AlonzoEra c) -> Int
PlutusScript (AlonzoEra c) -> ByteString
forall c. PlutusScript (AlonzoEra c) -> Int
forall c. PlutusScript (AlonzoEra c) -> ByteString
forall t.
(t -> ByteString)
-> (t -> Int)
-> (forall c index.
    HashAlgorithm (HASH c) =>
    Proxy c -> Proxy index -> t -> SafeHash c index)
-> SafeToHash t
forall c index.
HashAlgorithm (HASH c) =>
Proxy c
-> Proxy index -> PlutusScript (AlonzoEra c) -> SafeHash c index
forall c c index.
HashAlgorithm (HASH c) =>
Proxy c
-> Proxy index -> PlutusScript (AlonzoEra c) -> SafeHash c index
makeHashWithExplicitProxys :: forall c index.
HashAlgorithm (HASH c) =>
Proxy c
-> Proxy index -> PlutusScript (AlonzoEra c) -> SafeHash c index
$cmakeHashWithExplicitProxys :: forall c c index.
HashAlgorithm (HASH c) =>
Proxy c
-> Proxy index -> PlutusScript (AlonzoEra c) -> SafeHash c index
originalBytesSize :: PlutusScript (AlonzoEra c) -> Int
$coriginalBytesSize :: forall c. PlutusScript (AlonzoEra c) -> Int
originalBytes :: PlutusScript (AlonzoEra c) -> ByteString
$coriginalBytes :: forall c. PlutusScript (AlonzoEra c) -> ByteString
SafeToHash, forall x.
Rep (PlutusScript (AlonzoEra c)) x -> PlutusScript (AlonzoEra c)
forall x.
PlutusScript (AlonzoEra c) -> Rep (PlutusScript (AlonzoEra c)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x.
Rep (PlutusScript (AlonzoEra c)) x -> PlutusScript (AlonzoEra c)
forall c x.
PlutusScript (AlonzoEra c) -> Rep (PlutusScript (AlonzoEra c)) x
to :: forall x.
Rep (PlutusScript (AlonzoEra c)) x -> PlutusScript (AlonzoEra c)
$cto :: forall c x.
Rep (PlutusScript (AlonzoEra c)) x -> PlutusScript (AlonzoEra c)
from :: forall x.
PlutusScript (AlonzoEra c) -> Rep (PlutusScript (AlonzoEra c)) x
$cfrom :: forall c x.
PlutusScript (AlonzoEra c) -> Rep (PlutusScript (AlonzoEra c)) x
Generic)

  type PlutusPurpose f (AlonzoEra c) = AlonzoPlutusPurpose f (AlonzoEra c)

  eraMaxLanguage :: Language
eraMaxLanguage = Language
PlutusV1

  mkPlutusScript :: forall (l :: Language).
PlutusLanguage l =>
Plutus l -> Maybe (PlutusScript (AlonzoEra 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 (AlonzoEra c)
AlonzoPlutusV1 Plutus l
plutus
      SLanguage l
_ -> forall a. Maybe a
Nothing

  withPlutusScript :: forall a.
PlutusScript (AlonzoEra c)
-> (forall (l :: Language). PlutusLanguage l => Plutus l -> a) -> a
withPlutusScript (AlonzoPlutusV1 Plutus 'PlutusV1
plutus) forall (l :: Language). PlutusLanguage l => Plutus l -> a
f = forall (l :: Language). PlutusLanguage l => Plutus l -> a
f Plutus 'PlutusV1
plutus

  hoistPlutusPurpose :: forall (g :: * -> * -> *) (f :: * -> * -> *).
(forall ix it. g ix it -> f ix it)
-> PlutusPurpose g (AlonzoEra c) -> PlutusPurpose f (AlonzoEra c)
hoistPlutusPurpose forall ix it. g ix it -> f ix it
f = \case
    AlonzoSpending g Word32 (TxIn (EraCrypto (AlonzoEra c)))
x -> forall (f :: * -> * -> *) era.
f Word32 (TxIn (EraCrypto era)) -> AlonzoPlutusPurpose f era
AlonzoSpending forall a b. (a -> b) -> a -> b
$ forall ix it. g ix it -> f ix it
f g Word32 (TxIn (EraCrypto (AlonzoEra c)))
x
    AlonzoMinting g Word32 (PolicyID (EraCrypto (AlonzoEra c)))
x -> forall (f :: * -> * -> *) era.
f Word32 (PolicyID (EraCrypto era)) -> AlonzoPlutusPurpose f era
AlonzoMinting forall a b. (a -> b) -> a -> b
$ forall ix it. g ix it -> f ix it
f g Word32 (PolicyID (EraCrypto (AlonzoEra c)))
x
    AlonzoCertifying g Word32 (TxCert (AlonzoEra c))
x -> forall (f :: * -> * -> *) era.
f Word32 (TxCert era) -> AlonzoPlutusPurpose f era
AlonzoCertifying forall a b. (a -> b) -> a -> b
$ forall ix it. g ix it -> f ix it
f g Word32 (TxCert (AlonzoEra c))
x
    AlonzoRewarding g Word32 (RewardAccount (EraCrypto (AlonzoEra c)))
x -> forall (f :: * -> * -> *) era.
f Word32 (RewardAccount (EraCrypto era))
-> AlonzoPlutusPurpose f era
AlonzoRewarding forall a b. (a -> b) -> a -> b
$ forall ix it. g ix it -> f ix it
f g Word32 (RewardAccount (EraCrypto (AlonzoEra c)))
x

  mkSpendingPurpose :: forall (f :: * -> * -> *).
f Word32 (TxIn (EraCrypto (AlonzoEra c)))
-> PlutusPurpose f (AlonzoEra c)
mkSpendingPurpose = forall (f :: * -> * -> *) era.
f Word32 (TxIn (EraCrypto era)) -> AlonzoPlutusPurpose f era
AlonzoSpending

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

  mkMintingPurpose :: forall (f :: * -> * -> *).
f Word32 (PolicyID (EraCrypto (AlonzoEra c)))
-> PlutusPurpose f (AlonzoEra c)
mkMintingPurpose = forall (f :: * -> * -> *) era.
f Word32 (PolicyID (EraCrypto era)) -> AlonzoPlutusPurpose f era
AlonzoMinting

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

  mkCertifyingPurpose :: forall (f :: * -> * -> *).
f Word32 (TxCert (AlonzoEra c)) -> PlutusPurpose f (AlonzoEra c)
mkCertifyingPurpose = forall (f :: * -> * -> *) era.
f Word32 (TxCert era) -> AlonzoPlutusPurpose f era
AlonzoCertifying

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

  mkRewardingPurpose :: forall (f :: * -> * -> *).
f Word32 (RewardAccount (EraCrypto (AlonzoEra c)))
-> PlutusPurpose f (AlonzoEra c)
mkRewardingPurpose = forall (f :: * -> * -> *) era.
f Word32 (RewardAccount (EraCrypto era))
-> AlonzoPlutusPurpose f era
AlonzoRewarding

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

  upgradePlutusPurposeAsIx :: AlonzoEraScript (PreviousEra (AlonzoEra c)) =>
PlutusPurpose AsIx (PreviousEra (AlonzoEra c))
-> PlutusPurpose AsIx (AlonzoEra c)
upgradePlutusPurposeAsIx =
    forall a. HasCallStack => String -> a
error String
"Impossible: No `PlutusScript` and `AlonzoEraScript` instances in the previous era"

instance Eq (PlutusScript era) => EqRaw (AlonzoScript era) where
  eqRaw :: AlonzoScript era -> AlonzoScript era -> Bool
eqRaw = forall era.
Eq (PlutusScript era) =>
AlonzoScript era -> AlonzoScript era -> Bool
eqAlonzoScriptRaw

instance AlonzoEraScript era => ToJSON (AlonzoScript era) where
  toJSON :: AlonzoScript era -> Value
toJSON = Text -> Value
String forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToCBOR a => a -> Text
serializeAsHexText

--------------------------------------------------------------------------------
-- Serialisation
--------------------------------------------------------------------------------

decodePlutusScript ::
  forall era l s.
  (AlonzoEraScript era, PlutusLanguage l) =>
  SLanguage l ->
  Decoder s (PlutusScript era)
decodePlutusScript :: forall era (l :: Language) s.
(AlonzoEraScript era, PlutusLanguage l) =>
SLanguage l -> Decoder s (PlutusScript era)
decodePlutusScript SLanguage l
slang = do
  PlutusBinary
pb <- forall a s. DecCBOR a => Decoder s a
decCBOR
  case forall era (l :: Language).
(AlonzoEraScript era, PlutusLanguage l) =>
Plutus l -> Maybe (PlutusScript era)
mkPlutusScript forall a b. (a -> b) -> a -> b
$ forall (l :: Language) (proxy :: Language -> *).
SLanguage l -> proxy l -> proxy l
asSLanguage SLanguage l
slang forall a b. (a -> b) -> a -> b
$ forall (l :: Language). PlutusBinary -> Plutus l
Plutus PlutusBinary
pb of
    Maybe (PlutusScript era)
Nothing ->
      forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show (forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage SLanguage l
slang) forall a. [a] -> [a] -> [a]
++ String
" is not supported in " forall a. [a] -> [a] -> [a]
++ forall era. Era era => String
eraName @era forall a. [a] -> [a] -> [a]
++ String
" era."
    Just PlutusScript era
plutusScript -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PlutusScript era
plutusScript

instance AlonzoEraScript era => EncCBOR (AlonzoScript era)

instance AlonzoEraScript era => ToCBOR (AlonzoScript era) where
  toCBOR :: AlonzoScript era -> Encoding
toCBOR = forall era t. (Era era, EncCBOR t) => t -> Encoding
toEraCBOR @era forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
AlonzoEraScript era =>
AlonzoScript era -> Encode 'Open (AlonzoScript era)
encodeScript

encodeScript :: AlonzoEraScript era => AlonzoScript era -> Encode 'Open (AlonzoScript era)
encodeScript :: forall era.
AlonzoEraScript era =>
AlonzoScript era -> Encode 'Open (AlonzoScript era)
encodeScript = \case
  TimelockScript Timelock era
i -> forall t. t -> Word -> Encode 'Open t
Sum forall era. Timelock era -> AlonzoScript era
TimelockScript Word
0 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Timelock era
i
  PlutusScript PlutusScript era
plutusScript -> forall era a.
AlonzoEraScript era =>
PlutusScript era
-> (forall (l :: Language). PlutusLanguage l => Plutus l -> a) -> a
withPlutusScript PlutusScript era
plutusScript forall a b. (a -> b) -> a -> b
$ \plutus :: Plutus l
plutus@(Plutus PlutusBinary
pb) ->
    case forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> SLanguage l
plutusSLanguage Plutus l
plutus of
      SLanguage l
SPlutusV1 -> forall t. t -> Word -> Encode 'Open t
Sum (forall era. PlutusScript era -> AlonzoScript era
PlutusScript forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era (l :: Language).
(AlonzoEraScript era, PlutusLanguage l) =>
Plutus l -> Maybe (PlutusScript era)
mkPlutusScript forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: Language). PlutusBinary -> Plutus l
Plutus @'PlutusV1) Word
1 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PlutusBinary
pb
      SLanguage l
SPlutusV2 -> forall t. t -> Word -> Encode 'Open t
Sum (forall era. PlutusScript era -> AlonzoScript era
PlutusScript forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era (l :: Language).
(AlonzoEraScript era, PlutusLanguage l) =>
Plutus l -> Maybe (PlutusScript era)
mkPlutusScript forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: Language). PlutusBinary -> Plutus l
Plutus @'PlutusV2) Word
2 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PlutusBinary
pb
      SLanguage l
SPlutusV3 -> forall t. t -> Word -> Encode 'Open t
Sum (forall era. PlutusScript era -> AlonzoScript era
PlutusScript forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era (l :: Language).
(AlonzoEraScript era, PlutusLanguage l) =>
Plutus l -> Maybe (PlutusScript era)
mkPlutusScript forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: Language). PlutusBinary -> Plutus l
Plutus @'PlutusV3) Word
3 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PlutusBinary
pb

instance AlonzoEraScript era => DecCBOR (Annotator (AlonzoScript era)) where
  decCBOR :: forall s. Decoder s (Annotator (AlonzoScript era))
decCBOR = forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode (forall t.
Text -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands Text
"AlonzoScript" Word -> Decode 'Open (Annotator (AlonzoScript era))
decodeScript)
    where
      decodeAnnPlutus :: SLanguage l -> Decode 'Open (Annotator (AlonzoScript era))
decodeAnnPlutus SLanguage l
slang =
        forall (w :: Wrapped) t1. Decode w t1 -> Decode w (Annotator t1)
Ann (forall t. t -> Decode 'Open t
SumD forall era. PlutusScript era -> AlonzoScript era
PlutusScript) forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! forall (w :: Wrapped) t1. Decode w t1 -> Decode w (Annotator t1)
Ann (forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (forall era (l :: Language) s.
(AlonzoEraScript era, PlutusLanguage l) =>
SLanguage l -> Decoder s (PlutusScript era)
decodePlutusScript SLanguage l
slang))
      {-# INLINE decodeAnnPlutus #-}
      decodeScript :: Word -> Decode 'Open (Annotator (AlonzoScript era))
      decodeScript :: Word -> Decode 'Open (Annotator (AlonzoScript era))
decodeScript = \case
        Word
0 -> forall (w :: Wrapped) t1. Decode w t1 -> Decode w (Annotator t1)
Ann (forall t. t -> Decode 'Open t
SumD forall era. Timelock era -> AlonzoScript era
TimelockScript) forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Word
1 -> forall {era} {l :: Language}.
(AlonzoEraScript era, PlutusLanguage l) =>
SLanguage l -> Decode 'Open (Annotator (AlonzoScript era))
decodeAnnPlutus SLanguage 'PlutusV1
SPlutusV1
        Word
2 -> forall {era} {l :: Language}.
(AlonzoEraScript era, PlutusLanguage l) =>
SLanguage l -> Decode 'Open (Annotator (AlonzoScript era))
decodeAnnPlutus SLanguage 'PlutusV2
SPlutusV2
        Word
3 -> forall {era} {l :: Language}.
(AlonzoEraScript era, PlutusLanguage l) =>
SLanguage l -> Decode 'Open (Annotator (AlonzoScript era))
decodeAnnPlutus SLanguage 'PlutusV3
SPlutusV3
        Word
n -> forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n
      {-# INLINE decodeScript #-}
  {-# INLINE decCBOR #-}

-- | Verify that every `Script` represents a valid script. Force native scripts to Normal
-- Form, to ensure that there are no bottoms and deserialize `Plutus` scripts into a
-- `Cardano.Ledger.Plutus.Language.PlutusRunnable`.
validScript :: (HasCallStack, AlonzoEraScript era) => ProtVer -> Script era -> Bool
validScript :: forall era.
(HasCallStack, AlonzoEraScript era) =>
ProtVer -> Script era -> Bool
validScript ProtVer
pv Script era
script =
  case forall era.
AlonzoEraScript era =>
Script era -> Maybe (PlutusScript era)
toPlutusScript Script era
script of
    Just PlutusScript era
plutusScript -> forall era.
AlonzoEraScript era =>
Version -> PlutusScript era -> Bool
isValidPlutusScript (ProtVer -> Version
pvMajor ProtVer
pv) PlutusScript era
plutusScript
    Maybe (PlutusScript era)
Nothing ->
      case forall era. EraScript era => Script era -> Maybe (NativeScript era)
getNativeScript Script era
script of
        Just NativeScript era
timelockScript -> forall a b. NFData a => a -> b -> b
deepseq NativeScript era
timelockScript Bool
True
        Maybe (NativeScript era)
Nothing -> forall a. HasCallStack => String -> a
error String
"Impossible: There are only Native and Plutus scripts available"

-- | Check the equality of two underlying types, while ignoring their binary
-- representation, which `Eq` instance normally does. This is used for testing.
eqAlonzoScriptRaw :: Eq (PlutusScript era) => AlonzoScript era -> AlonzoScript era -> Bool
eqAlonzoScriptRaw :: forall era.
Eq (PlutusScript era) =>
AlonzoScript era -> AlonzoScript era -> Bool
eqAlonzoScriptRaw (TimelockScript Timelock era
t1) (TimelockScript Timelock era
t2) = forall era. Timelock era -> Timelock era -> Bool
eqTimelockRaw Timelock era
t1 Timelock era
t2
eqAlonzoScriptRaw (PlutusScript PlutusScript era
ps1) (PlutusScript PlutusScript era
ps2) = PlutusScript era
ps1 forall a. Eq a => a -> a -> Bool
== PlutusScript era
ps2
eqAlonzoScriptRaw AlonzoScript era
_ AlonzoScript era
_ = Bool
False

eraLanguages :: forall era. AlonzoEraScript era => [Language]
eraLanguages :: forall era. AlonzoEraScript era => [Language]
eraLanguages = [forall a. Bounded a => a
minBound .. forall era. AlonzoEraScript era => Language
eraMaxLanguage @era]

-- | Having a Map with scripts and a script hash, lookup the plutus script. Returns
-- Nothing when script is missing or it is not a PlutusScript
lookupPlutusScript ::
  AlonzoEraScript era =>
  ScriptHash (EraCrypto era) ->
  Map.Map (ScriptHash (EraCrypto era)) (Script era) ->
  Maybe (PlutusScript era)
lookupPlutusScript :: forall era.
AlonzoEraScript era =>
ScriptHash (EraCrypto era)
-> Map (ScriptHash (EraCrypto era)) (Script era)
-> Maybe (PlutusScript era)
lookupPlutusScript ScriptHash (EraCrypto era)
scriptHash = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ScriptHash (EraCrypto era)
scriptHash forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall era.
AlonzoEraScript era =>
Script era -> Maybe (PlutusScript era)
toPlutusScript