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

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,

    -- * 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,

    -- * The Plutus script language
    PlutusScript(..),
    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,

    -- * 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.Encoding 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 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.Eras
import           Cardano.Api.HasTypeProxy
import           Cardano.Api.Hash
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

{- HLINT ignore "Use section" -}


-- ----------------------------------------------------------------------------
-- 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)
-> (AnyPlutusScriptVersion -> Encoding' Text)
-> ToJSONKeyFunction AnyPlutusScriptVersion
forall a.
(a -> Text) -> (a -> Encoding' Text) -> ToJSONKeyFunction a
Aeson.ToJSONKeyText AnyPlutusScriptVersion -> Text
toText AnyPlutusScriptVersion -> Encoding' Text
forall a. AnyPlutusScriptVersion -> Encoding' a
toAesonEncoding
      where
        toText :: AnyPlutusScriptVersion -> Text
        toText :: AnyPlutusScriptVersion -> Text
toText (AnyPlutusScriptVersion PlutusScriptVersion lang
PlutusScriptV1) = Text
"PlutusScriptV1"
        toText (AnyPlutusScriptVersion PlutusScriptVersion lang
PlutusScriptV2) = Text
"PlutusScriptV2"
        toAesonEncoding :: AnyPlutusScriptVersion -> Encoding' a
toAesonEncoding = Text -> Encoding' a
forall a. Text -> Encoding' a
Aeson.text (Text -> Encoding' a)
-> (AnyPlutusScriptVersion -> Text)
-> AnyPlutusScriptVersion
-> Encoding' a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyPlutusScriptVersion -> Text
toText

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'


-- | 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

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

     PlutusScriptV1InAlonzo  :: ScriptLanguageInEra PlutusScriptV1 AlonzoEra
     PlutusScriptV2InAlonzo  :: ScriptLanguageInEra PlutusScriptV2 AlonzoEra

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

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
AlonzoEra, PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptV2) ->
        ScriptLanguageInEra PlutusScriptV2 AlonzoEra
-> Maybe (ScriptLanguageInEra PlutusScriptV2 AlonzoEra)
forall a. a -> Maybe a
Just ScriptLanguageInEra PlutusScriptV2 AlonzoEra
PlutusScriptV2InAlonzo

      (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
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
PlutusScriptV1InAlonzo  -> PlutusScriptVersion PlutusScriptV1 -> ScriptLanguage PlutusScriptV1
forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion PlutusScriptV1
PlutusScriptV1
      ScriptLanguageInEra lang era
PlutusScriptV2InAlonzo  -> 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
PlutusScriptV2InAlonzo  -> ShelleyBasedEra era
ShelleyBasedEra AlonzoEra
ShelleyBasedEraAlonzo


-- | 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


-- | 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
                         -> SimpleScript        lang
                         -> ScriptWitness witctx era

     PlutusScriptWitness :: ScriptLanguageInEra  lang era
                         -> PlutusScriptVersion  lang
                         -> PlutusScript         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  SimpleScript lang
script)
         (SimpleScriptWitness ScriptLanguageInEra lang era
langInEra' SimpleScriptVersion lang
version' SimpleScript 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
&& SimpleScript lang
script SimpleScript lang -> SimpleScript lang -> Bool
forall a. Eq a => a -> a -> Bool
== SimpleScript lang
SimpleScript lang
script'

    (==) (PlutusScriptWitness ScriptLanguageInEra lang era
langInEra  PlutusScriptVersion lang
version   PlutusScript lang
script
                              ScriptDatum witctx
datum      ScriptRedeemer
redeemer  ExecutionUnits
execUnits)
         (PlutusScriptWitness ScriptLanguageInEra lang era
langInEra' PlutusScriptVersion lang
version'  PlutusScript 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
&& PlutusScript lang
script    PlutusScript lang -> PlutusScript lang -> Bool
forall a. Eq a => a -> a -> Bool
== PlutusScript lang
PlutusScript 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
     NoScriptDatumForMint  ::               ScriptDatum WitCtxMint
     NoScriptDatumForStake ::               ScriptDatum WitCtxStake

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


scriptWitnessScript :: ScriptWitness witctx era -> ScriptInEra era
scriptWitnessScript :: ScriptWitness witctx era -> ScriptInEra era
scriptWitnessScript (SimpleScriptWitness ScriptLanguageInEra lang era
langInEra SimpleScriptVersion lang
version SimpleScript lang
script) =
    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 PlutusScript lang
script ScriptDatum witctx
_ ScriptRedeemer
_ ExecutionUnits
_) =
    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)


-- ----------------------------------------------------------------------------
-- 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 [ Text
"steps"  Text -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Natural
executionSteps
           , Text
"memory" Text -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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 -> Text -> Parser Natural
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"steps"
        Parser (Natural -> ExecutionUnits)
-> Parser Natural -> Parser ExecutionUnits
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Natural
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"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] -> Value
[ScriptHash] -> Encoding
ScriptHash -> Value
ScriptHash -> Encoding
(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 (ADDRHASH StandardCrypto) EraIndependentScript
Hash Blake2b_224 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 (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.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 native 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)

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)

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

toShelleyScript (ScriptInEra ScriptLanguageInEra lang era
langInEra (PlutusScript PlutusScriptVersion lang
PlutusScriptV2
                                         (PlutusScriptSerialised ShortByteString
script))) =
    case ScriptLanguageInEra lang era
langInEra of
      ScriptLanguageInEra lang era
PlutusScriptV2InAlonzo  -> Language -> ShortByteString -> Script (AlonzoEra 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 s ->
          ScriptLanguageInEra PlutusScriptV2 AlonzoEra
-> Script PlutusScriptV2 -> ScriptInEra AlonzoEra
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra PlutusScriptV2 AlonzoEra
PlutusScriptV2InAlonzo (Script PlutusScriptV2 -> ScriptInEra AlonzoEra)
-> Script PlutusScriptV2 -> ScriptInEra AlonzoEra
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 [ Text
"type"    Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"sig"
           , Text
"keyHash" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Hash PaymentKey -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText Hash PaymentKey
pKeyHash
           ]
  toJSON (RequireTimeBefore TimeLocksSupported lang
_ SlotNo
slot) =
    [Pair] -> Value
object [ Text
"type" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"before"
           , Text
"slot" Text -> SlotNo -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SlotNo
slot
           ]
  toJSON (RequireTimeAfter TimeLocksSupported lang
_ SlotNo
slot) =
    [Pair] -> Value
object [ Text
"type" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"after"
           , Text
"slot" Text -> SlotNo -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SlotNo
slot
           ]
  toJSON (RequireAnyOf [SimpleScript lang]
reqScripts) =
    [Pair] -> Value
object [ Text
"type" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"any", Text
"scripts" Text -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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 [ Text
"type" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"all", Text
"scripts" Text -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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 [ Text
"type" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> Value
String Text
"atLeast"
           , Text
"required" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
reqNum
           , Text
"scripts" Text -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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 -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"type"
      case Text
t :: Text of
        Text
"any" -> do Vector Value
vs <- Object
obj Object -> Text -> Parser (Vector Value)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"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 -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"type"
      case Text
t :: Text of
        Text
"all" -> do Vector Value
vs <- Object
obj Object -> Text -> Parser (Vector Value)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"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 -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"type"
      case Text
v :: Text of
        Text
"atLeast" -> do
          Value
r  <- Object
obj Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"required"
          Vector Value
vs <- Object
obj Object -> Text -> Parser (Vector Value)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"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 -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"type"
      case Text
v :: Text of
        Text
"sig" -> do Text
k <- Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"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 -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"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 -> Text -> Parser SlotNo
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"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 -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"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 -> Text -> Parser SlotNo
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"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 Text
txt =
    case AsType (Hash PaymentKey) -> ByteString -> Maybe (Hash PaymentKey)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytesHex (AsType PaymentKey -> AsType (Hash PaymentKey)
forall a. AsType a -> AsType (Hash a)
AsHash AsType PaymentKey
AsPaymentKey) (Text -> ByteString
Text.encodeUtf8 Text
txt) of
      Just Hash PaymentKey
payKeyHash -> Hash PaymentKey -> Parser (Hash PaymentKey)
forall (m :: * -> *) a. Monad m => a -> m a
return Hash PaymentKey
payKeyHash
      Maybe (Hash PaymentKey)
Nothing -> String -> Parser (Hash PaymentKey)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (Hash PaymentKey))
-> String -> Parser (Hash PaymentKey)
forall a b. (a -> b) -> a -> b
$ String
"Error deserialising payment key hash: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
txt