{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

{- HLINT ignore "Avoid lambda using `infix`" -}
{- HLINT ignore "Use section" -}

module Cardano.Api.Script (
    -- * Languages
    SimpleScriptV1,
    SimpleScriptV2,
    PlutusScriptV1,
    PlutusScriptV2,
    ScriptLanguage(..),
    SimpleScriptVersion(..),
    PlutusScriptVersion(..),
    AnyScriptLanguage(..),
    AnyPlutusScriptVersion(..),
    IsScriptLanguage(..),
    IsSimpleScriptLanguage(..),

    -- * Scripts in a specific language
    Script(..),

    -- * Scripts in any language
    ScriptInAnyLang(..),
    toScriptInAnyLang,

    -- * Scripts in an era
    ScriptInEra(..),
    toScriptInEra,
    eraOfScriptInEra,

    -- * Reference scripts
    ReferenceScript(..),
    ReferenceTxInsScriptsInlineDatumsSupportedInEra(..),
    refInsScriptsAndInlineDatsSupportedInEra,
    refScriptToShelleyScript,

    -- * Use of a script in an era as a witness
    WitCtxTxIn, WitCtxMint, WitCtxStake,
    WitCtx(..),
    ScriptWitness(..),
    Witness(..),
    KeyWitnessInCtx(..),
    ScriptWitnessInCtx(..),
    ScriptDatum(..),
    ScriptRedeemer,
    scriptWitnessScript,

    -- ** Languages supported in each era
    ScriptLanguageInEra(..),
    scriptLanguageSupportedInEra,
    languageOfScriptLanguageInEra,
    eraOfScriptLanguageInEra,

    -- * The simple script language
    SimpleScript(..),
    TimeLocksSupported(..),
    timeLocksSupported,
    adjustSimpleScriptVersion,
    SimpleScriptOrReferenceInput(..),

    -- * The Plutus script language
    PlutusScript(..),
    PlutusScriptOrReferenceInput(..),
    examplePlutusScriptAlwaysSucceeds,
    examplePlutusScriptAlwaysFails,

    -- * Script data
    ScriptData(..),

    -- * Script execution units
    ExecutionUnits(..),

    -- * Script hashes
    ScriptHash(..),
    hashScript,

    -- * Internal conversion functions
    toShelleyScript,
    fromShelleyBasedScript,
    toShelleyMultiSig,
    fromShelleyMultiSig,
    toAllegraTimelock,
    fromAllegraTimelock,
    toAlonzoExUnits,
    fromAlonzoExUnits,
    toShelleyScriptHash,
    fromShelleyScriptHash,
    toPlutusData,
    fromPlutusData,
    toAlonzoData,
    fromAlonzoData,
    toAlonzoLanguage,
    fromAlonzoLanguage,
    fromShelleyScriptToReferenceScript,

    -- * Data family instances
    AsType(..),
    Hash(..),
  ) where

import           Prelude

import qualified Data.ByteString.Lazy as LBS
import           Data.ByteString.Short (ShortByteString)
import qualified Data.ByteString.Short as SBS
import           Data.Foldable (toList)
import           Data.Scientific (toBoundedInteger)
import           Data.String (IsString)
import           Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import           Data.Type.Equality (TestEquality (..), (:~:) (Refl))
import           Data.Typeable (Typeable)
import           Numeric.Natural (Natural)

import           Data.Aeson (Value (..), object, (.:), (.=))
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import qualified Data.Sequence.Strict as Seq
import           Data.Vector (Vector)
import qualified Data.Vector as Vector

import           Control.Applicative
import           Control.Monad

import qualified Cardano.Binary as CBOR

import qualified Cardano.Crypto.Hash.Class as Crypto

import           Cardano.Slotting.Slot (SlotNo)

import           Cardano.Ledger.BaseTypes (StrictMaybe (..))
import qualified Cardano.Ledger.Core as Ledger
import qualified Cardano.Ledger.Era as Ledger

import qualified Cardano.Ledger.Keys as Shelley
import qualified Cardano.Ledger.Shelley.Scripts as Shelley
import qualified Cardano.Ledger.ShelleyMA.Timelocks as Timelock
import           Ouroboros.Consensus.Shelley.Eras (StandardCrypto)

import qualified Cardano.Ledger.Alonzo.Language as Alonzo
import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo

import qualified Plutus.V1.Ledger.Examples as Plutus

import           Cardano.Api.EraCast
import           Cardano.Api.Eras
import           Cardano.Api.Error
import           Cardano.Api.Hash
import           Cardano.Api.HasTypeProxy
import           Cardano.Api.KeysShelley
import           Cardano.Api.ScriptData
import           Cardano.Api.SerialiseCBOR
import           Cardano.Api.SerialiseJSON
import           Cardano.Api.SerialiseRaw
import           Cardano.Api.SerialiseTextEnvelope
import           Cardano.Api.SerialiseUsing
import           Cardano.Api.TxIn
import           Cardano.Api.Utils (failEitherWith)

-- ----------------------------------------------------------------------------
-- Types for script language and version
--

-- | The original simple script language which supports
--
-- * require a signature from a given key (by verification key hash)
-- * n-way and combinator
-- * n-way or combinator
-- * m-of-n combinator
--
-- This version of the language was introduced in the 'ShelleyEra'.
--
data SimpleScriptV1

-- | The second version of the simple script language. It has all the features
-- of 'SimpleScriptV1' plus new atomic predicates:
--
-- * require the time be before a given slot number
-- * require the time be after a given slot number
--
-- This version of the language was introduced in the 'AllegraEra'.
--
data SimpleScriptV2

-- | Place holder type to show what the pattern is to extend to multiple
-- languages, not just multiple versions of a single language.
--
data PlutusScriptV1
data PlutusScriptV2

instance HasTypeProxy SimpleScriptV1 where
    data AsType SimpleScriptV1 = AsSimpleScriptV1
    proxyToAsType :: Proxy SimpleScriptV1 -> AsType SimpleScriptV1
proxyToAsType Proxy SimpleScriptV1
_ = AsType SimpleScriptV1
AsSimpleScriptV1

instance HasTypeProxy SimpleScriptV2 where
    data AsType SimpleScriptV2 = AsSimpleScriptV2
    proxyToAsType :: Proxy SimpleScriptV2 -> AsType SimpleScriptV2
proxyToAsType Proxy SimpleScriptV2
_ = AsType SimpleScriptV2
AsSimpleScriptV2

instance HasTypeProxy PlutusScriptV1 where
    data AsType PlutusScriptV1 = AsPlutusScriptV1
    proxyToAsType :: Proxy PlutusScriptV1 -> AsType PlutusScriptV1
proxyToAsType Proxy PlutusScriptV1
_ = AsType PlutusScriptV1
AsPlutusScriptV1

instance HasTypeProxy PlutusScriptV2 where
    data AsType PlutusScriptV2 = AsPlutusScriptV2
    proxyToAsType :: Proxy PlutusScriptV2 -> AsType PlutusScriptV2
proxyToAsType Proxy PlutusScriptV2
_ = AsType PlutusScriptV2
AsPlutusScriptV2

-- ----------------------------------------------------------------------------
-- Value level representation for script languages
--
data ScriptLanguage lang where

     SimpleScriptLanguage :: SimpleScriptVersion lang -> ScriptLanguage lang

     PlutusScriptLanguage :: PlutusScriptVersion lang -> ScriptLanguage lang

deriving instance (Eq   (ScriptLanguage lang))
deriving instance (Show (ScriptLanguage lang))

instance TestEquality ScriptLanguage where
    testEquality :: ScriptLanguage a -> ScriptLanguage b -> Maybe (a :~: b)
testEquality (SimpleScriptLanguage SimpleScriptVersion a
lang)
                 (SimpleScriptLanguage SimpleScriptVersion b
lang') = SimpleScriptVersion a -> SimpleScriptVersion b -> Maybe (a :~: b)
forall k (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality SimpleScriptVersion a
lang SimpleScriptVersion b
lang'

    testEquality (PlutusScriptLanguage PlutusScriptVersion a
lang)
                 (PlutusScriptLanguage PlutusScriptVersion b
lang') = PlutusScriptVersion a -> PlutusScriptVersion b -> Maybe (a :~: b)
forall k (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality PlutusScriptVersion a
lang PlutusScriptVersion b
lang'

    testEquality  ScriptLanguage a
_ ScriptLanguage b
_ = Maybe (a :~: b)
forall a. Maybe a
Nothing


data SimpleScriptVersion lang where

     SimpleScriptV1 :: SimpleScriptVersion SimpleScriptV1
     SimpleScriptV2 :: SimpleScriptVersion SimpleScriptV2

deriving instance (Eq   (SimpleScriptVersion lang))
deriving instance (Show (SimpleScriptVersion lang))

instance TestEquality SimpleScriptVersion where
    testEquality :: SimpleScriptVersion a -> SimpleScriptVersion b -> Maybe (a :~: b)
testEquality SimpleScriptVersion a
SimpleScriptV1 SimpleScriptVersion b
SimpleScriptV1 = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
    testEquality SimpleScriptVersion a
SimpleScriptV2 SimpleScriptVersion b
SimpleScriptV2 = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
    testEquality SimpleScriptVersion a
_              SimpleScriptVersion b
_              = Maybe (a :~: b)
forall a. Maybe a
Nothing


data PlutusScriptVersion lang where
    PlutusScriptV1 :: PlutusScriptVersion PlutusScriptV1
    PlutusScriptV2 :: PlutusScriptVersion PlutusScriptV2

deriving instance (Eq   (PlutusScriptVersion lang))
deriving instance (Show (PlutusScriptVersion lang))

instance TestEquality PlutusScriptVersion where
    testEquality :: PlutusScriptVersion a -> PlutusScriptVersion b -> Maybe (a :~: b)
testEquality PlutusScriptVersion a
PlutusScriptV1 PlutusScriptVersion b
PlutusScriptV1 = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
    testEquality PlutusScriptVersion a
PlutusScriptV2 PlutusScriptVersion b
PlutusScriptV2 = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
    testEquality PlutusScriptVersion a
_ PlutusScriptVersion b
_ = Maybe (a :~: b)
forall a. Maybe a
Nothing


data AnyScriptLanguage where
     AnyScriptLanguage :: ScriptLanguage lang -> AnyScriptLanguage

deriving instance (Show AnyScriptLanguage)

instance Eq AnyScriptLanguage where
    AnyScriptLanguage
a == :: AnyScriptLanguage -> AnyScriptLanguage -> Bool
== AnyScriptLanguage
b = AnyScriptLanguage -> Int
forall a. Enum a => a -> Int
fromEnum AnyScriptLanguage
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== AnyScriptLanguage -> Int
forall a. Enum a => a -> Int
fromEnum AnyScriptLanguage
b

instance Ord AnyScriptLanguage where
    compare :: AnyScriptLanguage -> AnyScriptLanguage -> Ordering
compare AnyScriptLanguage
a AnyScriptLanguage
b = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (AnyScriptLanguage -> Int
forall a. Enum a => a -> Int
fromEnum AnyScriptLanguage
a) (AnyScriptLanguage -> Int
forall a. Enum a => a -> Int
fromEnum AnyScriptLanguage
b)

instance Enum AnyScriptLanguage where
    toEnum :: Int -> AnyScriptLanguage
toEnum Int
0 = ScriptLanguage SimpleScriptV1 -> AnyScriptLanguage
forall lang. ScriptLanguage lang -> AnyScriptLanguage
AnyScriptLanguage (SimpleScriptVersion SimpleScriptV1 -> ScriptLanguage SimpleScriptV1
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
SimpleScriptLanguage SimpleScriptVersion SimpleScriptV1
SimpleScriptV1)
    toEnum Int
1 = ScriptLanguage SimpleScriptV2 -> AnyScriptLanguage
forall lang. ScriptLanguage lang -> AnyScriptLanguage
AnyScriptLanguage (SimpleScriptVersion SimpleScriptV2 -> ScriptLanguage SimpleScriptV2
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
SimpleScriptLanguage SimpleScriptVersion SimpleScriptV2
SimpleScriptV2)
    toEnum Int
2 = ScriptLanguage PlutusScriptV1 -> AnyScriptLanguage
forall lang. ScriptLanguage lang -> AnyScriptLanguage
AnyScriptLanguage (PlutusScriptVersion PlutusScriptV1 -> ScriptLanguage PlutusScriptV1
forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion PlutusScriptV1
PlutusScriptV1)
    toEnum Int
3 = ScriptLanguage PlutusScriptV2 -> AnyScriptLanguage
forall lang. ScriptLanguage lang -> AnyScriptLanguage
AnyScriptLanguage (PlutusScriptVersion PlutusScriptV2 -> ScriptLanguage PlutusScriptV2
forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion PlutusScriptV2
PlutusScriptV2)
    toEnum Int
err = String -> AnyScriptLanguage
forall a. HasCallStack => String -> a
error (String -> AnyScriptLanguage) -> String -> AnyScriptLanguage
forall a b. (a -> b) -> a -> b
$ String
"AnyScriptLanguage.toEnum: bad argument: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
err

    fromEnum :: AnyScriptLanguage -> Int
fromEnum (AnyScriptLanguage (SimpleScriptLanguage SimpleScriptVersion lang
SimpleScriptV1)) = Int
0
    fromEnum (AnyScriptLanguage (SimpleScriptLanguage SimpleScriptVersion lang
SimpleScriptV2)) = Int
1
    fromEnum (AnyScriptLanguage (PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptV1)) = Int
2
    fromEnum (AnyScriptLanguage (PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptV2)) = Int
3

instance Bounded AnyScriptLanguage where
    minBound :: AnyScriptLanguage
minBound = ScriptLanguage SimpleScriptV1 -> AnyScriptLanguage
forall lang. ScriptLanguage lang -> AnyScriptLanguage
AnyScriptLanguage (SimpleScriptVersion SimpleScriptV1 -> ScriptLanguage SimpleScriptV1
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
SimpleScriptLanguage SimpleScriptVersion SimpleScriptV1
SimpleScriptV1)
    maxBound :: AnyScriptLanguage
maxBound = ScriptLanguage PlutusScriptV2 -> AnyScriptLanguage
forall lang. ScriptLanguage lang -> AnyScriptLanguage
AnyScriptLanguage (PlutusScriptVersion PlutusScriptV2 -> ScriptLanguage PlutusScriptV2
forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion PlutusScriptV2
PlutusScriptV2)


data AnyPlutusScriptVersion where
     AnyPlutusScriptVersion :: PlutusScriptVersion lang
                            -> AnyPlutusScriptVersion

deriving instance (Show AnyPlutusScriptVersion)

instance Eq AnyPlutusScriptVersion where
    AnyPlutusScriptVersion
a == :: AnyPlutusScriptVersion -> AnyPlutusScriptVersion -> Bool
== AnyPlutusScriptVersion
b = AnyPlutusScriptVersion -> Int
forall a. Enum a => a -> Int
fromEnum AnyPlutusScriptVersion
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== AnyPlutusScriptVersion -> Int
forall a. Enum a => a -> Int
fromEnum AnyPlutusScriptVersion
b

instance Ord AnyPlutusScriptVersion where
    compare :: AnyPlutusScriptVersion -> AnyPlutusScriptVersion -> Ordering
compare AnyPlutusScriptVersion
a AnyPlutusScriptVersion
b = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (AnyPlutusScriptVersion -> Int
forall a. Enum a => a -> Int
fromEnum AnyPlutusScriptVersion
a) (AnyPlutusScriptVersion -> Int
forall a. Enum a => a -> Int
fromEnum AnyPlutusScriptVersion
b)

instance Enum AnyPlutusScriptVersion where
    toEnum :: Int -> AnyPlutusScriptVersion
toEnum Int
0 = PlutusScriptVersion PlutusScriptV1 -> AnyPlutusScriptVersion
forall lang. PlutusScriptVersion lang -> AnyPlutusScriptVersion
AnyPlutusScriptVersion PlutusScriptVersion PlutusScriptV1
PlutusScriptV1
    toEnum Int
1 = PlutusScriptVersion PlutusScriptV2 -> AnyPlutusScriptVersion
forall lang. PlutusScriptVersion lang -> AnyPlutusScriptVersion
AnyPlutusScriptVersion PlutusScriptVersion PlutusScriptV2
PlutusScriptV2
    toEnum Int
err = String -> AnyPlutusScriptVersion
forall a. HasCallStack => String -> a
error (String -> AnyPlutusScriptVersion)
-> String -> AnyPlutusScriptVersion
forall a b. (a -> b) -> a -> b
$ String
"AnyPlutusScriptVersion.toEnum: bad argument: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
err

    fromEnum :: AnyPlutusScriptVersion -> Int
fromEnum (AnyPlutusScriptVersion PlutusScriptVersion lang
PlutusScriptV1) = Int
0
    fromEnum (AnyPlutusScriptVersion PlutusScriptVersion lang
PlutusScriptV2) = Int
1

instance Bounded AnyPlutusScriptVersion where
    minBound :: AnyPlutusScriptVersion
minBound = PlutusScriptVersion PlutusScriptV1 -> AnyPlutusScriptVersion
forall lang. PlutusScriptVersion lang -> AnyPlutusScriptVersion
AnyPlutusScriptVersion PlutusScriptVersion PlutusScriptV1
PlutusScriptV1
    maxBound :: AnyPlutusScriptVersion
maxBound = PlutusScriptVersion PlutusScriptV2 -> AnyPlutusScriptVersion
forall lang. PlutusScriptVersion lang -> AnyPlutusScriptVersion
AnyPlutusScriptVersion PlutusScriptVersion PlutusScriptV2
PlutusScriptV2

instance ToCBOR AnyPlutusScriptVersion where
    toCBOR :: AnyPlutusScriptVersion -> Encoding
toCBOR = Int -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Int -> Encoding)
-> (AnyPlutusScriptVersion -> Int)
-> AnyPlutusScriptVersion
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyPlutusScriptVersion -> Int
forall a. Enum a => a -> Int
fromEnum

instance FromCBOR AnyPlutusScriptVersion where
    fromCBOR :: Decoder s AnyPlutusScriptVersion
fromCBOR = do
      Int
n <- Decoder s Int
forall a s. FromCBOR a => Decoder s a
fromCBOR
      if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= AnyPlutusScriptVersion -> Int
forall a. Enum a => a -> Int
fromEnum (AnyPlutusScriptVersion
forall a. Bounded a => a
minBound :: AnyPlutusScriptVersion) Bool -> Bool -> Bool
&&
         Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= AnyPlutusScriptVersion -> Int
forall a. Enum a => a -> Int
fromEnum (AnyPlutusScriptVersion
forall a. Bounded a => a
maxBound :: AnyPlutusScriptVersion)
        then AnyPlutusScriptVersion -> Decoder s AnyPlutusScriptVersion
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyPlutusScriptVersion -> Decoder s AnyPlutusScriptVersion)
-> AnyPlutusScriptVersion -> Decoder s AnyPlutusScriptVersion
forall a b. (a -> b) -> a -> b
$! Int -> AnyPlutusScriptVersion
forall a. Enum a => Int -> a
toEnum Int
n
        else String -> Decoder s AnyPlutusScriptVersion
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"plutus script version out of bounds"

instance ToJSON AnyPlutusScriptVersion where
    toJSON :: AnyPlutusScriptVersion -> Value
toJSON (AnyPlutusScriptVersion PlutusScriptVersion lang
PlutusScriptV1) =
      Text -> Value
Aeson.String Text
"PlutusScriptV1"
    toJSON (AnyPlutusScriptVersion PlutusScriptVersion lang
PlutusScriptV2) =
      Text -> Value
Aeson.String Text
"PlutusScriptV2"

parsePlutusScriptVersion :: Text -> Aeson.Parser AnyPlutusScriptVersion
parsePlutusScriptVersion :: Text -> Parser AnyPlutusScriptVersion
parsePlutusScriptVersion Text
t =
  case Text
t of
    Text
"PlutusScriptV1" -> AnyPlutusScriptVersion -> Parser AnyPlutusScriptVersion
forall (m :: * -> *) a. Monad m => a -> m a
return (PlutusScriptVersion PlutusScriptV1 -> AnyPlutusScriptVersion
forall lang. PlutusScriptVersion lang -> AnyPlutusScriptVersion
AnyPlutusScriptVersion PlutusScriptVersion PlutusScriptV1
PlutusScriptV1)
    Text
"PlutusScriptV2" -> AnyPlutusScriptVersion -> Parser AnyPlutusScriptVersion
forall (m :: * -> *) a. Monad m => a -> m a
return (PlutusScriptVersion PlutusScriptV2 -> AnyPlutusScriptVersion
forall lang. PlutusScriptVersion lang -> AnyPlutusScriptVersion
AnyPlutusScriptVersion PlutusScriptVersion PlutusScriptV2
PlutusScriptV2)
    Text
_                -> String -> Parser AnyPlutusScriptVersion
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected PlutusScriptV1 or PlutusScriptV2"

instance FromJSON AnyPlutusScriptVersion where
    parseJSON :: Value -> Parser AnyPlutusScriptVersion
parseJSON = String
-> (Text -> Parser AnyPlutusScriptVersion)
-> Value
-> Parser AnyPlutusScriptVersion
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"PlutusScriptVersion" Text -> Parser AnyPlutusScriptVersion
parsePlutusScriptVersion

instance Aeson.FromJSONKey AnyPlutusScriptVersion where
    fromJSONKey :: FromJSONKeyFunction AnyPlutusScriptVersion
fromJSONKey = (Text -> Parser AnyPlutusScriptVersion)
-> FromJSONKeyFunction AnyPlutusScriptVersion
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
Aeson.FromJSONKeyTextParser Text -> Parser AnyPlutusScriptVersion
parsePlutusScriptVersion

instance Aeson.ToJSONKey AnyPlutusScriptVersion where
    toJSONKey :: ToJSONKeyFunction AnyPlutusScriptVersion
toJSONKey = (AnyPlutusScriptVersion -> Text)
-> ToJSONKeyFunction AnyPlutusScriptVersion
forall a. (a -> Text) -> ToJSONKeyFunction a
Aeson.toJSONKeyText AnyPlutusScriptVersion -> Text
toText
      where
        toText :: AnyPlutusScriptVersion -> Text
        toText :: AnyPlutusScriptVersion -> Text
toText (AnyPlutusScriptVersion PlutusScriptVersion lang
PlutusScriptV1) = Text
"PlutusScriptV1"
        toText (AnyPlutusScriptVersion PlutusScriptVersion lang
PlutusScriptV2) = Text
"PlutusScriptV2"

toAlonzoLanguage :: AnyPlutusScriptVersion -> Alonzo.Language
toAlonzoLanguage :: AnyPlutusScriptVersion -> Language
toAlonzoLanguage (AnyPlutusScriptVersion PlutusScriptVersion lang
PlutusScriptV1) = Language
Alonzo.PlutusV1
toAlonzoLanguage (AnyPlutusScriptVersion PlutusScriptVersion lang
PlutusScriptV2) = Language
Alonzo.PlutusV2

fromAlonzoLanguage :: Alonzo.Language -> AnyPlutusScriptVersion
fromAlonzoLanguage :: Language -> AnyPlutusScriptVersion
fromAlonzoLanguage Language
Alonzo.PlutusV1 = PlutusScriptVersion PlutusScriptV1 -> AnyPlutusScriptVersion
forall lang. PlutusScriptVersion lang -> AnyPlutusScriptVersion
AnyPlutusScriptVersion PlutusScriptVersion PlutusScriptV1
PlutusScriptV1
fromAlonzoLanguage Language
Alonzo.PlutusV2 = PlutusScriptVersion PlutusScriptV2 -> AnyPlutusScriptVersion
forall lang. PlutusScriptVersion lang -> AnyPlutusScriptVersion
AnyPlutusScriptVersion PlutusScriptVersion PlutusScriptV2
PlutusScriptV2


class HasTypeProxy lang => IsScriptLanguage lang where
    scriptLanguage :: ScriptLanguage lang

instance IsScriptLanguage SimpleScriptV1 where
    scriptLanguage :: ScriptLanguage SimpleScriptV1
scriptLanguage = SimpleScriptVersion SimpleScriptV1 -> ScriptLanguage SimpleScriptV1
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
SimpleScriptLanguage SimpleScriptVersion SimpleScriptV1
SimpleScriptV1

instance IsScriptLanguage SimpleScriptV2 where
    scriptLanguage :: ScriptLanguage SimpleScriptV2
scriptLanguage = SimpleScriptVersion SimpleScriptV2 -> ScriptLanguage SimpleScriptV2
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
SimpleScriptLanguage SimpleScriptVersion SimpleScriptV2
SimpleScriptV2

instance IsScriptLanguage PlutusScriptV1 where
    scriptLanguage :: ScriptLanguage PlutusScriptV1
scriptLanguage = PlutusScriptVersion PlutusScriptV1 -> ScriptLanguage PlutusScriptV1
forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion PlutusScriptV1
PlutusScriptV1

instance IsScriptLanguage PlutusScriptV2 where
    scriptLanguage :: ScriptLanguage PlutusScriptV2
scriptLanguage = PlutusScriptVersion PlutusScriptV2 -> ScriptLanguage PlutusScriptV2
forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion PlutusScriptV2
PlutusScriptV2


class IsScriptLanguage lang => IsSimpleScriptLanguage lang where
    simpleScriptVersion :: SimpleScriptVersion lang

instance IsSimpleScriptLanguage SimpleScriptV1 where
    simpleScriptVersion :: SimpleScriptVersion SimpleScriptV1
simpleScriptVersion = SimpleScriptVersion SimpleScriptV1
SimpleScriptV1

instance IsSimpleScriptLanguage SimpleScriptV2 where
    simpleScriptVersion :: SimpleScriptVersion SimpleScriptV2
simpleScriptVersion = SimpleScriptVersion SimpleScriptV2
SimpleScriptV2


class IsScriptLanguage lang => IsPlutusScriptLanguage lang where
    plutusScriptVersion :: PlutusScriptVersion lang

instance IsPlutusScriptLanguage PlutusScriptV1 where
    plutusScriptVersion :: PlutusScriptVersion PlutusScriptV1
plutusScriptVersion = PlutusScriptVersion PlutusScriptV1
PlutusScriptV1

instance IsPlutusScriptLanguage PlutusScriptV2 where
    plutusScriptVersion :: PlutusScriptVersion PlutusScriptV2
plutusScriptVersion = PlutusScriptVersion PlutusScriptV2
PlutusScriptV2

-- ----------------------------------------------------------------------------
-- Script type: covering all script languages
--

-- | A script in a particular language.
--
-- See also 'ScriptInAnyLang' for a script in any of the known languages.
--
-- See also 'ScriptInEra' for a script in a language that is available within
-- a particular era.
--
-- Note that some but not all scripts have an external JSON syntax, hence this
-- type has no JSON serialisation instances. The 'SimpleScript' family of
-- languages do have a JSON syntax and thus have 'ToJSON'\/'FromJSON' instances.
--
data Script lang where

     SimpleScript :: !(SimpleScriptVersion lang)
                  -> !(SimpleScript lang)
                  -> Script lang

     PlutusScript :: !(PlutusScriptVersion lang)
                  -> !(PlutusScript lang)
                  -> Script lang

deriving instance (Eq   (Script lang))
deriving instance (Show (Script lang))

instance HasTypeProxy lang => HasTypeProxy (Script lang) where
    data AsType (Script lang) = AsScript (AsType lang)
    proxyToAsType :: Proxy (Script lang) -> AsType (Script lang)
proxyToAsType Proxy (Script lang)
_ = AsType lang -> AsType (Script lang)
forall lang. AsType lang -> AsType (Script lang)
AsScript (Proxy lang -> AsType lang
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType (Proxy lang
forall k (t :: k). Proxy t
Proxy :: Proxy lang))

instance IsScriptLanguage lang => SerialiseAsCBOR (Script lang) where
    serialiseToCBOR :: Script lang -> ByteString
serialiseToCBOR (SimpleScript SimpleScriptVersion lang
SimpleScriptV1 SimpleScript lang
s) =
      MultiSig StandardCrypto -> ByteString
forall a. ToCBOR a => a -> ByteString
CBOR.serialize' (SimpleScript SimpleScriptV1 -> MultiSig StandardCrypto
toShelleyMultiSig SimpleScript lang
SimpleScript SimpleScriptV1
s)

    serialiseToCBOR (SimpleScript SimpleScriptVersion lang
SimpleScriptV2 SimpleScript lang
s) =
      Timelock StandardCrypto -> ByteString
forall a. ToCBOR a => a -> ByteString
CBOR.serialize' (SimpleScript lang -> Timelock StandardCrypto
forall lang. SimpleScript lang -> Timelock StandardCrypto
toAllegraTimelock SimpleScript lang
s :: Timelock.Timelock StandardCrypto)

    serialiseToCBOR (PlutusScript PlutusScriptVersion lang
PlutusScriptV1 PlutusScript lang
s) =
      PlutusScript lang -> ByteString
forall a. ToCBOR a => a -> ByteString
CBOR.serialize' PlutusScript lang
s

    serialiseToCBOR (PlutusScript PlutusScriptVersion lang
PlutusScriptV2 PlutusScript lang
s) =
      PlutusScript lang -> ByteString
forall a. ToCBOR a => a -> ByteString
CBOR.serialize' PlutusScript lang
s

    deserialiseFromCBOR :: AsType (Script lang)
-> ByteString -> Either DecoderError (Script lang)
deserialiseFromCBOR AsType (Script lang)
_ ByteString
bs =
      case ScriptLanguage lang
forall lang. IsScriptLanguage lang => ScriptLanguage lang
scriptLanguage :: ScriptLanguage lang of
        SimpleScriptLanguage SimpleScriptVersion lang
SimpleScriptV1 ->
              SimpleScriptVersion SimpleScriptV1
-> SimpleScript SimpleScriptV1 -> Script SimpleScriptV1
forall lang.
SimpleScriptVersion lang -> SimpleScript lang -> Script lang
SimpleScript SimpleScriptVersion SimpleScriptV1
SimpleScriptV1
            (SimpleScript SimpleScriptV1 -> Script SimpleScriptV1)
-> (MultiSig StandardCrypto -> SimpleScript SimpleScriptV1)
-> MultiSig StandardCrypto
-> Script SimpleScriptV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiSig StandardCrypto -> SimpleScript SimpleScriptV1
forall lang. MultiSig StandardCrypto -> SimpleScript lang
fromShelleyMultiSig
          (MultiSig StandardCrypto -> Script SimpleScriptV1)
-> Either DecoderError (MultiSig StandardCrypto)
-> Either DecoderError (Script SimpleScriptV1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> (forall s. Decoder s (Annotator (MultiSig StandardCrypto)))
-> LByteString
-> Either DecoderError (MultiSig StandardCrypto)
forall a.
Text
-> (forall s. Decoder s (Annotator a))
-> LByteString
-> Either DecoderError a
CBOR.decodeAnnotator Text
"Script" forall s. Decoder s (Annotator (MultiSig StandardCrypto))
forall a s. FromCBOR a => Decoder s a
fromCBOR (ByteString -> LByteString
LBS.fromStrict ByteString
bs)

        SimpleScriptLanguage SimpleScriptVersion lang
SimpleScriptV2 ->
              SimpleScriptVersion SimpleScriptV2
-> SimpleScript SimpleScriptV2 -> Script SimpleScriptV2
forall lang.
SimpleScriptVersion lang -> SimpleScript lang -> Script lang
SimpleScript SimpleScriptVersion SimpleScriptV2
SimpleScriptV2
            (SimpleScript SimpleScriptV2 -> Script SimpleScriptV2)
-> (Timelock StandardCrypto -> SimpleScript SimpleScriptV2)
-> Timelock StandardCrypto
-> Script SimpleScriptV2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TimeLocksSupported SimpleScriptV2
-> Timelock StandardCrypto -> SimpleScript SimpleScriptV2
forall lang.
TimeLocksSupported lang
-> Timelock StandardCrypto -> SimpleScript lang
fromAllegraTimelock TimeLocksSupported SimpleScriptV2
TimeLocksInSimpleScriptV2
                                :: Timelock.Timelock StandardCrypto
                                -> SimpleScript SimpleScriptV2)
          (Timelock StandardCrypto -> Script SimpleScriptV2)
-> Either DecoderError (Timelock StandardCrypto)
-> Either DecoderError (Script SimpleScriptV2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> (forall s. Decoder s (Annotator (Timelock StandardCrypto)))
-> LByteString
-> Either DecoderError (Timelock StandardCrypto)
forall a.
Text
-> (forall s. Decoder s (Annotator a))
-> LByteString
-> Either DecoderError a
CBOR.decodeAnnotator Text
"Script" forall s. Decoder s (Annotator (Timelock StandardCrypto))
forall a s. FromCBOR a => Decoder s a
fromCBOR (ByteString -> LByteString
LBS.fromStrict ByteString
bs)

        PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptV1 ->
              PlutusScriptVersion PlutusScriptV1
-> PlutusScript PlutusScriptV1 -> Script PlutusScriptV1
forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
PlutusScript PlutusScriptVersion PlutusScriptV1
PlutusScriptV1
          (PlutusScript PlutusScriptV1 -> Script PlutusScriptV1)
-> Either DecoderError (PlutusScript PlutusScriptV1)
-> Either DecoderError (Script PlutusScriptV1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either DecoderError (PlutusScript PlutusScriptV1)
forall a. FromCBOR a => ByteString -> Either DecoderError a
CBOR.decodeFull' ByteString
bs

        PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptV2 ->
              PlutusScriptVersion PlutusScriptV2
-> PlutusScript PlutusScriptV2 -> Script PlutusScriptV2
forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
PlutusScript PlutusScriptVersion PlutusScriptV2
PlutusScriptV2
          (PlutusScript PlutusScriptV2 -> Script PlutusScriptV2)
-> Either DecoderError (PlutusScript PlutusScriptV2)
-> Either DecoderError (Script PlutusScriptV2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either DecoderError (PlutusScript PlutusScriptV2)
forall a. FromCBOR a => ByteString -> Either DecoderError a
CBOR.decodeFull' ByteString
bs

instance IsScriptLanguage lang => HasTextEnvelope (Script lang) where
    textEnvelopeType :: AsType (Script lang) -> TextEnvelopeType
textEnvelopeType AsType (Script lang)
_ =
      case ScriptLanguage lang
forall lang. IsScriptLanguage lang => ScriptLanguage lang
scriptLanguage :: ScriptLanguage lang of
        SimpleScriptLanguage SimpleScriptVersion lang
SimpleScriptV1 -> TextEnvelopeType
"SimpleScriptV1"
        SimpleScriptLanguage SimpleScriptVersion lang
SimpleScriptV2 -> TextEnvelopeType
"SimpleScriptV2"
        PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptV1 -> TextEnvelopeType
"PlutusScriptV1"
        PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptV2 -> TextEnvelopeType
"PlutusScriptV2"


-- ----------------------------------------------------------------------------
-- Scripts in any language
--

-- | Sometimes it is necessary to handle all languages without making static
-- type distinctions between languages. For example, when reading external
-- input, or before the era context is known.
--
-- Use 'toScriptInEra' to convert to a script in the context of an era.
--
data ScriptInAnyLang where
     ScriptInAnyLang :: ScriptLanguage lang
                     -> Script lang
                     -> ScriptInAnyLang

deriving instance Show ScriptInAnyLang

-- The GADT in the ScriptInAnyLang constructor requires a custom Eq instance
instance Eq ScriptInAnyLang where
    == :: ScriptInAnyLang -> ScriptInAnyLang -> Bool
(==) (ScriptInAnyLang ScriptLanguage lang
lang  Script lang
script)
         (ScriptInAnyLang ScriptLanguage lang
lang' Script lang
script') =
      case ScriptLanguage lang -> ScriptLanguage lang -> Maybe (lang :~: lang)
forall k (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality ScriptLanguage lang
lang ScriptLanguage lang
lang' of
        Maybe (lang :~: lang)
Nothing   -> Bool
False
        Just lang :~: lang
Refl -> Script lang
script Script lang -> Script lang -> Bool
forall a. Eq a => a -> a -> Bool
== Script lang
Script lang
script'

instance ToJSON ScriptInAnyLang where
  toJSON :: ScriptInAnyLang -> Value
toJSON (ScriptInAnyLang ScriptLanguage lang
l Script lang
s) =
    [Pair] -> Value
object [ Key
"scriptLanguage" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ScriptLanguage lang -> String
forall a. Show a => a -> String
show ScriptLanguage lang
l
           , Key
"script" Key -> TextEnvelope -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ScriptLanguage lang
-> (IsScriptLanguage lang => TextEnvelope) -> TextEnvelope
forall lang a.
ScriptLanguage lang -> (IsScriptLanguage lang => a) -> a
obtainScriptLangConstraint ScriptLanguage lang
l
                           (Maybe TextEnvelopeDescr -> Script lang -> TextEnvelope
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> TextEnvelope
serialiseToTextEnvelope Maybe TextEnvelopeDescr
forall a. Maybe a
Nothing Script lang
s)
           ]
      where
       obtainScriptLangConstraint
         :: ScriptLanguage lang
         -> (IsScriptLanguage lang => a)
         -> a
       obtainScriptLangConstraint :: ScriptLanguage lang -> (IsScriptLanguage lang => a) -> a
obtainScriptLangConstraint (SimpleScriptLanguage SimpleScriptVersion lang
SimpleScriptV1) IsScriptLanguage lang => a
f = a
IsScriptLanguage lang => a
f
       obtainScriptLangConstraint (SimpleScriptLanguage SimpleScriptVersion lang
SimpleScriptV2) IsScriptLanguage lang => a
f = a
IsScriptLanguage lang => a
f
       obtainScriptLangConstraint (PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptV1) IsScriptLanguage lang => a
f = a
IsScriptLanguage lang => a
f
       obtainScriptLangConstraint (PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptV2) IsScriptLanguage lang => a
f = a
IsScriptLanguage lang => a
f

instance FromJSON ScriptInAnyLang where
  parseJSON :: Value -> Parser ScriptInAnyLang
parseJSON = String
-> (Object -> Parser ScriptInAnyLang)
-> Value
-> Parser ScriptInAnyLang
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"ScriptInAnyLang" ((Object -> Parser ScriptInAnyLang)
 -> Value -> Parser ScriptInAnyLang)
-> (Object -> Parser ScriptInAnyLang)
-> Value
-> Parser ScriptInAnyLang
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    TextEnvelope
textEnvelopeScript <- Object
o Object -> Key -> Parser TextEnvelope
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"script"
    case TextEnvelope -> Either TextEnvelopeError ScriptInAnyLang
textEnvelopeToScript TextEnvelope
textEnvelopeScript of
      Left TextEnvelopeError
textEnvErr -> String -> Parser ScriptInAnyLang
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ScriptInAnyLang)
-> String -> Parser ScriptInAnyLang
forall a b. (a -> b) -> a -> b
$ TextEnvelopeError -> String
forall e. Error e => e -> String
displayError TextEnvelopeError
textEnvErr
      Right (ScriptInAnyLang ScriptLanguage lang
l Script lang
s) -> ScriptInAnyLang -> Parser ScriptInAnyLang
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScriptInAnyLang -> Parser ScriptInAnyLang)
-> ScriptInAnyLang -> Parser ScriptInAnyLang
forall a b. (a -> b) -> a -> b
$ ScriptLanguage lang -> Script lang -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang ScriptLanguage lang
l Script lang
s

-- | Convert a script in a specific statically-known language to a
-- 'ScriptInAnyLang'.
--
-- No inverse to this is provided, just do case analysis on the 'ScriptLanguage'
-- field within the 'ScriptInAnyLang' constructor.
--
toScriptInAnyLang :: Script lang -> ScriptInAnyLang
toScriptInAnyLang :: Script lang -> ScriptInAnyLang
toScriptInAnyLang s :: Script lang
s@(SimpleScript SimpleScriptVersion lang
v SimpleScript lang
_) =
    ScriptLanguage lang -> Script lang -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang (SimpleScriptVersion lang -> ScriptLanguage lang
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
SimpleScriptLanguage SimpleScriptVersion lang
v) Script lang
s
toScriptInAnyLang s :: Script lang
s@(PlutusScript PlutusScriptVersion lang
v PlutusScript lang
_) =
    ScriptLanguage lang -> Script lang -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang (PlutusScriptVersion lang -> ScriptLanguage lang
forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion lang
v) Script lang
s

instance HasTypeProxy ScriptInAnyLang where
    data AsType ScriptInAnyLang = AsScriptInAnyLang
    proxyToAsType :: Proxy ScriptInAnyLang -> AsType ScriptInAnyLang
proxyToAsType Proxy ScriptInAnyLang
_ = AsType ScriptInAnyLang
AsScriptInAnyLang


-- ----------------------------------------------------------------------------
-- Scripts in the context of a ledger era
--

data ScriptInEra era where
     ScriptInEra :: ScriptLanguageInEra lang era
                 -> Script lang
                 -> ScriptInEra era

deriving instance Show (ScriptInEra era)

-- The GADT in the ScriptInEra constructor requires a custom instance
instance Eq (ScriptInEra era) where
    == :: ScriptInEra era -> ScriptInEra era -> Bool
(==) (ScriptInEra ScriptLanguageInEra lang era
langInEra  Script lang
script)
         (ScriptInEra ScriptLanguageInEra lang era
langInEra' Script lang
script') =
      case ScriptLanguage lang -> ScriptLanguage lang -> Maybe (lang :~: lang)
forall k (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (ScriptLanguageInEra lang era -> ScriptLanguage lang
forall lang era.
ScriptLanguageInEra lang era -> ScriptLanguage lang
languageOfScriptLanguageInEra ScriptLanguageInEra lang era
langInEra)
                        (ScriptLanguageInEra lang era -> ScriptLanguage lang
forall lang era.
ScriptLanguageInEra lang era -> ScriptLanguage lang
languageOfScriptLanguageInEra ScriptLanguageInEra lang era
langInEra') of
        Maybe (lang :~: lang)
Nothing   -> Bool
False
        Just lang :~: lang
Refl -> Script lang
script Script lang -> Script lang -> Bool
forall a. Eq a => a -> a -> Bool
== Script lang
Script lang
script'


data ScriptLanguageInEra lang era where

     SimpleScriptV1InShelley :: ScriptLanguageInEra SimpleScriptV1 ShelleyEra
     SimpleScriptV1InAllegra :: ScriptLanguageInEra SimpleScriptV1 AllegraEra
     SimpleScriptV1InMary    :: ScriptLanguageInEra SimpleScriptV1 MaryEra
     SimpleScriptV1InAlonzo  :: ScriptLanguageInEra SimpleScriptV1 AlonzoEra
     SimpleScriptV1InBabbage :: ScriptLanguageInEra SimpleScriptV1 BabbageEra

     SimpleScriptV2InAllegra :: ScriptLanguageInEra SimpleScriptV2 AllegraEra
     SimpleScriptV2InMary    :: ScriptLanguageInEra SimpleScriptV2 MaryEra
     SimpleScriptV2InAlonzo  :: ScriptLanguageInEra SimpleScriptV2 AlonzoEra
     SimpleScriptV2InBabbage :: ScriptLanguageInEra SimpleScriptV2 BabbageEra

     PlutusScriptV1InAlonzo  :: ScriptLanguageInEra PlutusScriptV1 AlonzoEra
     PlutusScriptV1InBabbage :: ScriptLanguageInEra PlutusScriptV1 BabbageEra

     PlutusScriptV2InBabbage :: ScriptLanguageInEra PlutusScriptV2 BabbageEra



deriving instance Eq   (ScriptLanguageInEra lang era)
deriving instance Show (ScriptLanguageInEra lang era)

instance ToJSON (ScriptLanguageInEra lang era) where
  toJSON :: ScriptLanguageInEra lang era -> Value
toJSON ScriptLanguageInEra lang era
sLangInEra = Text -> Value
Aeson.String (Text -> Value) -> (String -> Text) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ ScriptLanguageInEra lang era -> String
forall a. Show a => a -> String
show ScriptLanguageInEra lang era
sLangInEra


instance HasTypeProxy era => HasTypeProxy (ScriptInEra era) where
    data AsType (ScriptInEra era) = AsScriptInEra (AsType era)
    proxyToAsType :: Proxy (ScriptInEra era) -> AsType (ScriptInEra era)
proxyToAsType Proxy (ScriptInEra era)
_ = AsType era -> AsType (ScriptInEra era)
forall era. AsType era -> AsType (ScriptInEra era)
AsScriptInEra (Proxy era -> AsType era
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType (Proxy era
forall k (t :: k). Proxy t
Proxy :: Proxy era))


-- | Check if a given script language is supported in a given era, and if so
-- return the evidence.
--
scriptLanguageSupportedInEra :: CardanoEra era
                             -> ScriptLanguage lang
                             -> Maybe (ScriptLanguageInEra lang era)
scriptLanguageSupportedInEra :: CardanoEra era
-> ScriptLanguage lang -> Maybe (ScriptLanguageInEra lang era)
scriptLanguageSupportedInEra CardanoEra era
era ScriptLanguage lang
lang =
    case (CardanoEra era
era, ScriptLanguage lang
lang) of
      (CardanoEra era
ShelleyEra, SimpleScriptLanguage SimpleScriptVersion lang
SimpleScriptV1) ->
        ScriptLanguageInEra SimpleScriptV1 ShelleyEra
-> Maybe (ScriptLanguageInEra SimpleScriptV1 ShelleyEra)
forall a. a -> Maybe a
Just ScriptLanguageInEra SimpleScriptV1 ShelleyEra
SimpleScriptV1InShelley

      (CardanoEra era
AllegraEra, SimpleScriptLanguage SimpleScriptVersion lang
SimpleScriptV1) ->
        ScriptLanguageInEra SimpleScriptV1 AllegraEra
-> Maybe (ScriptLanguageInEra SimpleScriptV1 AllegraEra)
forall a. a -> Maybe a
Just ScriptLanguageInEra SimpleScriptV1 AllegraEra
SimpleScriptV1InAllegra

      (CardanoEra era
MaryEra, SimpleScriptLanguage SimpleScriptVersion lang
SimpleScriptV1) ->
        ScriptLanguageInEra SimpleScriptV1 MaryEra
-> Maybe (ScriptLanguageInEra SimpleScriptV1 MaryEra)
forall a. a -> Maybe a
Just ScriptLanguageInEra SimpleScriptV1 MaryEra
SimpleScriptV1InMary

      (CardanoEra era
AllegraEra, SimpleScriptLanguage SimpleScriptVersion lang
SimpleScriptV2) ->
        ScriptLanguageInEra SimpleScriptV2 AllegraEra
-> Maybe (ScriptLanguageInEra SimpleScriptV2 AllegraEra)
forall a. a -> Maybe a
Just ScriptLanguageInEra SimpleScriptV2 AllegraEra
SimpleScriptV2InAllegra

      (CardanoEra era
MaryEra, SimpleScriptLanguage SimpleScriptVersion lang
SimpleScriptV2) ->
        ScriptLanguageInEra SimpleScriptV2 MaryEra
-> Maybe (ScriptLanguageInEra SimpleScriptV2 MaryEra)
forall a. a -> Maybe a
Just ScriptLanguageInEra SimpleScriptV2 MaryEra
SimpleScriptV2InMary

      (CardanoEra era
AlonzoEra, SimpleScriptLanguage SimpleScriptVersion lang
SimpleScriptV1) ->
        ScriptLanguageInEra SimpleScriptV1 AlonzoEra
-> Maybe (ScriptLanguageInEra SimpleScriptV1 AlonzoEra)
forall a. a -> Maybe a
Just ScriptLanguageInEra SimpleScriptV1 AlonzoEra
SimpleScriptV1InAlonzo

      (CardanoEra era
AlonzoEra, SimpleScriptLanguage SimpleScriptVersion lang
SimpleScriptV2) ->
        ScriptLanguageInEra SimpleScriptV2 AlonzoEra
-> Maybe (ScriptLanguageInEra SimpleScriptV2 AlonzoEra)
forall a. a -> Maybe a
Just ScriptLanguageInEra SimpleScriptV2 AlonzoEra
SimpleScriptV2InAlonzo

      (CardanoEra era
AlonzoEra, PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptV1) ->
        ScriptLanguageInEra PlutusScriptV1 AlonzoEra
-> Maybe (ScriptLanguageInEra PlutusScriptV1 AlonzoEra)
forall a. a -> Maybe a
Just ScriptLanguageInEra PlutusScriptV1 AlonzoEra
PlutusScriptV1InAlonzo

      (CardanoEra era
BabbageEra, SimpleScriptLanguage SimpleScriptVersion lang
SimpleScriptV1) ->
        ScriptLanguageInEra SimpleScriptV1 BabbageEra
-> Maybe (ScriptLanguageInEra SimpleScriptV1 BabbageEra)
forall a. a -> Maybe a
Just ScriptLanguageInEra SimpleScriptV1 BabbageEra
SimpleScriptV1InBabbage

      (CardanoEra era
BabbageEra, SimpleScriptLanguage SimpleScriptVersion lang
SimpleScriptV2) ->
        ScriptLanguageInEra SimpleScriptV2 BabbageEra
-> Maybe (ScriptLanguageInEra SimpleScriptV2 BabbageEra)
forall a. a -> Maybe a
Just ScriptLanguageInEra SimpleScriptV2 BabbageEra
SimpleScriptV2InBabbage

      (CardanoEra era
BabbageEra, PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptV1) ->
        ScriptLanguageInEra PlutusScriptV1 BabbageEra
-> Maybe (ScriptLanguageInEra PlutusScriptV1 BabbageEra)
forall a. a -> Maybe a
Just ScriptLanguageInEra PlutusScriptV1 BabbageEra
PlutusScriptV1InBabbage

      (CardanoEra era
BabbageEra, PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptV2) ->
        ScriptLanguageInEra PlutusScriptV2 BabbageEra
-> Maybe (ScriptLanguageInEra PlutusScriptV2 BabbageEra)
forall a. a -> Maybe a
Just ScriptLanguageInEra PlutusScriptV2 BabbageEra
PlutusScriptV2InBabbage

      (CardanoEra era, ScriptLanguage lang)
_ -> Maybe (ScriptLanguageInEra lang era)
forall a. Maybe a
Nothing

languageOfScriptLanguageInEra :: ScriptLanguageInEra lang era
                              -> ScriptLanguage lang
languageOfScriptLanguageInEra :: ScriptLanguageInEra lang era -> ScriptLanguage lang
languageOfScriptLanguageInEra ScriptLanguageInEra lang era
langInEra =
    case ScriptLanguageInEra lang era
langInEra of
      ScriptLanguageInEra lang era
SimpleScriptV1InShelley -> SimpleScriptVersion SimpleScriptV1 -> ScriptLanguage SimpleScriptV1
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
SimpleScriptLanguage SimpleScriptVersion SimpleScriptV1
SimpleScriptV1
      ScriptLanguageInEra lang era
SimpleScriptV1InAllegra -> SimpleScriptVersion SimpleScriptV1 -> ScriptLanguage SimpleScriptV1
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
SimpleScriptLanguage SimpleScriptVersion SimpleScriptV1
SimpleScriptV1
      ScriptLanguageInEra lang era
SimpleScriptV1InMary    -> SimpleScriptVersion SimpleScriptV1 -> ScriptLanguage SimpleScriptV1
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
SimpleScriptLanguage SimpleScriptVersion SimpleScriptV1
SimpleScriptV1
      ScriptLanguageInEra lang era
SimpleScriptV1InAlonzo  -> SimpleScriptVersion SimpleScriptV1 -> ScriptLanguage SimpleScriptV1
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
SimpleScriptLanguage SimpleScriptVersion SimpleScriptV1
SimpleScriptV1
      ScriptLanguageInEra lang era
SimpleScriptV1InBabbage -> SimpleScriptVersion SimpleScriptV1 -> ScriptLanguage SimpleScriptV1
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
SimpleScriptLanguage SimpleScriptVersion SimpleScriptV1
SimpleScriptV1

      ScriptLanguageInEra lang era
SimpleScriptV2InAllegra -> SimpleScriptVersion SimpleScriptV2 -> ScriptLanguage SimpleScriptV2
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
SimpleScriptLanguage SimpleScriptVersion SimpleScriptV2
SimpleScriptV2
      ScriptLanguageInEra lang era
SimpleScriptV2InMary    -> SimpleScriptVersion SimpleScriptV2 -> ScriptLanguage SimpleScriptV2
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
SimpleScriptLanguage SimpleScriptVersion SimpleScriptV2
SimpleScriptV2
      ScriptLanguageInEra lang era
SimpleScriptV2InAlonzo  -> SimpleScriptVersion SimpleScriptV2 -> ScriptLanguage SimpleScriptV2
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
SimpleScriptLanguage SimpleScriptVersion SimpleScriptV2
SimpleScriptV2
      ScriptLanguageInEra lang era
SimpleScriptV2InBabbage -> SimpleScriptVersion SimpleScriptV2 -> ScriptLanguage SimpleScriptV2
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
SimpleScriptLanguage SimpleScriptVersion SimpleScriptV2
SimpleScriptV2

      ScriptLanguageInEra lang era
PlutusScriptV1InAlonzo  -> PlutusScriptVersion PlutusScriptV1 -> ScriptLanguage PlutusScriptV1
forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion PlutusScriptV1
PlutusScriptV1
      ScriptLanguageInEra lang era
PlutusScriptV1InBabbage -> PlutusScriptVersion PlutusScriptV1 -> ScriptLanguage PlutusScriptV1
forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion PlutusScriptV1
PlutusScriptV1
      ScriptLanguageInEra lang era
PlutusScriptV2InBabbage -> PlutusScriptVersion PlutusScriptV2 -> ScriptLanguage PlutusScriptV2
forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion PlutusScriptV2
PlutusScriptV2

eraOfScriptLanguageInEra :: ScriptLanguageInEra lang era
                         -> ShelleyBasedEra era
eraOfScriptLanguageInEra :: ScriptLanguageInEra lang era -> ShelleyBasedEra era
eraOfScriptLanguageInEra ScriptLanguageInEra lang era
langInEra =
    case ScriptLanguageInEra lang era
langInEra of
      ScriptLanguageInEra lang era
SimpleScriptV1InShelley -> ShelleyBasedEra era
ShelleyBasedEra ShelleyEra
ShelleyBasedEraShelley

      ScriptLanguageInEra lang era
SimpleScriptV1InAllegra -> ShelleyBasedEra era
ShelleyBasedEra AllegraEra
ShelleyBasedEraAllegra
      ScriptLanguageInEra lang era
SimpleScriptV2InAllegra -> ShelleyBasedEra era
ShelleyBasedEra AllegraEra
ShelleyBasedEraAllegra

      ScriptLanguageInEra lang era
SimpleScriptV1InMary    -> ShelleyBasedEra era
ShelleyBasedEra MaryEra
ShelleyBasedEraMary
      ScriptLanguageInEra lang era
SimpleScriptV2InMary    -> ShelleyBasedEra era
ShelleyBasedEra MaryEra
ShelleyBasedEraMary

      ScriptLanguageInEra lang era
SimpleScriptV1InAlonzo  -> ShelleyBasedEra era
ShelleyBasedEra AlonzoEra
ShelleyBasedEraAlonzo
      ScriptLanguageInEra lang era
SimpleScriptV2InAlonzo  -> ShelleyBasedEra era
ShelleyBasedEra AlonzoEra
ShelleyBasedEraAlonzo

      ScriptLanguageInEra lang era
PlutusScriptV1InAlonzo  -> ShelleyBasedEra era
ShelleyBasedEra AlonzoEra
ShelleyBasedEraAlonzo

      ScriptLanguageInEra lang era
SimpleScriptV1InBabbage  -> ShelleyBasedEra era
ShelleyBasedEra BabbageEra
ShelleyBasedEraBabbage
      ScriptLanguageInEra lang era
SimpleScriptV2InBabbage  -> ShelleyBasedEra era
ShelleyBasedEra BabbageEra
ShelleyBasedEraBabbage

      ScriptLanguageInEra lang era
PlutusScriptV1InBabbage -> ShelleyBasedEra era
ShelleyBasedEra BabbageEra
ShelleyBasedEraBabbage
      ScriptLanguageInEra lang era
PlutusScriptV2InBabbage -> ShelleyBasedEra era
ShelleyBasedEra BabbageEra
ShelleyBasedEraBabbage

-- | Given a target era and a script in some language, check if the language is
-- supported in that era, and if so return a 'ScriptInEra'.
--
toScriptInEra :: CardanoEra era -> ScriptInAnyLang -> Maybe (ScriptInEra era)
toScriptInEra :: CardanoEra era -> ScriptInAnyLang -> Maybe (ScriptInEra era)
toScriptInEra CardanoEra era
era (ScriptInAnyLang ScriptLanguage lang
lang Script lang
s) = do
    ScriptLanguageInEra lang era
lang' <- CardanoEra era
-> ScriptLanguage lang -> Maybe (ScriptLanguageInEra lang era)
forall era lang.
CardanoEra era
-> ScriptLanguage lang -> Maybe (ScriptLanguageInEra lang era)
scriptLanguageSupportedInEra CardanoEra era
era ScriptLanguage lang
lang
    ScriptInEra era -> Maybe (ScriptInEra era)
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra lang era
lang' Script lang
s)

eraOfScriptInEra :: ScriptInEra era -> ShelleyBasedEra era
eraOfScriptInEra :: ScriptInEra era -> ShelleyBasedEra era
eraOfScriptInEra (ScriptInEra ScriptLanguageInEra lang era
langInEra Script lang
_) = ScriptLanguageInEra lang era -> ShelleyBasedEra era
forall lang era.
ScriptLanguageInEra lang era -> ShelleyBasedEra era
eraOfScriptLanguageInEra ScriptLanguageInEra lang era
langInEra

-- ----------------------------------------------------------------------------
-- Scripts used in a transaction (in an era) to witness authorised use
--

-- | A tag type for the context in which a script is used in a transaction.
--
-- This type tags the context as being to witness a transaction input.
--
data WitCtxTxIn

-- | A tag type for the context in which a script is used in a transaction.
--
-- This type tags the context as being to witness minting.
--
data WitCtxMint

-- | A tag type for the context in which a script is used in a transaction.
--
-- This type tags the context as being to witness the use of stake addresses in
-- both certificates and withdrawals.
--
data WitCtxStake


-- | This GADT provides a value-level representation of all the witness
-- contexts. This enables pattern matching on the context to allow them to be
-- treated in a non-uniform way.
--
data WitCtx witctx where
     WitCtxTxIn  :: WitCtx WitCtxTxIn
     WitCtxMint  :: WitCtx WitCtxMint
     WitCtxStake :: WitCtx WitCtxStake

-- | Scripts can now exist in the UTxO at a transaction output. We can
-- reference these scripts via specification of a reference transaction input
-- in order to witness spending inputs, withdrawals, certificates
-- or to mint tokens. This datatype encapsulates this concept.
data PlutusScriptOrReferenceInput lang
  = PScript (PlutusScript lang)
  | PReferenceScript TxIn (Maybe ScriptHash)
  deriving (PlutusScriptOrReferenceInput lang
-> PlutusScriptOrReferenceInput lang -> Bool
(PlutusScriptOrReferenceInput lang
 -> PlutusScriptOrReferenceInput lang -> Bool)
-> (PlutusScriptOrReferenceInput lang
    -> PlutusScriptOrReferenceInput lang -> Bool)
-> Eq (PlutusScriptOrReferenceInput lang)
forall lang.
PlutusScriptOrReferenceInput lang
-> PlutusScriptOrReferenceInput lang -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlutusScriptOrReferenceInput lang
-> PlutusScriptOrReferenceInput lang -> Bool
$c/= :: forall lang.
PlutusScriptOrReferenceInput lang
-> PlutusScriptOrReferenceInput lang -> Bool
== :: PlutusScriptOrReferenceInput lang
-> PlutusScriptOrReferenceInput lang -> Bool
$c== :: forall lang.
PlutusScriptOrReferenceInput lang
-> PlutusScriptOrReferenceInput lang -> Bool
Eq, Int -> PlutusScriptOrReferenceInput lang -> ShowS
[PlutusScriptOrReferenceInput lang] -> ShowS
PlutusScriptOrReferenceInput lang -> String
(Int -> PlutusScriptOrReferenceInput lang -> ShowS)
-> (PlutusScriptOrReferenceInput lang -> String)
-> ([PlutusScriptOrReferenceInput lang] -> ShowS)
-> Show (PlutusScriptOrReferenceInput lang)
forall lang. Int -> PlutusScriptOrReferenceInput lang -> ShowS
forall lang. [PlutusScriptOrReferenceInput lang] -> ShowS
forall lang. PlutusScriptOrReferenceInput lang -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlutusScriptOrReferenceInput lang] -> ShowS
$cshowList :: forall lang. [PlutusScriptOrReferenceInput lang] -> ShowS
show :: PlutusScriptOrReferenceInput lang -> String
$cshow :: forall lang. PlutusScriptOrReferenceInput lang -> String
showsPrec :: Int -> PlutusScriptOrReferenceInput lang -> ShowS
$cshowsPrec :: forall lang. Int -> PlutusScriptOrReferenceInput lang -> ShowS
Show)


data SimpleScriptOrReferenceInput lang
  = SScript (SimpleScript lang)
  | SReferenceScript TxIn (Maybe ScriptHash)
  deriving (SimpleScriptOrReferenceInput lang
-> SimpleScriptOrReferenceInput lang -> Bool
(SimpleScriptOrReferenceInput lang
 -> SimpleScriptOrReferenceInput lang -> Bool)
-> (SimpleScriptOrReferenceInput lang
    -> SimpleScriptOrReferenceInput lang -> Bool)
-> Eq (SimpleScriptOrReferenceInput lang)
forall lang.
SimpleScriptOrReferenceInput lang
-> SimpleScriptOrReferenceInput lang -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimpleScriptOrReferenceInput lang
-> SimpleScriptOrReferenceInput lang -> Bool
$c/= :: forall lang.
SimpleScriptOrReferenceInput lang
-> SimpleScriptOrReferenceInput lang -> Bool
== :: SimpleScriptOrReferenceInput lang
-> SimpleScriptOrReferenceInput lang -> Bool
$c== :: forall lang.
SimpleScriptOrReferenceInput lang
-> SimpleScriptOrReferenceInput lang -> Bool
Eq, Int -> SimpleScriptOrReferenceInput lang -> ShowS
[SimpleScriptOrReferenceInput lang] -> ShowS
SimpleScriptOrReferenceInput lang -> String
(Int -> SimpleScriptOrReferenceInput lang -> ShowS)
-> (SimpleScriptOrReferenceInput lang -> String)
-> ([SimpleScriptOrReferenceInput lang] -> ShowS)
-> Show (SimpleScriptOrReferenceInput lang)
forall lang. Int -> SimpleScriptOrReferenceInput lang -> ShowS
forall lang. [SimpleScriptOrReferenceInput lang] -> ShowS
forall lang. SimpleScriptOrReferenceInput lang -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SimpleScriptOrReferenceInput lang] -> ShowS
$cshowList :: forall lang. [SimpleScriptOrReferenceInput lang] -> ShowS
show :: SimpleScriptOrReferenceInput lang -> String
$cshow :: forall lang. SimpleScriptOrReferenceInput lang -> String
showsPrec :: Int -> SimpleScriptOrReferenceInput lang -> ShowS
$cshowsPrec :: forall lang. Int -> SimpleScriptOrReferenceInput lang -> ShowS
Show)

-- | A /use/ of a script within a transaction body to witness that something is
-- being used in an authorised manner. That can be
--
-- * spending a transaction input
-- * minting tokens
-- * using a certificate (stake address certs specifically)
-- * withdrawing from a reward account
--
-- For simple script languages, the use of the script is the same in all
-- contexts. For Plutus scripts, using a script involves supplying a redeemer.
-- In addition, Plutus scripts used for spending inputs must also supply the
-- datum value used when originally creating the TxOut that is now being spent.
--
data ScriptWitness witctx era where

     SimpleScriptWitness :: ScriptLanguageInEra lang era
                         -> SimpleScriptVersion lang
                         -> SimpleScriptOrReferenceInput lang
                         -> ScriptWitness witctx era

     PlutusScriptWitness :: ScriptLanguageInEra  lang era
                         -> PlutusScriptVersion  lang
                         -> PlutusScriptOrReferenceInput lang
                         -> ScriptDatum witctx
                         -> ScriptRedeemer
                         -> ExecutionUnits
                         -> ScriptWitness witctx era

deriving instance Show (ScriptWitness witctx era)

-- The GADT in the SimpleScriptWitness constructor requires a custom instance
instance Eq (ScriptWitness witctx era) where
    == :: ScriptWitness witctx era -> ScriptWitness witctx era -> Bool
(==) (SimpleScriptWitness ScriptLanguageInEra lang era
langInEra  SimpleScriptVersion lang
version  SimpleScriptOrReferenceInput lang
script)
         (SimpleScriptWitness ScriptLanguageInEra lang era
langInEra' SimpleScriptVersion lang
version' SimpleScriptOrReferenceInput lang
script') =
      case ScriptLanguage lang -> ScriptLanguage lang -> Maybe (lang :~: lang)
forall k (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (ScriptLanguageInEra lang era -> ScriptLanguage lang
forall lang era.
ScriptLanguageInEra lang era -> ScriptLanguage lang
languageOfScriptLanguageInEra ScriptLanguageInEra lang era
langInEra)
                        (ScriptLanguageInEra lang era -> ScriptLanguage lang
forall lang era.
ScriptLanguageInEra lang era -> ScriptLanguage lang
languageOfScriptLanguageInEra ScriptLanguageInEra lang era
langInEra') of
        Maybe (lang :~: lang)
Nothing   -> Bool
False
        Just lang :~: lang
Refl -> SimpleScriptVersion lang
version SimpleScriptVersion lang -> SimpleScriptVersion lang -> Bool
forall a. Eq a => a -> a -> Bool
== SimpleScriptVersion lang
SimpleScriptVersion lang
version' Bool -> Bool -> Bool
&& SimpleScriptOrReferenceInput lang
script SimpleScriptOrReferenceInput lang
-> SimpleScriptOrReferenceInput lang -> Bool
forall a. Eq a => a -> a -> Bool
== SimpleScriptOrReferenceInput lang
SimpleScriptOrReferenceInput lang
script'

    (==) (PlutusScriptWitness ScriptLanguageInEra lang era
langInEra  PlutusScriptVersion lang
version   PlutusScriptOrReferenceInput lang
script
                              ScriptDatum witctx
datum      ScriptRedeemer
redeemer  ExecutionUnits
execUnits)
         (PlutusScriptWitness ScriptLanguageInEra lang era
langInEra' PlutusScriptVersion lang
version'  PlutusScriptOrReferenceInput lang
script'
                              ScriptDatum witctx
datum'     ScriptRedeemer
redeemer' ExecutionUnits
execUnits') =
      case ScriptLanguage lang -> ScriptLanguage lang -> Maybe (lang :~: lang)
forall k (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (ScriptLanguageInEra lang era -> ScriptLanguage lang
forall lang era.
ScriptLanguageInEra lang era -> ScriptLanguage lang
languageOfScriptLanguageInEra ScriptLanguageInEra lang era
langInEra)
                        (ScriptLanguageInEra lang era -> ScriptLanguage lang
forall lang era.
ScriptLanguageInEra lang era -> ScriptLanguage lang
languageOfScriptLanguageInEra ScriptLanguageInEra lang era
langInEra') of
        Maybe (lang :~: lang)
Nothing   -> Bool
False
        Just lang :~: lang
Refl ->    PlutusScriptVersion lang
version   PlutusScriptVersion lang -> PlutusScriptVersion lang -> Bool
forall a. Eq a => a -> a -> Bool
== PlutusScriptVersion lang
PlutusScriptVersion lang
version'
                     Bool -> Bool -> Bool
&& PlutusScriptOrReferenceInput lang
script    PlutusScriptOrReferenceInput lang
-> PlutusScriptOrReferenceInput lang -> Bool
forall a. Eq a => a -> a -> Bool
== PlutusScriptOrReferenceInput lang
PlutusScriptOrReferenceInput lang
script'
                     Bool -> Bool -> Bool
&& ScriptDatum witctx
datum     ScriptDatum witctx -> ScriptDatum witctx -> Bool
forall a. Eq a => a -> a -> Bool
== ScriptDatum witctx
datum'
                     Bool -> Bool -> Bool
&& ScriptRedeemer
redeemer  ScriptRedeemer -> ScriptRedeemer -> Bool
forall a. Eq a => a -> a -> Bool
== ScriptRedeemer
redeemer'
                     Bool -> Bool -> Bool
&& ExecutionUnits
execUnits ExecutionUnits -> ExecutionUnits -> Bool
forall a. Eq a => a -> a -> Bool
== ExecutionUnits
execUnits'

    (==)  ScriptWitness witctx era
_ ScriptWitness witctx era
_ = Bool
False

type ScriptRedeemer = ScriptData

data ScriptDatum witctx where
     ScriptDatumForTxIn    :: ScriptData -> ScriptDatum WitCtxTxIn
     InlineScriptDatum     ::               ScriptDatum WitCtxTxIn
     NoScriptDatumForMint  ::               ScriptDatum WitCtxMint
     NoScriptDatumForStake ::               ScriptDatum WitCtxStake

deriving instance Eq   (ScriptDatum witctx)
deriving instance Show (ScriptDatum witctx)

-- We cannot always extract a script from a script witness due to reference scripts.
-- Reference scripts exist in the UTxO, so without access to the UTxO we cannot
-- retrieve the script.
scriptWitnessScript :: ScriptWitness witctx era -> Maybe (ScriptInEra era)
scriptWitnessScript :: ScriptWitness witctx era -> Maybe (ScriptInEra era)
scriptWitnessScript (SimpleScriptWitness ScriptLanguageInEra lang era
langInEra SimpleScriptVersion lang
version (SScript SimpleScript lang
script)) =
    ScriptInEra era -> Maybe (ScriptInEra era)
forall a. a -> Maybe a
Just (ScriptInEra era -> Maybe (ScriptInEra era))
-> ScriptInEra era -> Maybe (ScriptInEra era)
forall a b. (a -> b) -> a -> b
$ ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra lang era
langInEra (SimpleScriptVersion lang -> SimpleScript lang -> Script lang
forall lang.
SimpleScriptVersion lang -> SimpleScript lang -> Script lang
SimpleScript SimpleScriptVersion lang
version SimpleScript lang
script)

scriptWitnessScript (PlutusScriptWitness ScriptLanguageInEra lang era
langInEra PlutusScriptVersion lang
version (PScript PlutusScript lang
script) ScriptDatum witctx
_ ScriptRedeemer
_ ExecutionUnits
_) =
    ScriptInEra era -> Maybe (ScriptInEra era)
forall a. a -> Maybe a
Just (ScriptInEra era -> Maybe (ScriptInEra era))
-> ScriptInEra era -> Maybe (ScriptInEra era)
forall a b. (a -> b) -> a -> b
$ ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra lang era
langInEra (PlutusScriptVersion lang -> PlutusScript lang -> Script lang
forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
PlutusScript PlutusScriptVersion lang
version PlutusScript lang
script)

scriptWitnessScript (SimpleScriptWitness ScriptLanguageInEra lang era
_ SimpleScriptVersion lang
_ (SReferenceScript TxIn
_ Maybe ScriptHash
_)) =
    Maybe (ScriptInEra era)
forall a. Maybe a
Nothing
scriptWitnessScript (PlutusScriptWitness ScriptLanguageInEra lang era
_ PlutusScriptVersion lang
_ (PReferenceScript TxIn
_ Maybe ScriptHash
_) ScriptDatum witctx
_ ScriptRedeemer
_ ExecutionUnits
_) =
    Maybe (ScriptInEra era)
forall a. Maybe a
Nothing

-- ----------------------------------------------------------------------------
-- The kind of witness to use, key (signature) or script
--

data Witness witctx era where

     KeyWitness    :: KeyWitnessInCtx witctx
                   -> Witness         witctx era

     ScriptWitness :: ScriptWitnessInCtx witctx
                   -> ScriptWitness      witctx era
                   -> Witness            witctx era

deriving instance Eq   (Witness witctx era)
deriving instance Show (Witness witctx era)

data KeyWitnessInCtx witctx where

     KeyWitnessForSpending  :: KeyWitnessInCtx WitCtxTxIn
     KeyWitnessForStakeAddr :: KeyWitnessInCtx WitCtxStake

data ScriptWitnessInCtx witctx where

     ScriptWitnessForSpending  :: ScriptWitnessInCtx WitCtxTxIn
     ScriptWitnessForMinting   :: ScriptWitnessInCtx WitCtxMint
     ScriptWitnessForStakeAddr :: ScriptWitnessInCtx WitCtxStake

deriving instance Eq   (KeyWitnessInCtx witctx)
deriving instance Show (KeyWitnessInCtx witctx)

deriving instance Eq   (ScriptWitnessInCtx witctx)
deriving instance Show (ScriptWitnessInCtx witctx)


-- ----------------------------------------------------------------------------
-- Script execution units
--

-- | The units for how long a script executes for and how much memory it uses.
-- This is used to declare the resources used by a particular use of a script.
--
-- This type is also used to describe the limits for the maximum overall
-- execution units per transaction or per block.
--
data ExecutionUnits =
     ExecutionUnits {
        -- | This corresponds roughly to the time to execute a script.
        ExecutionUnits -> Natural
executionSteps  :: Natural,

        -- | This corresponds roughly to the peak memory used during script
        -- execution.
        ExecutionUnits -> Natural
executionMemory :: Natural
     }
  deriving (ExecutionUnits -> ExecutionUnits -> Bool
(ExecutionUnits -> ExecutionUnits -> Bool)
-> (ExecutionUnits -> ExecutionUnits -> Bool) -> Eq ExecutionUnits
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExecutionUnits -> ExecutionUnits -> Bool
$c/= :: ExecutionUnits -> ExecutionUnits -> Bool
== :: ExecutionUnits -> ExecutionUnits -> Bool
$c== :: ExecutionUnits -> ExecutionUnits -> Bool
Eq, Int -> ExecutionUnits -> ShowS
[ExecutionUnits] -> ShowS
ExecutionUnits -> String
(Int -> ExecutionUnits -> ShowS)
-> (ExecutionUnits -> String)
-> ([ExecutionUnits] -> ShowS)
-> Show ExecutionUnits
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExecutionUnits] -> ShowS
$cshowList :: [ExecutionUnits] -> ShowS
show :: ExecutionUnits -> String
$cshow :: ExecutionUnits -> String
showsPrec :: Int -> ExecutionUnits -> ShowS
$cshowsPrec :: Int -> ExecutionUnits -> ShowS
Show)

instance ToCBOR ExecutionUnits where
  toCBOR :: ExecutionUnits -> Encoding
toCBOR ExecutionUnits{Natural
executionSteps :: Natural
executionSteps :: ExecutionUnits -> Natural
executionSteps, Natural
executionMemory :: Natural
executionMemory :: ExecutionUnits -> Natural
executionMemory} =
      Word -> Encoding
CBOR.encodeListLen Word
2
   Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Natural
executionSteps
   Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Natural
executionMemory

instance FromCBOR ExecutionUnits where
  fromCBOR :: Decoder s ExecutionUnits
fromCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
CBOR.enforceSize Text
"ExecutionUnits" Int
2
    Natural -> Natural -> ExecutionUnits
ExecutionUnits
      (Natural -> Natural -> ExecutionUnits)
-> Decoder s Natural -> Decoder s (Natural -> ExecutionUnits)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Natural
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder s (Natural -> ExecutionUnits)
-> Decoder s Natural -> Decoder s ExecutionUnits
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Natural
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance ToJSON ExecutionUnits where
  toJSON :: ExecutionUnits -> Value
toJSON ExecutionUnits{Natural
executionSteps :: Natural
executionSteps :: ExecutionUnits -> Natural
executionSteps, Natural
executionMemory :: Natural
executionMemory :: ExecutionUnits -> Natural
executionMemory} =
    [Pair] -> Value
object [ Key
"steps"  Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Natural
executionSteps
           , Key
"memory" Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Natural
executionMemory ]

instance FromJSON ExecutionUnits where
  parseJSON :: Value -> Parser ExecutionUnits
parseJSON =
    String
-> (Object -> Parser ExecutionUnits)
-> Value
-> Parser ExecutionUnits
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"ExecutionUnits" ((Object -> Parser ExecutionUnits)
 -> Value -> Parser ExecutionUnits)
-> (Object -> Parser ExecutionUnits)
-> Value
-> Parser ExecutionUnits
forall a b. (a -> b) -> a -> b
$ \Object
o ->
      Natural -> Natural -> ExecutionUnits
ExecutionUnits
        (Natural -> Natural -> ExecutionUnits)
-> Parser Natural -> Parser (Natural -> ExecutionUnits)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Natural
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"steps"
        Parser (Natural -> ExecutionUnits)
-> Parser Natural -> Parser ExecutionUnits
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Natural
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"memory"

toAlonzoExUnits :: ExecutionUnits -> Alonzo.ExUnits
toAlonzoExUnits :: ExecutionUnits -> ExUnits
toAlonzoExUnits ExecutionUnits{Natural
executionSteps :: Natural
executionSteps :: ExecutionUnits -> Natural
executionSteps, Natural
executionMemory :: Natural
executionMemory :: ExecutionUnits -> Natural
executionMemory} =
  ExUnits :: Natural -> Natural -> ExUnits
Alonzo.ExUnits {
    exUnitsSteps :: Natural
Alonzo.exUnitsSteps = Natural
executionSteps,
    exUnitsMem :: Natural
Alonzo.exUnitsMem   = Natural
executionMemory
  }

fromAlonzoExUnits :: Alonzo.ExUnits -> ExecutionUnits
fromAlonzoExUnits :: ExUnits -> ExecutionUnits
fromAlonzoExUnits Alonzo.ExUnits{Natural
exUnitsSteps :: Natural
exUnitsSteps :: ExUnits -> Natural
Alonzo.exUnitsSteps, Natural
exUnitsMem :: Natural
exUnitsMem :: ExUnits -> Natural
Alonzo.exUnitsMem} =
  ExecutionUnits :: Natural -> Natural -> ExecutionUnits
ExecutionUnits {
    executionSteps :: Natural
executionSteps  = Natural
exUnitsSteps,
    executionMemory :: Natural
executionMemory = Natural
exUnitsMem
  }


-- ----------------------------------------------------------------------------
-- Script Hash
--

-- | We have this type separate from the 'Hash' type to avoid the script
-- hash type being parametrised by the era. The representation is era
-- independent, and there are many places where we want to use a script
-- hash where we don't want things to be era-parametrised.
--
newtype ScriptHash = ScriptHash (Shelley.ScriptHash StandardCrypto)
  deriving stock (ScriptHash -> ScriptHash -> Bool
(ScriptHash -> ScriptHash -> Bool)
-> (ScriptHash -> ScriptHash -> Bool) -> Eq ScriptHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScriptHash -> ScriptHash -> Bool
$c/= :: ScriptHash -> ScriptHash -> Bool
== :: ScriptHash -> ScriptHash -> Bool
$c== :: ScriptHash -> ScriptHash -> Bool
Eq, Eq ScriptHash
Eq ScriptHash
-> (ScriptHash -> ScriptHash -> Ordering)
-> (ScriptHash -> ScriptHash -> Bool)
-> (ScriptHash -> ScriptHash -> Bool)
-> (ScriptHash -> ScriptHash -> Bool)
-> (ScriptHash -> ScriptHash -> Bool)
-> (ScriptHash -> ScriptHash -> ScriptHash)
-> (ScriptHash -> ScriptHash -> ScriptHash)
-> Ord ScriptHash
ScriptHash -> ScriptHash -> Bool
ScriptHash -> ScriptHash -> Ordering
ScriptHash -> ScriptHash -> ScriptHash
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
min :: ScriptHash -> ScriptHash -> ScriptHash
$cmin :: ScriptHash -> ScriptHash -> ScriptHash
max :: ScriptHash -> ScriptHash -> ScriptHash
$cmax :: ScriptHash -> ScriptHash -> ScriptHash
>= :: ScriptHash -> ScriptHash -> Bool
$c>= :: ScriptHash -> ScriptHash -> Bool
> :: ScriptHash -> ScriptHash -> Bool
$c> :: ScriptHash -> ScriptHash -> Bool
<= :: ScriptHash -> ScriptHash -> Bool
$c<= :: ScriptHash -> ScriptHash -> Bool
< :: ScriptHash -> ScriptHash -> Bool
$c< :: ScriptHash -> ScriptHash -> Bool
compare :: ScriptHash -> ScriptHash -> Ordering
$ccompare :: ScriptHash -> ScriptHash -> Ordering
$cp1Ord :: Eq ScriptHash
Ord)
  deriving (Int -> ScriptHash -> ShowS
[ScriptHash] -> ShowS
ScriptHash -> String
(Int -> ScriptHash -> ShowS)
-> (ScriptHash -> String)
-> ([ScriptHash] -> ShowS)
-> Show ScriptHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptHash] -> ShowS
$cshowList :: [ScriptHash] -> ShowS
show :: ScriptHash -> String
$cshow :: ScriptHash -> String
showsPrec :: Int -> ScriptHash -> ShowS
$cshowsPrec :: Int -> ScriptHash -> ShowS
Show, String -> ScriptHash
(String -> ScriptHash) -> IsString ScriptHash
forall a. (String -> a) -> IsString a
fromString :: String -> ScriptHash
$cfromString :: String -> ScriptHash
IsString)   via UsingRawBytesHex ScriptHash
  deriving ([ScriptHash] -> Encoding
[ScriptHash] -> Value
ScriptHash -> Encoding
ScriptHash -> Value
(ScriptHash -> Value)
-> (ScriptHash -> Encoding)
-> ([ScriptHash] -> Value)
-> ([ScriptHash] -> Encoding)
-> ToJSON ScriptHash
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ScriptHash] -> Encoding
$ctoEncodingList :: [ScriptHash] -> Encoding
toJSONList :: [ScriptHash] -> Value
$ctoJSONList :: [ScriptHash] -> Value
toEncoding :: ScriptHash -> Encoding
$ctoEncoding :: ScriptHash -> Encoding
toJSON :: ScriptHash -> Value
$ctoJSON :: ScriptHash -> Value
ToJSON, Value -> Parser [ScriptHash]
Value -> Parser ScriptHash
(Value -> Parser ScriptHash)
-> (Value -> Parser [ScriptHash]) -> FromJSON ScriptHash
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ScriptHash]
$cparseJSONList :: Value -> Parser [ScriptHash]
parseJSON :: Value -> Parser ScriptHash
$cparseJSON :: Value -> Parser ScriptHash
FromJSON) via UsingRawBytesHex ScriptHash

instance HasTypeProxy ScriptHash where
    data AsType ScriptHash = AsScriptHash
    proxyToAsType :: Proxy ScriptHash -> AsType ScriptHash
proxyToAsType Proxy ScriptHash
_ = AsType ScriptHash
AsScriptHash

instance SerialiseAsRawBytes ScriptHash where
    serialiseToRawBytes :: ScriptHash -> ByteString
serialiseToRawBytes (ScriptHash (Shelley.ScriptHash Hash (ADDRHASH StandardCrypto) EraIndependentScript
h)) =
      Hash Blake2b_224 EraIndependentScript -> ByteString
forall h a. Hash h a -> ByteString
Crypto.hashToBytes Hash Blake2b_224 EraIndependentScript
Hash (ADDRHASH StandardCrypto) EraIndependentScript
h

    deserialiseFromRawBytes :: AsType ScriptHash -> ByteString -> Maybe ScriptHash
deserialiseFromRawBytes AsType ScriptHash
AsScriptHash ByteString
bs =
      ScriptHash StandardCrypto -> ScriptHash
ScriptHash (ScriptHash StandardCrypto -> ScriptHash)
-> (Hash Blake2b_224 EraIndependentScript
    -> ScriptHash StandardCrypto)
-> Hash Blake2b_224 EraIndependentScript
-> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_224 EraIndependentScript -> ScriptHash StandardCrypto
forall crypto.
Hash (ADDRHASH crypto) EraIndependentScript -> ScriptHash crypto
Shelley.ScriptHash (Hash Blake2b_224 EraIndependentScript -> ScriptHash)
-> Maybe (Hash Blake2b_224 EraIndependentScript)
-> Maybe ScriptHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Hash Blake2b_224 EraIndependentScript)
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Crypto.hashFromBytes ByteString
bs


hashScript :: Script lang -> ScriptHash
hashScript :: Script lang -> ScriptHash
hashScript (SimpleScript SimpleScriptVersion lang
SimpleScriptV1 SimpleScript lang
s) =
    -- For V1, we convert to the Shelley-era version specifically and hash that.
    -- Later ledger eras have to be compatible anyway.
    ScriptHash StandardCrypto -> ScriptHash
ScriptHash
  (ScriptHash StandardCrypto -> ScriptHash)
-> (SimpleScript SimpleScriptV1 -> ScriptHash StandardCrypto)
-> SimpleScript SimpleScriptV1
-> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidateScript (ShelleyLedgerEra ShelleyEra) =>
Script (ShelleyLedgerEra ShelleyEra)
-> ScriptHash (Crypto (ShelleyLedgerEra ShelleyEra))
forall era.
ValidateScript era =>
Script era -> ScriptHash (Crypto era)
Ledger.hashScript @(ShelleyLedgerEra ShelleyEra)
  (MultiSig StandardCrypto -> ScriptHash StandardCrypto)
-> (SimpleScript SimpleScriptV1 -> MultiSig StandardCrypto)
-> SimpleScript SimpleScriptV1
-> ScriptHash StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleScript SimpleScriptV1 -> MultiSig StandardCrypto
toShelleyMultiSig
  (SimpleScript SimpleScriptV1 -> ScriptHash)
-> SimpleScript SimpleScriptV1 -> ScriptHash
forall a b. (a -> b) -> a -> b
$ SimpleScript lang
SimpleScript SimpleScriptV1
s

hashScript (SimpleScript SimpleScriptVersion lang
SimpleScriptV2 SimpleScript lang
s) =
    -- For V2, we convert to the Allegra-era version specifically and hash that.
    -- Later ledger eras have to be compatible anyway.
    ScriptHash StandardCrypto -> ScriptHash
ScriptHash
  (ScriptHash StandardCrypto -> ScriptHash)
-> (SimpleScript SimpleScriptV2 -> ScriptHash StandardCrypto)
-> SimpleScript SimpleScriptV2
-> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidateScript (ShelleyLedgerEra AllegraEra) =>
Script (ShelleyLedgerEra AllegraEra)
-> ScriptHash (Crypto (ShelleyLedgerEra AllegraEra))
forall era.
ValidateScript era =>
Script era -> ScriptHash (Crypto era)
Ledger.hashScript @(ShelleyLedgerEra AllegraEra)
  (Timelock StandardCrypto -> ScriptHash StandardCrypto)
-> (SimpleScript SimpleScriptV2 -> Timelock StandardCrypto)
-> SimpleScript SimpleScriptV2
-> ScriptHash StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SimpleScript SimpleScriptV2 -> Timelock StandardCrypto
forall lang. SimpleScript lang -> Timelock StandardCrypto
toAllegraTimelock :: SimpleScript SimpleScriptV2
                       -> Timelock.Timelock StandardCrypto)
  (SimpleScript SimpleScriptV2 -> ScriptHash)
-> SimpleScript SimpleScriptV2 -> ScriptHash
forall a b. (a -> b) -> a -> b
$ SimpleScript lang
SimpleScript SimpleScriptV2
s

hashScript (PlutusScript PlutusScriptVersion lang
PlutusScriptV1 (PlutusScriptSerialised ShortByteString
script)) =
    -- For Plutus V1, we convert to the Alonzo-era version specifically and
    -- hash that. Later ledger eras have to be compatible anyway.
    ScriptHash StandardCrypto -> ScriptHash
ScriptHash
  (ScriptHash StandardCrypto -> ScriptHash)
-> (Script (AlonzoEra StandardCrypto) -> ScriptHash StandardCrypto)
-> Script (AlonzoEra StandardCrypto)
-> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidateScript (ShelleyLedgerEra AlonzoEra) =>
Script (ShelleyLedgerEra AlonzoEra)
-> ScriptHash (Crypto (ShelleyLedgerEra AlonzoEra))
forall era.
ValidateScript era =>
Script era -> ScriptHash (Crypto era)
Ledger.hashScript @(ShelleyLedgerEra AlonzoEra)
  (Script (AlonzoEra StandardCrypto) -> ScriptHash)
-> Script (AlonzoEra StandardCrypto) -> ScriptHash
forall a b. (a -> b) -> a -> b
$ Language -> ShortByteString -> Script (AlonzoEra StandardCrypto)
forall era. Language -> ShortByteString -> Script era
Alonzo.PlutusScript Language
Alonzo.PlutusV1 ShortByteString
script

hashScript (PlutusScript PlutusScriptVersion lang
PlutusScriptV2 (PlutusScriptSerialised ShortByteString
script)) =
    ScriptHash StandardCrypto -> ScriptHash
ScriptHash
  (ScriptHash StandardCrypto -> ScriptHash)
-> (Script (BabbageEra StandardCrypto)
    -> ScriptHash StandardCrypto)
-> Script (BabbageEra StandardCrypto)
-> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidateScript (ShelleyLedgerEra BabbageEra) =>
Script (ShelleyLedgerEra BabbageEra)
-> ScriptHash (Crypto (ShelleyLedgerEra BabbageEra))
forall era.
ValidateScript era =>
Script era -> ScriptHash (Crypto era)
Ledger.hashScript @(ShelleyLedgerEra BabbageEra)
  (Script (BabbageEra StandardCrypto) -> ScriptHash)
-> Script (BabbageEra StandardCrypto) -> ScriptHash
forall a b. (a -> b) -> a -> b
$ Language -> ShortByteString -> Script (BabbageEra StandardCrypto)
forall era. Language -> ShortByteString -> Script era
Alonzo.PlutusScript Language
Alonzo.PlutusV2 ShortByteString
script

toShelleyScriptHash :: ScriptHash -> Shelley.ScriptHash StandardCrypto
toShelleyScriptHash :: ScriptHash -> ScriptHash StandardCrypto
toShelleyScriptHash (ScriptHash ScriptHash StandardCrypto
h) =  ScriptHash StandardCrypto
h

fromShelleyScriptHash :: Shelley.ScriptHash StandardCrypto -> ScriptHash
fromShelleyScriptHash :: ScriptHash StandardCrypto -> ScriptHash
fromShelleyScriptHash = ScriptHash StandardCrypto -> ScriptHash
ScriptHash


-- ----------------------------------------------------------------------------
-- The simple script language
--

data SimpleScript lang where

     RequireSignature  :: !(Hash PaymentKey)
                       -> SimpleScript lang

     RequireTimeBefore :: !(TimeLocksSupported lang)
                       -> !SlotNo
                       -> SimpleScript lang

     RequireTimeAfter  :: !(TimeLocksSupported lang)
                       -> !SlotNo
                       -> SimpleScript lang

     RequireAllOf      ::        [SimpleScript lang] -> SimpleScript lang
     RequireAnyOf      ::        [SimpleScript lang] -> SimpleScript lang
     RequireMOf        :: Int -> [SimpleScript lang] -> SimpleScript lang

deriving instance Eq   (SimpleScript lang)
deriving instance Show (SimpleScript lang)

instance HasTypeProxy lang => HasTypeProxy (SimpleScript lang) where
    data AsType (SimpleScript lang) = AsSimpleScript (AsType lang)
    proxyToAsType :: Proxy (SimpleScript lang) -> AsType (SimpleScript lang)
proxyToAsType Proxy (SimpleScript lang)
_ = AsType lang -> AsType (SimpleScript lang)
forall lang. AsType lang -> AsType (SimpleScript lang)
AsSimpleScript (Proxy lang -> AsType lang
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType (Proxy lang
forall k (t :: k). Proxy t
Proxy :: Proxy lang))


-- | Time lock feature in the 'SimpleScript' language.
--
-- The constructors of this type serve as evidence that the timelocks feature
-- is supported in particular versions of the language.
--
data TimeLocksSupported lang where
     TimeLocksInSimpleScriptV2 :: TimeLocksSupported SimpleScriptV2

deriving instance Eq   (TimeLocksSupported lang)
deriving instance Show (TimeLocksSupported lang)

timeLocksSupported :: SimpleScriptVersion lang
                   -> Maybe (TimeLocksSupported lang)
timeLocksSupported :: SimpleScriptVersion lang -> Maybe (TimeLocksSupported lang)
timeLocksSupported SimpleScriptVersion lang
SimpleScriptV1 = Maybe (TimeLocksSupported lang)
forall a. Maybe a
Nothing
timeLocksSupported SimpleScriptVersion lang
SimpleScriptV2 = TimeLocksSupported SimpleScriptV2
-> Maybe (TimeLocksSupported SimpleScriptV2)
forall a. a -> Maybe a
Just TimeLocksSupported SimpleScriptV2
TimeLocksInSimpleScriptV2


-- | Try converting the 'SimpleScript' into a different version of the language.
--
-- This will work when the script only uses the features of the target language
-- version. For example converting from 'SimpleScriptV2' to 'SimpleScriptV1'
-- will work if the script happens not to use time locks feature. On the other
-- hand converting 'SimpleScriptV1' to 'SimpleScriptV2' will always work because
-- it is backwards compatible.
--
adjustSimpleScriptVersion :: SimpleScriptVersion lang'
                          -> SimpleScript lang
                          -> Maybe (SimpleScript lang')
adjustSimpleScriptVersion :: SimpleScriptVersion lang'
-> SimpleScript lang -> Maybe (SimpleScript lang')
adjustSimpleScriptVersion SimpleScriptVersion lang'
target = SimpleScript lang -> Maybe (SimpleScript lang')
go
  where
    go :: SimpleScript lang -> Maybe (SimpleScript lang')
go (RequireSignature Hash PaymentKey
sig) = SimpleScript lang' -> Maybe (SimpleScript lang')
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Hash PaymentKey -> SimpleScript lang'
forall lang. Hash PaymentKey -> SimpleScript lang
RequireSignature Hash PaymentKey
sig)

    go (RequireTimeBefore TimeLocksSupported lang
_ SlotNo
slot) = do
      TimeLocksSupported lang'
supported <- SimpleScriptVersion lang' -> Maybe (TimeLocksSupported lang')
forall lang.
SimpleScriptVersion lang -> Maybe (TimeLocksSupported lang)
timeLocksSupported SimpleScriptVersion lang'
target
      SimpleScript lang' -> Maybe (SimpleScript lang')
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TimeLocksSupported lang' -> SlotNo -> SimpleScript lang'
forall lang. TimeLocksSupported lang -> SlotNo -> SimpleScript lang
RequireTimeBefore TimeLocksSupported lang'
supported SlotNo
slot)

    go (RequireTimeAfter TimeLocksSupported lang
_ SlotNo
slot) = do
      TimeLocksSupported lang'
supported <- SimpleScriptVersion lang' -> Maybe (TimeLocksSupported lang')
forall lang.
SimpleScriptVersion lang -> Maybe (TimeLocksSupported lang)
timeLocksSupported SimpleScriptVersion lang'
target
      SimpleScript lang' -> Maybe (SimpleScript lang')
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TimeLocksSupported lang' -> SlotNo -> SimpleScript lang'
forall lang. TimeLocksSupported lang -> SlotNo -> SimpleScript lang
RequireTimeAfter TimeLocksSupported lang'
supported SlotNo
slot)

    go (RequireAllOf [SimpleScript lang]
ss) = [SimpleScript lang'] -> SimpleScript lang'
forall lang. [SimpleScript lang] -> SimpleScript lang
RequireAllOf ([SimpleScript lang'] -> SimpleScript lang')
-> Maybe [SimpleScript lang'] -> Maybe (SimpleScript lang')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SimpleScript lang -> Maybe (SimpleScript lang'))
-> [SimpleScript lang] -> Maybe [SimpleScript lang']
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse SimpleScript lang -> Maybe (SimpleScript lang')
go [SimpleScript lang]
ss
    go (RequireAnyOf [SimpleScript lang]
ss) = [SimpleScript lang'] -> SimpleScript lang'
forall lang. [SimpleScript lang] -> SimpleScript lang
RequireAnyOf ([SimpleScript lang'] -> SimpleScript lang')
-> Maybe [SimpleScript lang'] -> Maybe (SimpleScript lang')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SimpleScript lang -> Maybe (SimpleScript lang'))
-> [SimpleScript lang] -> Maybe [SimpleScript lang']
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse SimpleScript lang -> Maybe (SimpleScript lang')
go [SimpleScript lang]
ss
    go (RequireMOf Int
m [SimpleScript lang]
ss) = Int -> [SimpleScript lang'] -> SimpleScript lang'
forall lang. Int -> [SimpleScript lang] -> SimpleScript lang
RequireMOf Int
m ([SimpleScript lang'] -> SimpleScript lang')
-> Maybe [SimpleScript lang'] -> Maybe (SimpleScript lang')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SimpleScript lang -> Maybe (SimpleScript lang'))
-> [SimpleScript lang] -> Maybe [SimpleScript lang']
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse SimpleScript lang -> Maybe (SimpleScript lang')
go [SimpleScript lang]
ss


-- ----------------------------------------------------------------------------
-- The Plutus script language
--

-- | Plutus scripts.
--
-- Note that Plutus scripts have a binary serialisation but no JSON
-- serialisation.
--
data PlutusScript lang where
     PlutusScriptSerialised :: ShortByteString -> PlutusScript lang
  deriving stock (PlutusScript lang -> PlutusScript lang -> Bool
(PlutusScript lang -> PlutusScript lang -> Bool)
-> (PlutusScript lang -> PlutusScript lang -> Bool)
-> Eq (PlutusScript lang)
forall lang. PlutusScript lang -> PlutusScript lang -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlutusScript lang -> PlutusScript lang -> Bool
$c/= :: forall lang. PlutusScript lang -> PlutusScript lang -> Bool
== :: PlutusScript lang -> PlutusScript lang -> Bool
$c== :: forall lang. PlutusScript lang -> PlutusScript lang -> Bool
Eq, Eq (PlutusScript lang)
Eq (PlutusScript lang)
-> (PlutusScript lang -> PlutusScript lang -> Ordering)
-> (PlutusScript lang -> PlutusScript lang -> Bool)
-> (PlutusScript lang -> PlutusScript lang -> Bool)
-> (PlutusScript lang -> PlutusScript lang -> Bool)
-> (PlutusScript lang -> PlutusScript lang -> Bool)
-> (PlutusScript lang -> PlutusScript lang -> PlutusScript lang)
-> (PlutusScript lang -> PlutusScript lang -> PlutusScript lang)
-> Ord (PlutusScript lang)
PlutusScript lang -> PlutusScript lang -> Bool
PlutusScript lang -> PlutusScript lang -> Ordering
PlutusScript lang -> PlutusScript lang -> PlutusScript lang
forall lang. Eq (PlutusScript lang)
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 lang. PlutusScript lang -> PlutusScript lang -> Bool
forall lang. PlutusScript lang -> PlutusScript lang -> Ordering
forall lang.
PlutusScript lang -> PlutusScript lang -> PlutusScript lang
min :: PlutusScript lang -> PlutusScript lang -> PlutusScript lang
$cmin :: forall lang.
PlutusScript lang -> PlutusScript lang -> PlutusScript lang
max :: PlutusScript lang -> PlutusScript lang -> PlutusScript lang
$cmax :: forall lang.
PlutusScript lang -> PlutusScript lang -> PlutusScript lang
>= :: PlutusScript lang -> PlutusScript lang -> Bool
$c>= :: forall lang. PlutusScript lang -> PlutusScript lang -> Bool
> :: PlutusScript lang -> PlutusScript lang -> Bool
$c> :: forall lang. PlutusScript lang -> PlutusScript lang -> Bool
<= :: PlutusScript lang -> PlutusScript lang -> Bool
$c<= :: forall lang. PlutusScript lang -> PlutusScript lang -> Bool
< :: PlutusScript lang -> PlutusScript lang -> Bool
$c< :: forall lang. PlutusScript lang -> PlutusScript lang -> Bool
compare :: PlutusScript lang -> PlutusScript lang -> Ordering
$ccompare :: forall lang. PlutusScript lang -> PlutusScript lang -> Ordering
$cp1Ord :: forall lang. Eq (PlutusScript lang)
Ord)
  deriving stock (Int -> PlutusScript lang -> ShowS
[PlutusScript lang] -> ShowS
PlutusScript lang -> String
(Int -> PlutusScript lang -> ShowS)
-> (PlutusScript lang -> String)
-> ([PlutusScript lang] -> ShowS)
-> Show (PlutusScript lang)
forall lang. Int -> PlutusScript lang -> ShowS
forall lang. [PlutusScript lang] -> ShowS
forall lang. PlutusScript lang -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlutusScript lang] -> ShowS
$cshowList :: forall lang. [PlutusScript lang] -> ShowS
show :: PlutusScript lang -> String
$cshow :: forall lang. PlutusScript lang -> String
showsPrec :: Int -> PlutusScript lang -> ShowS
$cshowsPrec :: forall lang. Int -> PlutusScript lang -> ShowS
Show) -- TODO: would be nice to use via UsingRawBytesHex
                        -- however that adds an awkward HasTypeProxy lang =>
                        -- constraint to other Show instances elsewhere
  deriving (Typeable (PlutusScript lang)
Typeable (PlutusScript lang)
-> (PlutusScript lang -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (PlutusScript lang) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [PlutusScript lang] -> Size)
-> ToCBOR (PlutusScript lang)
PlutusScript lang -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PlutusScript lang] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PlutusScript lang) -> Size
forall lang.
(Typeable lang, HasTypeProxy lang) =>
Typeable (PlutusScript lang)
forall lang.
(Typeable lang, HasTypeProxy lang) =>
PlutusScript lang -> Encoding
forall lang.
(Typeable lang, HasTypeProxy lang) =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PlutusScript lang] -> Size
forall lang.
(Typeable lang, HasTypeProxy lang) =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PlutusScript lang) -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PlutusScript lang] -> Size
$cencodedListSizeExpr :: forall lang.
(Typeable lang, HasTypeProxy lang) =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PlutusScript lang] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PlutusScript lang) -> Size
$cencodedSizeExpr :: forall lang.
(Typeable lang, HasTypeProxy lang) =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PlutusScript lang) -> Size
toCBOR :: PlutusScript lang -> Encoding
$ctoCBOR :: forall lang.
(Typeable lang, HasTypeProxy lang) =>
PlutusScript lang -> Encoding
$cp1ToCBOR :: forall lang.
(Typeable lang, HasTypeProxy lang) =>
Typeable (PlutusScript lang)
ToCBOR, Typeable (PlutusScript lang)
Decoder s (PlutusScript lang)
Typeable (PlutusScript lang)
-> (forall s. Decoder s (PlutusScript lang))
-> (Proxy (PlutusScript lang) -> Text)
-> FromCBOR (PlutusScript lang)
Proxy (PlutusScript lang) -> Text
forall s. Decoder s (PlutusScript lang)
forall lang.
(Typeable lang, HasTypeProxy lang) =>
Typeable (PlutusScript lang)
forall lang.
(Typeable lang, HasTypeProxy lang) =>
Proxy (PlutusScript lang) -> Text
forall lang s.
(Typeable lang, HasTypeProxy lang) =>
Decoder s (PlutusScript lang)
forall a.
Typeable a
-> (forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
label :: Proxy (PlutusScript lang) -> Text
$clabel :: forall lang.
(Typeable lang, HasTypeProxy lang) =>
Proxy (PlutusScript lang) -> Text
fromCBOR :: Decoder s (PlutusScript lang)
$cfromCBOR :: forall lang s.
(Typeable lang, HasTypeProxy lang) =>
Decoder s (PlutusScript lang)
$cp1FromCBOR :: forall lang.
(Typeable lang, HasTypeProxy lang) =>
Typeable (PlutusScript lang)
FromCBOR) via (UsingRawBytes (PlutusScript lang))
  deriving anyclass HasTypeProxy (PlutusScript lang)
HasTypeProxy (PlutusScript lang)
-> (PlutusScript lang -> ByteString)
-> (AsType (PlutusScript lang)
    -> ByteString -> Either DecoderError (PlutusScript lang))
-> SerialiseAsCBOR (PlutusScript lang)
AsType (PlutusScript lang)
-> ByteString -> Either DecoderError (PlutusScript lang)
PlutusScript lang -> ByteString
forall lang.
(HasTypeProxy lang, Typeable lang) =>
HasTypeProxy (PlutusScript lang)
forall lang.
(HasTypeProxy lang, Typeable lang) =>
AsType (PlutusScript lang)
-> ByteString -> Either DecoderError (PlutusScript lang)
forall lang.
(HasTypeProxy lang, Typeable lang) =>
PlutusScript lang -> ByteString
forall a.
HasTypeProxy a
-> (a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
deserialiseFromCBOR :: AsType (PlutusScript lang)
-> ByteString -> Either DecoderError (PlutusScript lang)
$cdeserialiseFromCBOR :: forall lang.
(HasTypeProxy lang, Typeable lang) =>
AsType (PlutusScript lang)
-> ByteString -> Either DecoderError (PlutusScript lang)
serialiseToCBOR :: PlutusScript lang -> ByteString
$cserialiseToCBOR :: forall lang.
(HasTypeProxy lang, Typeable lang) =>
PlutusScript lang -> ByteString
$cp1SerialiseAsCBOR :: forall lang.
(HasTypeProxy lang, Typeable lang) =>
HasTypeProxy (PlutusScript lang)
SerialiseAsCBOR

instance HasTypeProxy lang => HasTypeProxy (PlutusScript lang) where
    data AsType (PlutusScript lang) = AsPlutusScript (AsType lang)
    proxyToAsType :: Proxy (PlutusScript lang) -> AsType (PlutusScript lang)
proxyToAsType Proxy (PlutusScript lang)
_ = AsType lang -> AsType (PlutusScript lang)
forall lang. AsType lang -> AsType (PlutusScript lang)
AsPlutusScript (Proxy lang -> AsType lang
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType (Proxy lang
forall k (t :: k). Proxy t
Proxy :: Proxy lang))

instance HasTypeProxy lang => SerialiseAsRawBytes (PlutusScript lang) where
    serialiseToRawBytes :: PlutusScript lang -> ByteString
serialiseToRawBytes (PlutusScriptSerialised ShortByteString
sbs) = ShortByteString -> ByteString
SBS.fromShort ShortByteString
sbs

    deserialiseFromRawBytes :: AsType (PlutusScript lang)
-> ByteString -> Maybe (PlutusScript lang)
deserialiseFromRawBytes (AsPlutusScript _) ByteString
bs =
      -- TODO alonzo: validate the script syntax and fail decoding if invalid
      PlutusScript lang -> Maybe (PlutusScript lang)
forall a. a -> Maybe a
Just (ShortByteString -> PlutusScript lang
forall lang. ShortByteString -> PlutusScript lang
PlutusScriptSerialised (ByteString -> ShortByteString
SBS.toShort ByteString
bs))

instance (IsPlutusScriptLanguage lang, Typeable lang) =>
         HasTextEnvelope (PlutusScript lang) where
    textEnvelopeType :: AsType (PlutusScript lang) -> TextEnvelopeType
textEnvelopeType AsType (PlutusScript lang)
_ =
      case PlutusScriptVersion lang
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang
plutusScriptVersion :: PlutusScriptVersion lang of
        PlutusScriptVersion lang
PlutusScriptV1 -> TextEnvelopeType
"PlutusScriptV1"
        PlutusScriptVersion lang
PlutusScriptV2 -> TextEnvelopeType
"PlutusScriptV2"


-- | An example Plutus script that always succeeds, irrespective of inputs.
--
-- For example, if one were to use this for a payment address then it would
-- allow anyone to spend from it.
--
-- The exact script depends on the context in which it is to be used.
--
examplePlutusScriptAlwaysSucceeds :: WitCtx witctx
                                  -> PlutusScript PlutusScriptV1
examplePlutusScriptAlwaysSucceeds :: WitCtx witctx -> PlutusScript PlutusScriptV1
examplePlutusScriptAlwaysSucceeds =
    ShortByteString -> PlutusScript PlutusScriptV1
forall lang. ShortByteString -> PlutusScript lang
PlutusScriptSerialised
  (ShortByteString -> PlutusScript PlutusScriptV1)
-> (WitCtx witctx -> ShortByteString)
-> WitCtx witctx
-> PlutusScript PlutusScriptV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> ShortByteString
Plutus.alwaysSucceedingNAryFunction
  (Natural -> ShortByteString)
-> (WitCtx witctx -> Natural) -> WitCtx witctx -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WitCtx witctx -> Natural
forall witctx. WitCtx witctx -> Natural
scriptArityForWitCtx

-- | An example Plutus script that always fails, irrespective of inputs.
--
-- For example, if one were to use this for a payment address then it would
-- be impossible for anyone to ever spend from it.
--
-- The exact script depends on the context in which it is to be used.
--
examplePlutusScriptAlwaysFails :: WitCtx witctx
                               -> PlutusScript PlutusScriptV1
examplePlutusScriptAlwaysFails :: WitCtx witctx -> PlutusScript PlutusScriptV1
examplePlutusScriptAlwaysFails =
    ShortByteString -> PlutusScript PlutusScriptV1
forall lang. ShortByteString -> PlutusScript lang
PlutusScriptSerialised
  (ShortByteString -> PlutusScript PlutusScriptV1)
-> (WitCtx witctx -> ShortByteString)
-> WitCtx witctx
-> PlutusScript PlutusScriptV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> ShortByteString
Plutus.alwaysFailingNAryFunction
  (Natural -> ShortByteString)
-> (WitCtx witctx -> Natural) -> WitCtx witctx -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WitCtx witctx -> Natural
forall witctx. WitCtx witctx -> Natural
scriptArityForWitCtx

-- | The expected arity of the Plutus function, depending on the context in
-- which it is used.
--
-- The script inputs consist of
--
-- * the optional datum (for txins)
-- * the redeemer
-- * the Plutus representation of the tx and environment
--
scriptArityForWitCtx :: WitCtx witctx -> Natural
scriptArityForWitCtx :: WitCtx witctx -> Natural
scriptArityForWitCtx WitCtx witctx
WitCtxTxIn  = Natural
3
scriptArityForWitCtx WitCtx witctx
WitCtxMint  = Natural
2
scriptArityForWitCtx WitCtx witctx
WitCtxStake = Natural
2


-- ----------------------------------------------------------------------------
-- Conversion functions
--

toShelleyScript :: ScriptInEra era -> Ledger.Script (ShelleyLedgerEra era)
toShelleyScript :: ScriptInEra era -> Script (ShelleyLedgerEra era)
toShelleyScript (ScriptInEra ScriptLanguageInEra lang era
langInEra (SimpleScript SimpleScriptVersion lang
SimpleScriptV1 SimpleScript lang
script)) =
    case ScriptLanguageInEra lang era
langInEra of
      ScriptLanguageInEra lang era
SimpleScriptV1InShelley -> SimpleScript SimpleScriptV1 -> MultiSig StandardCrypto
toShelleyMultiSig SimpleScript lang
SimpleScript SimpleScriptV1
script
      ScriptLanguageInEra lang era
SimpleScriptV1InAllegra -> SimpleScript lang -> Timelock StandardCrypto
forall lang. SimpleScript lang -> Timelock StandardCrypto
toAllegraTimelock SimpleScript lang
script
      ScriptLanguageInEra lang era
SimpleScriptV1InMary    -> SimpleScript lang -> Timelock StandardCrypto
forall lang. SimpleScript lang -> Timelock StandardCrypto
toAllegraTimelock SimpleScript lang
script
      ScriptLanguageInEra lang era
SimpleScriptV1InAlonzo  -> Timelock (Crypto (AlonzoEra StandardCrypto))
-> Script (AlonzoEra StandardCrypto)
forall era. Timelock (Crypto era) -> Script era
Alonzo.TimelockScript (SimpleScript lang -> Timelock StandardCrypto
forall lang. SimpleScript lang -> Timelock StandardCrypto
toAllegraTimelock SimpleScript lang
script)
      ScriptLanguageInEra lang era
SimpleScriptV1InBabbage -> Timelock (Crypto (BabbageEra StandardCrypto))
-> Script (BabbageEra StandardCrypto)
forall era. Timelock (Crypto era) -> Script era
Alonzo.TimelockScript (SimpleScript lang -> Timelock StandardCrypto
forall lang. SimpleScript lang -> Timelock StandardCrypto
toAllegraTimelock SimpleScript lang
script)

toShelleyScript (ScriptInEra ScriptLanguageInEra lang era
langInEra (SimpleScript SimpleScriptVersion lang
SimpleScriptV2 SimpleScript lang
script)) =
    case ScriptLanguageInEra lang era
langInEra of
      ScriptLanguageInEra lang era
SimpleScriptV2InAllegra -> SimpleScript lang -> Timelock StandardCrypto
forall lang. SimpleScript lang -> Timelock StandardCrypto
toAllegraTimelock SimpleScript lang
script
      ScriptLanguageInEra lang era
SimpleScriptV2InMary    -> SimpleScript lang -> Timelock StandardCrypto
forall lang. SimpleScript lang -> Timelock StandardCrypto
toAllegraTimelock SimpleScript lang
script
      ScriptLanguageInEra lang era
SimpleScriptV2InAlonzo  -> Timelock (Crypto (AlonzoEra StandardCrypto))
-> Script (AlonzoEra StandardCrypto)
forall era. Timelock (Crypto era) -> Script era
Alonzo.TimelockScript (SimpleScript lang -> Timelock StandardCrypto
forall lang. SimpleScript lang -> Timelock StandardCrypto
toAllegraTimelock SimpleScript lang
script)
      ScriptLanguageInEra lang era
SimpleScriptV2InBabbage -> Timelock (Crypto (BabbageEra StandardCrypto))
-> Script (BabbageEra StandardCrypto)
forall era. Timelock (Crypto era) -> Script era
Alonzo.TimelockScript (SimpleScript lang -> Timelock StandardCrypto
forall lang. SimpleScript lang -> Timelock StandardCrypto
toAllegraTimelock SimpleScript lang
script)

toShelleyScript (ScriptInEra ScriptLanguageInEra lang era
langInEra (PlutusScript PlutusScriptVersion lang
PlutusScriptV1
                                         (PlutusScriptSerialised ShortByteString
script))) =
    case ScriptLanguageInEra lang era
langInEra of
      ScriptLanguageInEra lang era
PlutusScriptV1InAlonzo  -> Language -> ShortByteString -> Script (AlonzoEra StandardCrypto)
forall era. Language -> ShortByteString -> Script era
Alonzo.PlutusScript Language
Alonzo.PlutusV1 ShortByteString
script
      ScriptLanguageInEra lang era
PlutusScriptV1InBabbage -> Language -> ShortByteString -> Script (BabbageEra StandardCrypto)
forall era. Language -> ShortByteString -> Script era
Alonzo.PlutusScript Language
Alonzo.PlutusV1 ShortByteString
script

toShelleyScript (ScriptInEra ScriptLanguageInEra lang era
langInEra (PlutusScript PlutusScriptVersion lang
PlutusScriptV2
                                         (PlutusScriptSerialised ShortByteString
script))) =
    case ScriptLanguageInEra lang era
langInEra of
      ScriptLanguageInEra lang era
PlutusScriptV2InBabbage -> Language -> ShortByteString -> Script (BabbageEra StandardCrypto)
forall era. Language -> ShortByteString -> Script era
Alonzo.PlutusScript Language
Alonzo.PlutusV2 ShortByteString
script

fromShelleyBasedScript  :: ShelleyBasedEra era
                        -> Ledger.Script (ShelleyLedgerEra era)
                        -> ScriptInEra era
fromShelleyBasedScript :: ShelleyBasedEra era
-> Script (ShelleyLedgerEra era) -> ScriptInEra era
fromShelleyBasedScript ShelleyBasedEra era
era Script (ShelleyLedgerEra era)
script =
  case ShelleyBasedEra era
era of
    ShelleyBasedEra era
ShelleyBasedEraShelley ->
      ScriptLanguageInEra SimpleScriptV1 ShelleyEra
-> Script SimpleScriptV1 -> ScriptInEra ShelleyEra
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScriptV1 ShelleyEra
SimpleScriptV1InShelley (Script SimpleScriptV1 -> ScriptInEra ShelleyEra)
-> Script SimpleScriptV1 -> ScriptInEra ShelleyEra
forall a b. (a -> b) -> a -> b
$
      SimpleScriptVersion SimpleScriptV1
-> SimpleScript SimpleScriptV1 -> Script SimpleScriptV1
forall lang.
SimpleScriptVersion lang -> SimpleScript lang -> Script lang
SimpleScript SimpleScriptVersion SimpleScriptV1
SimpleScriptV1 (SimpleScript SimpleScriptV1 -> Script SimpleScriptV1)
-> SimpleScript SimpleScriptV1 -> Script SimpleScriptV1
forall a b. (a -> b) -> a -> b
$
      MultiSig StandardCrypto -> SimpleScript SimpleScriptV1
forall lang. MultiSig StandardCrypto -> SimpleScript lang
fromShelleyMultiSig Script (ShelleyLedgerEra era)
MultiSig StandardCrypto
script
    ShelleyBasedEra era
ShelleyBasedEraAllegra ->
      ScriptLanguageInEra SimpleScriptV2 AllegraEra
-> Script SimpleScriptV2 -> ScriptInEra AllegraEra
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScriptV2 AllegraEra
SimpleScriptV2InAllegra (Script SimpleScriptV2 -> ScriptInEra AllegraEra)
-> Script SimpleScriptV2 -> ScriptInEra AllegraEra
forall a b. (a -> b) -> a -> b
$
      SimpleScriptVersion SimpleScriptV2
-> SimpleScript SimpleScriptV2 -> Script SimpleScriptV2
forall lang.
SimpleScriptVersion lang -> SimpleScript lang -> Script lang
SimpleScript SimpleScriptVersion SimpleScriptV2
SimpleScriptV2 (SimpleScript SimpleScriptV2 -> Script SimpleScriptV2)
-> SimpleScript SimpleScriptV2 -> Script SimpleScriptV2
forall a b. (a -> b) -> a -> b
$
      TimeLocksSupported SimpleScriptV2
-> Timelock StandardCrypto -> SimpleScript SimpleScriptV2
forall lang.
TimeLocksSupported lang
-> Timelock StandardCrypto -> SimpleScript lang
fromAllegraTimelock TimeLocksSupported SimpleScriptV2
TimeLocksInSimpleScriptV2 Script (ShelleyLedgerEra era)
Timelock StandardCrypto
script
    ShelleyBasedEra era
ShelleyBasedEraMary ->
      ScriptLanguageInEra SimpleScriptV2 MaryEra
-> Script SimpleScriptV2 -> ScriptInEra MaryEra
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScriptV2 MaryEra
SimpleScriptV2InMary (Script SimpleScriptV2 -> ScriptInEra MaryEra)
-> Script SimpleScriptV2 -> ScriptInEra MaryEra
forall a b. (a -> b) -> a -> b
$
      SimpleScriptVersion SimpleScriptV2
-> SimpleScript SimpleScriptV2 -> Script SimpleScriptV2
forall lang.
SimpleScriptVersion lang -> SimpleScript lang -> Script lang
SimpleScript SimpleScriptVersion SimpleScriptV2
SimpleScriptV2 (SimpleScript SimpleScriptV2 -> Script SimpleScriptV2)
-> SimpleScript SimpleScriptV2 -> Script SimpleScriptV2
forall a b. (a -> b) -> a -> b
$
      TimeLocksSupported SimpleScriptV2
-> Timelock StandardCrypto -> SimpleScript SimpleScriptV2
forall lang.
TimeLocksSupported lang
-> Timelock StandardCrypto -> SimpleScript lang
fromAllegraTimelock TimeLocksSupported SimpleScriptV2
TimeLocksInSimpleScriptV2 Script (ShelleyLedgerEra era)
Timelock StandardCrypto
script
    ShelleyBasedEra era
ShelleyBasedEraAlonzo ->
      case Script (ShelleyLedgerEra era)
script of
        Alonzo.TimelockScript s ->
          ScriptLanguageInEra SimpleScriptV2 AlonzoEra
-> Script SimpleScriptV2 -> ScriptInEra AlonzoEra
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScriptV2 AlonzoEra
SimpleScriptV2InAlonzo (Script SimpleScriptV2 -> ScriptInEra AlonzoEra)
-> Script SimpleScriptV2 -> ScriptInEra AlonzoEra
forall a b. (a -> b) -> a -> b
$
          SimpleScriptVersion SimpleScriptV2
-> SimpleScript SimpleScriptV2 -> Script SimpleScriptV2
forall lang.
SimpleScriptVersion lang -> SimpleScript lang -> Script lang
SimpleScript SimpleScriptVersion SimpleScriptV2
SimpleScriptV2 (SimpleScript SimpleScriptV2 -> Script SimpleScriptV2)
-> SimpleScript SimpleScriptV2 -> Script SimpleScriptV2
forall a b. (a -> b) -> a -> b
$
          TimeLocksSupported SimpleScriptV2
-> Timelock StandardCrypto -> SimpleScript SimpleScriptV2
forall lang.
TimeLocksSupported lang
-> Timelock StandardCrypto -> SimpleScript lang
fromAllegraTimelock TimeLocksSupported SimpleScriptV2
TimeLocksInSimpleScriptV2 Timelock StandardCrypto
Timelock (Crypto (AlonzoEra StandardCrypto))
s
        Alonzo.PlutusScript Alonzo.PlutusV1 s ->
          ScriptLanguageInEra PlutusScriptV1 AlonzoEra
-> Script PlutusScriptV1 -> ScriptInEra AlonzoEra
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra PlutusScriptV1 AlonzoEra
PlutusScriptV1InAlonzo (Script PlutusScriptV1 -> ScriptInEra AlonzoEra)
-> Script PlutusScriptV1 -> ScriptInEra AlonzoEra
forall a b. (a -> b) -> a -> b
$
          PlutusScriptVersion PlutusScriptV1
-> PlutusScript PlutusScriptV1 -> Script PlutusScriptV1
forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
PlutusScript PlutusScriptVersion PlutusScriptV1
PlutusScriptV1 (PlutusScript PlutusScriptV1 -> Script PlutusScriptV1)
-> PlutusScript PlutusScriptV1 -> Script PlutusScriptV1
forall a b. (a -> b) -> a -> b
$
          ShortByteString -> PlutusScript PlutusScriptV1
forall lang. ShortByteString -> PlutusScript lang
PlutusScriptSerialised ShortByteString
s
        Alonzo.PlutusScript Alonzo.PlutusV2 _ ->
          String -> ScriptInEra era
forall a. HasCallStack => String -> a
error String
"fromShelleyBasedScript: PlutusV2 not supported in Alonzo era"
    ShelleyBasedEra era
ShelleyBasedEraBabbage ->
      case Script (ShelleyLedgerEra era)
script of
        Alonzo.TimelockScript s ->
          ScriptLanguageInEra SimpleScriptV2 BabbageEra
-> Script SimpleScriptV2 -> ScriptInEra BabbageEra
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScriptV2 BabbageEra
SimpleScriptV2InBabbage (Script SimpleScriptV2 -> ScriptInEra BabbageEra)
-> Script SimpleScriptV2 -> ScriptInEra BabbageEra
forall a b. (a -> b) -> a -> b
$
          SimpleScriptVersion SimpleScriptV2
-> SimpleScript SimpleScriptV2 -> Script SimpleScriptV2
forall lang.
SimpleScriptVersion lang -> SimpleScript lang -> Script lang
SimpleScript SimpleScriptVersion SimpleScriptV2
SimpleScriptV2 (SimpleScript SimpleScriptV2 -> Script SimpleScriptV2)
-> SimpleScript SimpleScriptV2 -> Script SimpleScriptV2
forall a b. (a -> b) -> a -> b
$
          TimeLocksSupported SimpleScriptV2
-> Timelock StandardCrypto -> SimpleScript SimpleScriptV2
forall lang.
TimeLocksSupported lang
-> Timelock StandardCrypto -> SimpleScript lang
fromAllegraTimelock TimeLocksSupported SimpleScriptV2
TimeLocksInSimpleScriptV2 Timelock StandardCrypto
Timelock (Crypto (BabbageEra StandardCrypto))
s
        Alonzo.PlutusScript Alonzo.PlutusV1 s ->
          ScriptLanguageInEra PlutusScriptV1 BabbageEra
-> Script PlutusScriptV1 -> ScriptInEra BabbageEra
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra PlutusScriptV1 BabbageEra
PlutusScriptV1InBabbage (Script PlutusScriptV1 -> ScriptInEra BabbageEra)
-> Script PlutusScriptV1 -> ScriptInEra BabbageEra
forall a b. (a -> b) -> a -> b
$
          PlutusScriptVersion PlutusScriptV1
-> PlutusScript PlutusScriptV1 -> Script PlutusScriptV1
forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
PlutusScript PlutusScriptVersion PlutusScriptV1
PlutusScriptV1 (PlutusScript PlutusScriptV1 -> Script PlutusScriptV1)
-> PlutusScript PlutusScriptV1 -> Script PlutusScriptV1
forall a b. (a -> b) -> a -> b
$
          ShortByteString -> PlutusScript PlutusScriptV1
forall lang. ShortByteString -> PlutusScript lang
PlutusScriptSerialised ShortByteString
s
        Alonzo.PlutusScript Alonzo.PlutusV2 s ->
          ScriptLanguageInEra PlutusScriptV2 BabbageEra
-> Script PlutusScriptV2 -> ScriptInEra BabbageEra
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra PlutusScriptV2 BabbageEra
PlutusScriptV2InBabbage (Script PlutusScriptV2 -> ScriptInEra BabbageEra)
-> Script PlutusScriptV2 -> ScriptInEra BabbageEra
forall a b. (a -> b) -> a -> b
$
          PlutusScriptVersion PlutusScriptV2
-> PlutusScript PlutusScriptV2 -> Script PlutusScriptV2
forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
PlutusScript PlutusScriptVersion PlutusScriptV2
PlutusScriptV2 (PlutusScript PlutusScriptV2 -> Script PlutusScriptV2)
-> PlutusScript PlutusScriptV2 -> Script PlutusScriptV2
forall a b. (a -> b) -> a -> b
$
          ShortByteString -> PlutusScript PlutusScriptV2
forall lang. ShortByteString -> PlutusScript lang
PlutusScriptSerialised ShortByteString
s



-- | Conversion for the 'Shelley.MultiSig' language used by the Shelley era.
--
toShelleyMultiSig :: SimpleScript SimpleScriptV1
                  -> Shelley.MultiSig StandardCrypto
toShelleyMultiSig :: SimpleScript SimpleScriptV1 -> MultiSig StandardCrypto
toShelleyMultiSig = SimpleScript SimpleScriptV1 -> MultiSig StandardCrypto
go
  where
    go :: SimpleScript SimpleScriptV1 -> Shelley.MultiSig StandardCrypto
    go :: SimpleScript SimpleScriptV1 -> MultiSig StandardCrypto
go (RequireSignature (PaymentKeyHash kh))
                        = KeyHash 'Witness StandardCrypto -> MultiSig StandardCrypto
forall crypto.
Crypto crypto =>
KeyHash 'Witness crypto -> MultiSig crypto
Shelley.RequireSignature (KeyHash 'Payment StandardCrypto -> KeyHash 'Witness StandardCrypto
forall (a :: KeyRole -> * -> *) (r :: KeyRole) crypto
       (r' :: KeyRole).
HasKeyRole a =>
a r crypto -> a r' crypto
Shelley.coerceKeyRole KeyHash 'Payment StandardCrypto
kh)
    go (RequireAllOf [SimpleScript SimpleScriptV1]
s) = [MultiSig StandardCrypto] -> MultiSig StandardCrypto
forall crypto.
Crypto crypto =>
[MultiSig crypto] -> MultiSig crypto
Shelley.RequireAllOf ((SimpleScript SimpleScriptV1 -> MultiSig StandardCrypto)
-> [SimpleScript SimpleScriptV1] -> [MultiSig StandardCrypto]
forall a b. (a -> b) -> [a] -> [b]
map SimpleScript SimpleScriptV1 -> MultiSig StandardCrypto
go [SimpleScript SimpleScriptV1]
s)
    go (RequireAnyOf [SimpleScript SimpleScriptV1]
s) = [MultiSig StandardCrypto] -> MultiSig StandardCrypto
forall crypto.
Crypto crypto =>
[MultiSig crypto] -> MultiSig crypto
Shelley.RequireAnyOf ((SimpleScript SimpleScriptV1 -> MultiSig StandardCrypto)
-> [SimpleScript SimpleScriptV1] -> [MultiSig StandardCrypto]
forall a b. (a -> b) -> [a] -> [b]
map SimpleScript SimpleScriptV1 -> MultiSig StandardCrypto
go [SimpleScript SimpleScriptV1]
s)
    go (RequireMOf Int
m [SimpleScript SimpleScriptV1]
s) = Int -> [MultiSig StandardCrypto] -> MultiSig StandardCrypto
forall crypto.
Crypto crypto =>
Int -> [MultiSig crypto] -> MultiSig crypto
Shelley.RequireMOf Int
m ((SimpleScript SimpleScriptV1 -> MultiSig StandardCrypto)
-> [SimpleScript SimpleScriptV1] -> [MultiSig StandardCrypto]
forall a b. (a -> b) -> [a] -> [b]
map SimpleScript SimpleScriptV1 -> MultiSig StandardCrypto
go [SimpleScript SimpleScriptV1]
s)

-- | Conversion for the 'Shelley.MultiSig' language used by the Shelley era.
--
fromShelleyMultiSig :: Shelley.MultiSig StandardCrypto -> SimpleScript lang
fromShelleyMultiSig :: MultiSig StandardCrypto -> SimpleScript lang
fromShelleyMultiSig = MultiSig StandardCrypto -> SimpleScript lang
forall lang. MultiSig StandardCrypto -> SimpleScript lang
go
  where
    go :: MultiSig StandardCrypto -> SimpleScript lang
go (Shelley.RequireSignature KeyHash 'Witness StandardCrypto
kh)
                                = Hash PaymentKey -> SimpleScript lang
forall lang. Hash PaymentKey -> SimpleScript lang
RequireSignature
                                    (KeyHash 'Payment StandardCrypto -> Hash PaymentKey
PaymentKeyHash (KeyHash 'Witness StandardCrypto -> KeyHash 'Payment StandardCrypto
forall (a :: KeyRole -> * -> *) (r :: KeyRole) crypto
       (r' :: KeyRole).
HasKeyRole a =>
a r crypto -> a r' crypto
Shelley.coerceKeyRole KeyHash 'Witness StandardCrypto
kh))
    go (Shelley.RequireAllOf [MultiSig StandardCrypto]
s) = [SimpleScript lang] -> SimpleScript lang
forall lang. [SimpleScript lang] -> SimpleScript lang
RequireAllOf ((MultiSig StandardCrypto -> SimpleScript lang)
-> [MultiSig StandardCrypto] -> [SimpleScript lang]
forall a b. (a -> b) -> [a] -> [b]
map MultiSig StandardCrypto -> SimpleScript lang
go [MultiSig StandardCrypto]
s)
    go (Shelley.RequireAnyOf [MultiSig StandardCrypto]
s) = [SimpleScript lang] -> SimpleScript lang
forall lang. [SimpleScript lang] -> SimpleScript lang
RequireAnyOf ((MultiSig StandardCrypto -> SimpleScript lang)
-> [MultiSig StandardCrypto] -> [SimpleScript lang]
forall a b. (a -> b) -> [a] -> [b]
map MultiSig StandardCrypto -> SimpleScript lang
go [MultiSig StandardCrypto]
s)
    go (Shelley.RequireMOf Int
m [MultiSig StandardCrypto]
s) = Int -> [SimpleScript lang] -> SimpleScript lang
forall lang. Int -> [SimpleScript lang] -> SimpleScript lang
RequireMOf Int
m ((MultiSig StandardCrypto -> SimpleScript lang)
-> [MultiSig StandardCrypto] -> [SimpleScript lang]
forall a b. (a -> b) -> [a] -> [b]
map MultiSig StandardCrypto -> SimpleScript lang
go [MultiSig StandardCrypto]
s)

-- | Conversion for the 'Timelock.Timelock' language that is shared between the
-- Allegra and Mary eras.
--
toAllegraTimelock :: forall lang.
                     SimpleScript lang -> Timelock.Timelock StandardCrypto
toAllegraTimelock :: SimpleScript lang -> Timelock StandardCrypto
toAllegraTimelock = SimpleScript lang -> Timelock StandardCrypto
go
  where
    go :: SimpleScript lang -> Timelock.Timelock StandardCrypto
    go :: SimpleScript lang -> Timelock StandardCrypto
go (RequireSignature (PaymentKeyHash kh))
                        = KeyHash 'Witness StandardCrypto -> Timelock StandardCrypto
forall crypto.
Crypto crypto =>
KeyHash 'Witness crypto -> Timelock crypto
Timelock.RequireSignature (KeyHash 'Payment StandardCrypto -> KeyHash 'Witness StandardCrypto
forall (a :: KeyRole -> * -> *) (r :: KeyRole) crypto
       (r' :: KeyRole).
HasKeyRole a =>
a r crypto -> a r' crypto
Shelley.coerceKeyRole KeyHash 'Payment StandardCrypto
kh)
    go (RequireAllOf [SimpleScript lang]
s) = StrictSeq (Timelock StandardCrypto) -> Timelock StandardCrypto
forall crypto.
Crypto crypto =>
StrictSeq (Timelock crypto) -> Timelock crypto
Timelock.RequireAllOf ([Timelock StandardCrypto] -> StrictSeq (Timelock StandardCrypto)
forall a. [a] -> StrictSeq a
Seq.fromList ((SimpleScript lang -> Timelock StandardCrypto)
-> [SimpleScript lang] -> [Timelock StandardCrypto]
forall a b. (a -> b) -> [a] -> [b]
map SimpleScript lang -> Timelock StandardCrypto
go [SimpleScript lang]
s))
    go (RequireAnyOf [SimpleScript lang]
s) = StrictSeq (Timelock StandardCrypto) -> Timelock StandardCrypto
forall crypto.
Crypto crypto =>
StrictSeq (Timelock crypto) -> Timelock crypto
Timelock.RequireAnyOf ([Timelock StandardCrypto] -> StrictSeq (Timelock StandardCrypto)
forall a. [a] -> StrictSeq a
Seq.fromList ((SimpleScript lang -> Timelock StandardCrypto)
-> [SimpleScript lang] -> [Timelock StandardCrypto]
forall a b. (a -> b) -> [a] -> [b]
map SimpleScript lang -> Timelock StandardCrypto
go [SimpleScript lang]
s))
    go (RequireMOf Int
m [SimpleScript lang]
s) = Int
-> StrictSeq (Timelock StandardCrypto) -> Timelock StandardCrypto
forall crypto.
Crypto crypto =>
Int -> StrictSeq (Timelock crypto) -> Timelock crypto
Timelock.RequireMOf Int
m ([Timelock StandardCrypto] -> StrictSeq (Timelock StandardCrypto)
forall a. [a] -> StrictSeq a
Seq.fromList ((SimpleScript lang -> Timelock StandardCrypto)
-> [SimpleScript lang] -> [Timelock StandardCrypto]
forall a b. (a -> b) -> [a] -> [b]
map SimpleScript lang -> Timelock StandardCrypto
go [SimpleScript lang]
s))
    go (RequireTimeBefore TimeLocksSupported lang
_ SlotNo
t) = SlotNo -> Timelock StandardCrypto
forall crypto. Crypto crypto => SlotNo -> Timelock crypto
Timelock.RequireTimeExpire SlotNo
t
    go (RequireTimeAfter  TimeLocksSupported lang
_ SlotNo
t) = SlotNo -> Timelock StandardCrypto
forall crypto. Crypto crypto => SlotNo -> Timelock crypto
Timelock.RequireTimeStart  SlotNo
t

-- | Conversion for the 'Timelock.Timelock' language that is shared between the
-- Allegra and Mary eras.
--
fromAllegraTimelock :: TimeLocksSupported lang
                    -> Timelock.Timelock StandardCrypto
                    -> SimpleScript lang
fromAllegraTimelock :: TimeLocksSupported lang
-> Timelock StandardCrypto -> SimpleScript lang
fromAllegraTimelock TimeLocksSupported lang
timelocks = Timelock StandardCrypto -> SimpleScript lang
go
  where
    go :: Timelock StandardCrypto -> SimpleScript lang
go (Timelock.RequireSignature KeyHash 'Witness StandardCrypto
kh) = Hash PaymentKey -> SimpleScript lang
forall lang. Hash PaymentKey -> SimpleScript lang
RequireSignature
                                          (KeyHash 'Payment StandardCrypto -> Hash PaymentKey
PaymentKeyHash (KeyHash 'Witness StandardCrypto -> KeyHash 'Payment StandardCrypto
forall (a :: KeyRole -> * -> *) (r :: KeyRole) crypto
       (r' :: KeyRole).
HasKeyRole a =>
a r crypto -> a r' crypto
Shelley.coerceKeyRole KeyHash 'Witness StandardCrypto
kh))
    go (Timelock.RequireTimeExpire SlotNo
t) = TimeLocksSupported lang -> SlotNo -> SimpleScript lang
forall lang. TimeLocksSupported lang -> SlotNo -> SimpleScript lang
RequireTimeBefore TimeLocksSupported lang
timelocks SlotNo
t
    go (Timelock.RequireTimeStart  SlotNo
t) = TimeLocksSupported lang -> SlotNo -> SimpleScript lang
forall lang. TimeLocksSupported lang -> SlotNo -> SimpleScript lang
RequireTimeAfter  TimeLocksSupported lang
timelocks SlotNo
t
    go (Timelock.RequireAllOf      StrictSeq (Timelock StandardCrypto)
s) = [SimpleScript lang] -> SimpleScript lang
forall lang. [SimpleScript lang] -> SimpleScript lang
RequireAllOf ((Timelock StandardCrypto -> SimpleScript lang)
-> [Timelock StandardCrypto] -> [SimpleScript lang]
forall a b. (a -> b) -> [a] -> [b]
map Timelock StandardCrypto -> SimpleScript lang
go (StrictSeq (Timelock StandardCrypto) -> [Timelock StandardCrypto]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (Timelock StandardCrypto)
s))
    go (Timelock.RequireAnyOf      StrictSeq (Timelock StandardCrypto)
s) = [SimpleScript lang] -> SimpleScript lang
forall lang. [SimpleScript lang] -> SimpleScript lang
RequireAnyOf ((Timelock StandardCrypto -> SimpleScript lang)
-> [Timelock StandardCrypto] -> [SimpleScript lang]
forall a b. (a -> b) -> [a] -> [b]
map Timelock StandardCrypto -> SimpleScript lang
go (StrictSeq (Timelock StandardCrypto) -> [Timelock StandardCrypto]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (Timelock StandardCrypto)
s))
    go (Timelock.RequireMOf      Int
i StrictSeq (Timelock StandardCrypto)
s) = Int -> [SimpleScript lang] -> SimpleScript lang
forall lang. Int -> [SimpleScript lang] -> SimpleScript lang
RequireMOf Int
i ((Timelock StandardCrypto -> SimpleScript lang)
-> [Timelock StandardCrypto] -> [SimpleScript lang]
forall a b. (a -> b) -> [a] -> [b]
map Timelock StandardCrypto -> SimpleScript lang
go (StrictSeq (Timelock StandardCrypto) -> [Timelock StandardCrypto]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (Timelock StandardCrypto)
s))


-- ----------------------------------------------------------------------------
-- JSON serialisation
--

-- Remember that Plutus scripts do not have a JSON syntax, and so do not have
-- and JSON instances. The only JSON format they support is via the
-- HasTextEnvelope class which just wraps the binary format.
--
-- Because of this the 'Script' type also does not have any JSON instances, but
-- the 'SimpleScript' type does.

instance ToJSON (SimpleScript lang) where
  toJSON :: SimpleScript lang -> Value
toJSON (RequireSignature Hash PaymentKey
pKeyHash) =
    [Pair] -> Value
object [ Key
"type"    Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"sig"
           , Key
"keyHash" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Hash PaymentKey -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText Hash PaymentKey
pKeyHash
           ]
  toJSON (RequireTimeBefore TimeLocksSupported lang
_ SlotNo
slot) =
    [Pair] -> Value
object [ Key
"type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"before"
           , Key
"slot" Key -> SlotNo -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SlotNo
slot
           ]
  toJSON (RequireTimeAfter TimeLocksSupported lang
_ SlotNo
slot) =
    [Pair] -> Value
object [ Key
"type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"after"
           , Key
"slot" Key -> SlotNo -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SlotNo
slot
           ]
  toJSON (RequireAnyOf [SimpleScript lang]
reqScripts) =
    [Pair] -> Value
object [ Key
"type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"any", Key
"scripts" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (SimpleScript lang -> Value) -> [SimpleScript lang] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map SimpleScript lang -> Value
forall a. ToJSON a => a -> Value
toJSON [SimpleScript lang]
reqScripts ]
  toJSON (RequireAllOf [SimpleScript lang]
reqScripts) =
    [Pair] -> Value
object [ Key
"type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"all", Key
"scripts" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (SimpleScript lang -> Value) -> [SimpleScript lang] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map SimpleScript lang -> Value
forall a. ToJSON a => a -> Value
toJSON [SimpleScript lang]
reqScripts ]
  toJSON (RequireMOf Int
reqNum [SimpleScript lang]
reqScripts) =
    [Pair] -> Value
object [ Key
"type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"atLeast"
           , Key
"required" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
reqNum
           , Key
"scripts" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (SimpleScript lang -> Value) -> [SimpleScript lang] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map SimpleScript lang -> Value
forall a. ToJSON a => a -> Value
toJSON [SimpleScript lang]
reqScripts
           ]


instance IsSimpleScriptLanguage lang => FromJSON (SimpleScript lang) where
  parseJSON :: Value -> Parser (SimpleScript lang)
parseJSON = SimpleScriptVersion lang -> Value -> Parser (SimpleScript lang)
forall lang.
SimpleScriptVersion lang -> Value -> Parser (SimpleScript lang)
parseSimpleScript SimpleScriptVersion lang
forall lang.
IsSimpleScriptLanguage lang =>
SimpleScriptVersion lang
simpleScriptVersion


parseSimpleScript :: SimpleScriptVersion lang
                  -> Value -> Aeson.Parser (SimpleScript lang)
parseSimpleScript :: SimpleScriptVersion lang -> Value -> Parser (SimpleScript lang)
parseSimpleScript SimpleScriptVersion lang
lang Value
v = Value -> Parser (SimpleScript lang)
forall lang. Value -> Parser (SimpleScript lang)
parseScriptSig          Value
v
                       Parser (SimpleScript lang)
-> Parser (SimpleScript lang) -> Parser (SimpleScript lang)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SimpleScriptVersion lang -> Value -> Parser (SimpleScript lang)
forall lang.
SimpleScriptVersion lang -> Value -> Parser (SimpleScript lang)
parseScriptBefore  SimpleScriptVersion lang
lang Value
v
                       Parser (SimpleScript lang)
-> Parser (SimpleScript lang) -> Parser (SimpleScript lang)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SimpleScriptVersion lang -> Value -> Parser (SimpleScript lang)
forall lang.
SimpleScriptVersion lang -> Value -> Parser (SimpleScript lang)
parseScriptAfter   SimpleScriptVersion lang
lang Value
v
                       Parser (SimpleScript lang)
-> Parser (SimpleScript lang) -> Parser (SimpleScript lang)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SimpleScriptVersion lang -> Value -> Parser (SimpleScript lang)
forall lang.
SimpleScriptVersion lang -> Value -> Parser (SimpleScript lang)
parseScriptAny     SimpleScriptVersion lang
lang Value
v
                       Parser (SimpleScript lang)
-> Parser (SimpleScript lang) -> Parser (SimpleScript lang)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SimpleScriptVersion lang -> Value -> Parser (SimpleScript lang)
forall lang.
SimpleScriptVersion lang -> Value -> Parser (SimpleScript lang)
parseScriptAll     SimpleScriptVersion lang
lang Value
v
                       Parser (SimpleScript lang)
-> Parser (SimpleScript lang) -> Parser (SimpleScript lang)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SimpleScriptVersion lang -> Value -> Parser (SimpleScript lang)
forall lang.
SimpleScriptVersion lang -> Value -> Parser (SimpleScript lang)
parseScriptAtLeast SimpleScriptVersion lang
lang Value
v

parseScriptAny :: SimpleScriptVersion lang
               -> Value -> Aeson.Parser (SimpleScript lang)
parseScriptAny :: SimpleScriptVersion lang -> Value -> Parser (SimpleScript lang)
parseScriptAny SimpleScriptVersion lang
lang =
    String
-> (Object -> Parser (SimpleScript lang))
-> Value
-> Parser (SimpleScript lang)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"any" ((Object -> Parser (SimpleScript lang))
 -> Value -> Parser (SimpleScript lang))
-> (Object -> Parser (SimpleScript lang))
-> Value
-> Parser (SimpleScript lang)
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
      Text
t <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
      case Text
t :: Text of
        Text
"any" -> do Vector Value
vs <- Object
obj Object -> Key -> Parser (Vector Value)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"scripts"
                    [SimpleScript lang] -> SimpleScript lang
forall lang. [SimpleScript lang] -> SimpleScript lang
RequireAnyOf ([SimpleScript lang] -> SimpleScript lang)
-> Parser [SimpleScript lang] -> Parser (SimpleScript lang)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SimpleScriptVersion lang
-> Vector Value -> Parser [SimpleScript lang]
forall lang.
SimpleScriptVersion lang
-> Vector Value -> Parser [SimpleScript lang]
gatherSimpleScriptTerms SimpleScriptVersion lang
lang Vector Value
vs
        Text
_ -> String -> Parser (SimpleScript lang)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"\"any\" script value not found"

parseScriptAll :: SimpleScriptVersion lang
               -> Value -> Aeson.Parser (SimpleScript lang)
parseScriptAll :: SimpleScriptVersion lang -> Value -> Parser (SimpleScript lang)
parseScriptAll SimpleScriptVersion lang
lang =
    String
-> (Object -> Parser (SimpleScript lang))
-> Value
-> Parser (SimpleScript lang)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"all" ((Object -> Parser (SimpleScript lang))
 -> Value -> Parser (SimpleScript lang))
-> (Object -> Parser (SimpleScript lang))
-> Value
-> Parser (SimpleScript lang)
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
      Text
t <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
      case Text
t :: Text of
        Text
"all" -> do Vector Value
vs <- Object
obj Object -> Key -> Parser (Vector Value)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"scripts"
                    [SimpleScript lang] -> SimpleScript lang
forall lang. [SimpleScript lang] -> SimpleScript lang
RequireAllOf ([SimpleScript lang] -> SimpleScript lang)
-> Parser [SimpleScript lang] -> Parser (SimpleScript lang)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SimpleScriptVersion lang
-> Vector Value -> Parser [SimpleScript lang]
forall lang.
SimpleScriptVersion lang
-> Vector Value -> Parser [SimpleScript lang]
gatherSimpleScriptTerms SimpleScriptVersion lang
lang Vector Value
vs
        Text
_ -> String -> Parser (SimpleScript lang)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"\"all\" script value not found"

parseScriptAtLeast :: SimpleScriptVersion lang
                   -> Value -> Aeson.Parser (SimpleScript lang)
parseScriptAtLeast :: SimpleScriptVersion lang -> Value -> Parser (SimpleScript lang)
parseScriptAtLeast SimpleScriptVersion lang
lang =
    String
-> (Object -> Parser (SimpleScript lang))
-> Value
-> Parser (SimpleScript lang)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"atLeast" ((Object -> Parser (SimpleScript lang))
 -> Value -> Parser (SimpleScript lang))
-> (Object -> Parser (SimpleScript lang))
-> Value
-> Parser (SimpleScript lang)
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
      Text
v <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
      case Text
v :: Text of
        Text
"atLeast" -> do
          Value
r  <- Object
obj Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"required"
          Vector Value
vs <- Object
obj Object -> Key -> Parser (Vector Value)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"scripts"
          case Value
r of
            Number Scientific
sci ->
              case Scientific -> Maybe Int
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger Scientific
sci of
                Just Int
reqInt ->
                  do [SimpleScript lang]
scripts <- SimpleScriptVersion lang
-> Vector Value -> Parser [SimpleScript lang]
forall lang.
SimpleScriptVersion lang
-> Vector Value -> Parser [SimpleScript lang]
gatherSimpleScriptTerms SimpleScriptVersion lang
lang Vector Value
vs
                     let numScripts :: Int
numScripts = [SimpleScript lang] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SimpleScript lang]
scripts
                     Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
                       (Int
reqInt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
numScripts)
                       (String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ()) -> String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String
"Required number of script signatures exceeds the number of scripts."
                             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" Required number: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
reqInt
                             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" Number of scripts: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
numScripts)
                     SimpleScript lang -> Parser (SimpleScript lang)
forall (m :: * -> *) a. Monad m => a -> m a
return (SimpleScript lang -> Parser (SimpleScript lang))
-> SimpleScript lang -> Parser (SimpleScript lang)
forall a b. (a -> b) -> a -> b
$ Int -> [SimpleScript lang] -> SimpleScript lang
forall lang. Int -> [SimpleScript lang] -> SimpleScript lang
RequireMOf Int
reqInt [SimpleScript lang]
scripts
                Maybe Int
Nothing -> String -> Parser (SimpleScript lang)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (SimpleScript lang))
-> String -> Parser (SimpleScript lang)
forall a b. (a -> b) -> a -> b
$ String
"Error in \"required\" key: "
                                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Scientific -> String
forall a. Show a => a -> String
show Scientific
sci String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not a valid Int"
            Value
_ -> String -> Parser (SimpleScript lang)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"\"required\" value should be an integer"
        Text
_        -> String -> Parser (SimpleScript lang)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"\"atLeast\" script value not found"

gatherSimpleScriptTerms :: SimpleScriptVersion lang
                        -> Vector Value -> Aeson.Parser [SimpleScript lang]
gatherSimpleScriptTerms :: SimpleScriptVersion lang
-> Vector Value -> Parser [SimpleScript lang]
gatherSimpleScriptTerms SimpleScriptVersion lang
lang = (Value -> Parser (SimpleScript lang))
-> [Value] -> Parser [SimpleScript lang]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (SimpleScriptVersion lang -> Value -> Parser (SimpleScript lang)
forall lang.
SimpleScriptVersion lang -> Value -> Parser (SimpleScript lang)
parseSimpleScript SimpleScriptVersion lang
lang) ([Value] -> Parser [SimpleScript lang])
-> (Vector Value -> [Value])
-> Vector Value
-> Parser [SimpleScript lang]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Value -> [Value]
forall a. Vector a -> [a]
Vector.toList

parseScriptSig :: Value -> Aeson.Parser (SimpleScript lang)
parseScriptSig :: Value -> Parser (SimpleScript lang)
parseScriptSig =
    String
-> (Object -> Parser (SimpleScript lang))
-> Value
-> Parser (SimpleScript lang)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"sig" ((Object -> Parser (SimpleScript lang))
 -> Value -> Parser (SimpleScript lang))
-> (Object -> Parser (SimpleScript lang))
-> Value
-> Parser (SimpleScript lang)
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
      Text
v <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
      case Text
v :: Text of
        Text
"sig" -> do Text
k <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"keyHash"
                    Hash PaymentKey -> SimpleScript lang
forall lang. Hash PaymentKey -> SimpleScript lang
RequireSignature (Hash PaymentKey -> SimpleScript lang)
-> Parser (Hash PaymentKey) -> Parser (SimpleScript lang)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser (Hash PaymentKey)
parsePaymentKeyHash Text
k
        Text
_     -> String -> Parser (SimpleScript lang)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"\"sig\" script value not found"

parseScriptBefore :: SimpleScriptVersion lang
                  -> Value -> Aeson.Parser (SimpleScript lang)
parseScriptBefore :: SimpleScriptVersion lang -> Value -> Parser (SimpleScript lang)
parseScriptBefore SimpleScriptVersion lang
lang =
    String
-> (Object -> Parser (SimpleScript lang))
-> Value
-> Parser (SimpleScript lang)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"before" ((Object -> Parser (SimpleScript lang))
 -> Value -> Parser (SimpleScript lang))
-> (Object -> Parser (SimpleScript lang))
-> Value
-> Parser (SimpleScript lang)
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
      Text
v <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
      case Text
v :: Text of
        Text
"before" ->
          case SimpleScriptVersion lang -> Maybe (TimeLocksSupported lang)
forall lang.
SimpleScriptVersion lang -> Maybe (TimeLocksSupported lang)
timeLocksSupported SimpleScriptVersion lang
lang of
            Just TimeLocksSupported lang
supported -> TimeLocksSupported lang -> SlotNo -> SimpleScript lang
forall lang. TimeLocksSupported lang -> SlotNo -> SimpleScript lang
RequireTimeBefore TimeLocksSupported lang
supported (SlotNo -> SimpleScript lang)
-> Parser SlotNo -> Parser (SimpleScript lang)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser SlotNo
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"slot"
            Maybe (TimeLocksSupported lang)
Nothing -> String -> Parser (SimpleScript lang)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"type \"before\" not supported in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SimpleScriptVersion lang -> String
forall a. Show a => a -> String
show SimpleScriptVersion lang
lang)
        Text
_ -> String -> Parser (SimpleScript lang)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"\"before\" script value not found"

parseScriptAfter :: SimpleScriptVersion lang
                 -> Value -> Aeson.Parser (SimpleScript lang)
parseScriptAfter :: SimpleScriptVersion lang -> Value -> Parser (SimpleScript lang)
parseScriptAfter SimpleScriptVersion lang
lang =
    String
-> (Object -> Parser (SimpleScript lang))
-> Value
-> Parser (SimpleScript lang)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"after" ((Object -> Parser (SimpleScript lang))
 -> Value -> Parser (SimpleScript lang))
-> (Object -> Parser (SimpleScript lang))
-> Value
-> Parser (SimpleScript lang)
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
      Text
v <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
      case Text
v :: Text of
        Text
"after" ->
          case SimpleScriptVersion lang -> Maybe (TimeLocksSupported lang)
forall lang.
SimpleScriptVersion lang -> Maybe (TimeLocksSupported lang)
timeLocksSupported SimpleScriptVersion lang
lang of
            Just TimeLocksSupported lang
supported -> TimeLocksSupported lang -> SlotNo -> SimpleScript lang
forall lang. TimeLocksSupported lang -> SlotNo -> SimpleScript lang
RequireTimeAfter TimeLocksSupported lang
supported (SlotNo -> SimpleScript lang)
-> Parser SlotNo -> Parser (SimpleScript lang)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser SlotNo
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"slot"
            Maybe (TimeLocksSupported lang)
Nothing -> String -> Parser (SimpleScript lang)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"type \"after\" not supported in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SimpleScriptVersion lang -> String
forall a. Show a => a -> String
show SimpleScriptVersion lang
lang)
        Text
_       -> String -> Parser (SimpleScript lang)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"\"after\" script value not found"

parsePaymentKeyHash :: Text -> Aeson.Parser (Hash PaymentKey)
parsePaymentKeyHash :: Text -> Parser (Hash PaymentKey)
parsePaymentKeyHash =
  (RawBytesHexError -> String)
-> Either RawBytesHexError (Hash PaymentKey)
-> Parser (Hash PaymentKey)
forall (m :: * -> *) e a.
MonadFail m =>
(e -> String) -> Either e a -> m a
failEitherWith
    (\RawBytesHexError
e -> String
"Error deserialising payment key hash: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ RawBytesHexError -> String
forall e. Error e => e -> String
displayError RawBytesHexError
e)
  (Either RawBytesHexError (Hash PaymentKey)
 -> Parser (Hash PaymentKey))
-> (Text -> Either RawBytesHexError (Hash PaymentKey))
-> Text
-> Parser (Hash PaymentKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType (Hash PaymentKey)
-> ByteString -> Either RawBytesHexError (Hash PaymentKey)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either RawBytesHexError a
deserialiseFromRawBytesHex (AsType PaymentKey -> AsType (Hash PaymentKey)
forall a. AsType a -> AsType (Hash a)
AsHash AsType PaymentKey
AsPaymentKey)
  (ByteString -> Either RawBytesHexError (Hash PaymentKey))
-> (Text -> ByteString)
-> Text
-> Either RawBytesHexError (Hash PaymentKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8


-- ----------------------------------------------------------------------------
-- Reference scripts
--

-- | A reference scripts is a script that can exist at a transaction output. This greatly
-- reduces the size of transactions that use scripts as the script no longer
-- has to be added to the transaction, they can now be referenced via a transaction output.

data ReferenceScript era where
     ReferenceScript :: ReferenceTxInsScriptsInlineDatumsSupportedInEra era
                     -> ScriptInAnyLang
                     -> ReferenceScript era

     ReferenceScriptNone :: ReferenceScript era

deriving instance Eq (ReferenceScript era)
deriving instance Show (ReferenceScript era)
deriving instance Typeable (ReferenceScript era)

instance IsCardanoEra era => ToJSON (ReferenceScript era) where
  toJSON :: ReferenceScript era -> Value
toJSON (ReferenceScript ReferenceTxInsScriptsInlineDatumsSupportedInEra era
_ ScriptInAnyLang
s) = [Pair] -> Value
object [Key
"referenceScript" Key -> ScriptInAnyLang -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ScriptInAnyLang
s]
  toJSON ReferenceScript era
ReferenceScriptNone = Value
Aeson.Null

instance IsCardanoEra era => FromJSON (ReferenceScript era) where
  parseJSON :: Value -> Parser (ReferenceScript era)
parseJSON = String
-> (Object -> Parser (ReferenceScript era))
-> Value
-> Parser (ReferenceScript era)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"ReferenceScript" ((Object -> Parser (ReferenceScript era))
 -> Value -> Parser (ReferenceScript era))
-> (Object -> Parser (ReferenceScript era))
-> Value
-> Parser (ReferenceScript era)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    case CardanoEra era
-> Maybe (ReferenceTxInsScriptsInlineDatumsSupportedInEra era)
forall era.
CardanoEra era
-> Maybe (ReferenceTxInsScriptsInlineDatumsSupportedInEra era)
refInsScriptsAndInlineDatsSupportedInEra (CardanoEra era
forall era. IsCardanoEra era => CardanoEra era
cardanoEra :: CardanoEra era) of
      Maybe (ReferenceTxInsScriptsInlineDatumsSupportedInEra era)
Nothing -> ReferenceScript era -> Parser (ReferenceScript era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReferenceScript era
forall era. ReferenceScript era
ReferenceScriptNone
      Just ReferenceTxInsScriptsInlineDatumsSupportedInEra era
refSupInEra ->
        ReferenceTxInsScriptsInlineDatumsSupportedInEra era
-> ScriptInAnyLang -> ReferenceScript era
forall era.
ReferenceTxInsScriptsInlineDatumsSupportedInEra era
-> ScriptInAnyLang -> ReferenceScript era
ReferenceScript ReferenceTxInsScriptsInlineDatumsSupportedInEra era
refSupInEra (ScriptInAnyLang -> ReferenceScript era)
-> Parser ScriptInAnyLang -> Parser (ReferenceScript era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ScriptInAnyLang
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"referenceScript"

instance EraCast ReferenceScript where
  eraCast :: CardanoEra toEra
-> ReferenceScript fromEra
-> Either EraCastError (ReferenceScript toEra)
eraCast CardanoEra toEra
toEra = \case
    ReferenceScript fromEra
ReferenceScriptNone -> ReferenceScript toEra
-> Either EraCastError (ReferenceScript toEra)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReferenceScript toEra
forall era. ReferenceScript era
ReferenceScriptNone
    v :: ReferenceScript fromEra
v@(ReferenceScript (ReferenceTxInsScriptsInlineDatumsSupportedInEra fromEra
_ :: ReferenceTxInsScriptsInlineDatumsSupportedInEra fromEra) ScriptInAnyLang
scriptInAnyLang) ->
      case CardanoEra toEra
-> Maybe (ReferenceTxInsScriptsInlineDatumsSupportedInEra toEra)
forall era.
CardanoEra era
-> Maybe (ReferenceTxInsScriptsInlineDatumsSupportedInEra era)
refInsScriptsAndInlineDatsSupportedInEra CardanoEra toEra
toEra of
        Maybe (ReferenceTxInsScriptsInlineDatumsSupportedInEra toEra)
Nothing -> EraCastError -> Either EraCastError (ReferenceScript toEra)
forall a b. a -> Either a b
Left (EraCastError -> Either EraCastError (ReferenceScript toEra))
-> EraCastError -> Either EraCastError (ReferenceScript toEra)
forall a b. (a -> b) -> a -> b
$ ReferenceScript fromEra
-> CardanoEra fromEra -> CardanoEra toEra -> EraCastError
forall fromEra toEra value.
(IsCardanoEra fromEra, IsCardanoEra toEra, Show value) =>
value -> CardanoEra fromEra -> CardanoEra toEra -> EraCastError
EraCastError ReferenceScript fromEra
v (IsCardanoEra fromEra => CardanoEra fromEra
forall era. IsCardanoEra era => CardanoEra era
cardanoEra @fromEra) CardanoEra toEra
toEra
        Just ReferenceTxInsScriptsInlineDatumsSupportedInEra toEra
supportedInEra -> ReferenceScript toEra
-> Either EraCastError (ReferenceScript toEra)
forall a b. b -> Either a b
Right (ReferenceScript toEra
 -> Either EraCastError (ReferenceScript toEra))
-> ReferenceScript toEra
-> Either EraCastError (ReferenceScript toEra)
forall a b. (a -> b) -> a -> b
$ ReferenceTxInsScriptsInlineDatumsSupportedInEra toEra
-> ScriptInAnyLang -> ReferenceScript toEra
forall era.
ReferenceTxInsScriptsInlineDatumsSupportedInEra era
-> ScriptInAnyLang -> ReferenceScript era
ReferenceScript ReferenceTxInsScriptsInlineDatumsSupportedInEra toEra
supportedInEra ScriptInAnyLang
scriptInAnyLang

data ReferenceTxInsScriptsInlineDatumsSupportedInEra era where
    ReferenceTxInsScriptsInlineDatumsInBabbageEra :: ReferenceTxInsScriptsInlineDatumsSupportedInEra BabbageEra

deriving instance Eq (ReferenceTxInsScriptsInlineDatumsSupportedInEra era)
deriving instance Show (ReferenceTxInsScriptsInlineDatumsSupportedInEra era)

refInsScriptsAndInlineDatsSupportedInEra
  :: CardanoEra era -> Maybe (ReferenceTxInsScriptsInlineDatumsSupportedInEra era)
refInsScriptsAndInlineDatsSupportedInEra :: CardanoEra era
-> Maybe (ReferenceTxInsScriptsInlineDatumsSupportedInEra era)
refInsScriptsAndInlineDatsSupportedInEra CardanoEra era
ByronEra   = Maybe (ReferenceTxInsScriptsInlineDatumsSupportedInEra era)
forall a. Maybe a
Nothing
refInsScriptsAndInlineDatsSupportedInEra CardanoEra era
ShelleyEra = Maybe (ReferenceTxInsScriptsInlineDatumsSupportedInEra era)
forall a. Maybe a
Nothing
refInsScriptsAndInlineDatsSupportedInEra CardanoEra era
AllegraEra = Maybe (ReferenceTxInsScriptsInlineDatumsSupportedInEra era)
forall a. Maybe a
Nothing
refInsScriptsAndInlineDatsSupportedInEra CardanoEra era
MaryEra    = Maybe (ReferenceTxInsScriptsInlineDatumsSupportedInEra era)
forall a. Maybe a
Nothing
refInsScriptsAndInlineDatsSupportedInEra CardanoEra era
AlonzoEra  = Maybe (ReferenceTxInsScriptsInlineDatumsSupportedInEra era)
forall a. Maybe a
Nothing
refInsScriptsAndInlineDatsSupportedInEra CardanoEra era
BabbageEra = ReferenceTxInsScriptsInlineDatumsSupportedInEra BabbageEra
-> Maybe
     (ReferenceTxInsScriptsInlineDatumsSupportedInEra BabbageEra)
forall a. a -> Maybe a
Just ReferenceTxInsScriptsInlineDatumsSupportedInEra BabbageEra
ReferenceTxInsScriptsInlineDatumsInBabbageEra

refScriptToShelleyScript
  :: CardanoEra era
  -> ReferenceScript era
  -> StrictMaybe (Ledger.Script (ShelleyLedgerEra era))
refScriptToShelleyScript :: CardanoEra era
-> ReferenceScript era
-> StrictMaybe (Script (ShelleyLedgerEra era))
refScriptToShelleyScript CardanoEra era
era (ReferenceScript ReferenceTxInsScriptsInlineDatumsSupportedInEra era
_ ScriptInAnyLang
s) =
  case CardanoEra era -> ScriptInAnyLang -> Maybe (ScriptInEra era)
forall era.
CardanoEra era -> ScriptInAnyLang -> Maybe (ScriptInEra era)
toScriptInEra CardanoEra era
era ScriptInAnyLang
s of
    Just ScriptInEra era
sInEra -> Script (ShelleyLedgerEra era)
-> StrictMaybe (Script (ShelleyLedgerEra era))
forall a. a -> StrictMaybe a
SJust (Script (ShelleyLedgerEra era)
 -> StrictMaybe (Script (ShelleyLedgerEra era)))
-> Script (ShelleyLedgerEra era)
-> StrictMaybe (Script (ShelleyLedgerEra era))
forall a b. (a -> b) -> a -> b
$ ScriptInEra era -> Script (ShelleyLedgerEra era)
forall era. ScriptInEra era -> Script (ShelleyLedgerEra era)
toShelleyScript ScriptInEra era
sInEra
    Maybe (ScriptInEra era)
Nothing -> StrictMaybe (Script (ShelleyLedgerEra era))
forall a. StrictMaybe a
SNothing
refScriptToShelleyScript CardanoEra era
_ ReferenceScript era
ReferenceScriptNone = StrictMaybe (Script (ShelleyLedgerEra era))
forall a. StrictMaybe a
SNothing

fromShelleyScriptToReferenceScript
  :: ShelleyBasedEra era -> Ledger.Script (ShelleyLedgerEra era) -> ReferenceScript era
fromShelleyScriptToReferenceScript :: ShelleyBasedEra era
-> Script (ShelleyLedgerEra era) -> ReferenceScript era
fromShelleyScriptToReferenceScript ShelleyBasedEra era
sbe Script (ShelleyLedgerEra era)
script =
   ScriptInEra era -> ReferenceScript era
forall era. ScriptInEra era -> ReferenceScript era
scriptInEraToRefScript (ScriptInEra era -> ReferenceScript era)
-> ScriptInEra era -> ReferenceScript era
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> Script (ShelleyLedgerEra era) -> ScriptInEra era
forall era.
ShelleyBasedEra era
-> Script (ShelleyLedgerEra era) -> ScriptInEra era
fromShelleyBasedScript ShelleyBasedEra era
sbe Script (ShelleyLedgerEra era)
script

scriptInEraToRefScript :: ScriptInEra era -> ReferenceScript era
scriptInEraToRefScript :: ScriptInEra era -> ReferenceScript era
scriptInEraToRefScript sIne :: ScriptInEra era
sIne@(ScriptInEra ScriptLanguageInEra lang era
_ Script lang
s) =
  case CardanoEra era
-> Maybe (ReferenceTxInsScriptsInlineDatumsSupportedInEra era)
forall era.
CardanoEra era
-> Maybe (ReferenceTxInsScriptsInlineDatumsSupportedInEra era)
refInsScriptsAndInlineDatsSupportedInEra CardanoEra era
era of
    Maybe (ReferenceTxInsScriptsInlineDatumsSupportedInEra era)
Nothing -> ReferenceScript era
forall era. ReferenceScript era
ReferenceScriptNone
    Just ReferenceTxInsScriptsInlineDatumsSupportedInEra era
supp ->
      -- Any script can be a reference script
      ReferenceTxInsScriptsInlineDatumsSupportedInEra era
-> ScriptInAnyLang -> ReferenceScript era
forall era.
ReferenceTxInsScriptsInlineDatumsSupportedInEra era
-> ScriptInAnyLang -> ReferenceScript era
ReferenceScript ReferenceTxInsScriptsInlineDatumsSupportedInEra era
supp (ScriptInAnyLang -> ReferenceScript era)
-> ScriptInAnyLang -> ReferenceScript era
forall a b. (a -> b) -> a -> b
$ Script lang -> ScriptInAnyLang
forall lang. Script lang -> ScriptInAnyLang
toScriptInAnyLang Script lang
s
 where
  era :: CardanoEra era
era = ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
shelleyBasedToCardanoEra (ShelleyBasedEra era -> CardanoEra era)
-> ShelleyBasedEra era -> CardanoEra era
forall a b. (a -> b) -> a -> b
$ ScriptInEra era -> ShelleyBasedEra era
forall era. ScriptInEra era -> ShelleyBasedEra era
eraOfScriptInEra ScriptInEra era
sIne

-- Helpers

textEnvelopeToScript :: TextEnvelope -> Either TextEnvelopeError ScriptInAnyLang
textEnvelopeToScript :: TextEnvelope -> Either TextEnvelopeError ScriptInAnyLang
textEnvelopeToScript = [FromSomeType HasTextEnvelope ScriptInAnyLang]
-> TextEnvelope -> Either TextEnvelopeError ScriptInAnyLang
forall b.
[FromSomeType HasTextEnvelope b]
-> TextEnvelope -> Either TextEnvelopeError b
deserialiseFromTextEnvelopeAnyOf [FromSomeType HasTextEnvelope ScriptInAnyLang]
textEnvTypes
 where
  textEnvTypes :: [FromSomeType HasTextEnvelope ScriptInAnyLang]
  textEnvTypes :: [FromSomeType HasTextEnvelope ScriptInAnyLang]
textEnvTypes =
    [ AsType (Script SimpleScriptV1)
-> (Script SimpleScriptV1 -> ScriptInAnyLang)
-> FromSomeType HasTextEnvelope ScriptInAnyLang
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType SimpleScriptV1 -> AsType (Script SimpleScriptV1)
forall lang. AsType lang -> AsType (Script lang)
AsScript AsType SimpleScriptV1
AsSimpleScriptV1)
                   (ScriptLanguage SimpleScriptV1
-> Script SimpleScriptV1 -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang (SimpleScriptVersion SimpleScriptV1 -> ScriptLanguage SimpleScriptV1
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
SimpleScriptLanguage SimpleScriptVersion SimpleScriptV1
SimpleScriptV1))
    , AsType (Script SimpleScriptV2)
-> (Script SimpleScriptV2 -> ScriptInAnyLang)
-> FromSomeType HasTextEnvelope ScriptInAnyLang
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType SimpleScriptV2 -> AsType (Script SimpleScriptV2)
forall lang. AsType lang -> AsType (Script lang)
AsScript AsType SimpleScriptV2
AsSimpleScriptV2)
                   (ScriptLanguage SimpleScriptV2
-> Script SimpleScriptV2 -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang (SimpleScriptVersion SimpleScriptV2 -> ScriptLanguage SimpleScriptV2
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
SimpleScriptLanguage SimpleScriptVersion SimpleScriptV2
SimpleScriptV2))
    , AsType (Script PlutusScriptV1)
-> (Script PlutusScriptV1 -> ScriptInAnyLang)
-> FromSomeType HasTextEnvelope ScriptInAnyLang
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType PlutusScriptV1 -> AsType (Script PlutusScriptV1)
forall lang. AsType lang -> AsType (Script lang)
AsScript AsType PlutusScriptV1
AsPlutusScriptV1)
                   (ScriptLanguage PlutusScriptV1
-> Script PlutusScriptV1 -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang (PlutusScriptVersion PlutusScriptV1 -> ScriptLanguage PlutusScriptV1
forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion PlutusScriptV1
PlutusScriptV1))
    , AsType (Script PlutusScriptV2)
-> (Script PlutusScriptV2 -> ScriptInAnyLang)
-> FromSomeType HasTextEnvelope ScriptInAnyLang
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType PlutusScriptV2 -> AsType (Script PlutusScriptV2)
forall lang. AsType lang -> AsType (Script lang)
AsScript AsType PlutusScriptV2
AsPlutusScriptV2)
                   (ScriptLanguage PlutusScriptV2
-> Script PlutusScriptV2 -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang (PlutusScriptVersion PlutusScriptV2 -> ScriptLanguage PlutusScriptV2
forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion PlutusScriptV2
PlutusScriptV2))
    ]