{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

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

module Cardano.Api.Script
  ( -- * Languages
    SimpleScript'
  , PlutusScriptV1
  , PlutusScriptV2
  , PlutusScriptV3
  , ScriptLanguage (..)
  , PlutusScriptVersion (..)
  , AnyScriptLanguage (..)
  , AnyPlutusScriptVersion (..)
  , IsPlutusScriptLanguage (..)
  , IsScriptLanguage (..)

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

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

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

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

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

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

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

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

    -- * Script data
  , ScriptData (..)

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

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

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

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

import           Cardano.Api.Eon.BabbageEraOnwards
import           Cardano.Api.Eon.ShelleyBasedEra
import           Cardano.Api.Eras.Case
import           Cardano.Api.Eras.Core
import           Cardano.Api.Error
import           Cardano.Api.Hash
import           Cardano.Api.HasTypeProxy
import           Cardano.Api.Keys.Shelley
import           Cardano.Api.ScriptData
import           Cardano.Api.SerialiseCBOR
import           Cardano.Api.SerialiseJSON
import           Cardano.Api.SerialiseRaw
import           Cardano.Api.SerialiseTextEnvelope
import           Cardano.Api.SerialiseUsing
import           Cardano.Api.TxIn
import           Cardano.Api.Utils (failEitherWith)

import qualified Cardano.Binary as CBOR
import qualified Cardano.Crypto.Hash.Class as Crypto
import qualified Cardano.Ledger.Allegra.Scripts as Allegra
import qualified Cardano.Ledger.Allegra.Scripts as Timelock
import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo
import qualified Cardano.Ledger.Babbage.Scripts as Babbage
import           Cardano.Ledger.BaseTypes (StrictMaybe (..))
import qualified Cardano.Ledger.Binary as Binary (decCBOR, decodeFullAnnotator)
import qualified Cardano.Ledger.Conway.Scripts as Conway
import           Cardano.Ledger.Core (Era (EraCrypto))
import qualified Cardano.Ledger.Core as Ledger
import qualified Cardano.Ledger.Keys as Shelley
import qualified Cardano.Ledger.Plutus.Language as Plutus
import qualified Cardano.Ledger.Shelley.Scripts as Shelley
import           Cardano.Slotting.Slot (SlotNo)
import           Ouroboros.Consensus.Shelley.Eras (StandardCrypto)
import qualified PlutusLedgerApi.Test.Examples as Plutus

import           Control.Applicative
import           Control.Monad
import           Data.Aeson (Value (..), object, (.:), (.=))
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import qualified Data.ByteString.Lazy as LBS
import           Data.ByteString.Short (ShortByteString)
import qualified Data.ByteString.Short as SBS
import           Data.Either.Combinators (maybeToRight)
import           Data.Functor
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           Data.Vector (Vector)
import           GHC.Exts (IsList (..))
import           Numeric.Natural (Natural)

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

data SimpleScript'

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

-- | The second version of the simple script language. It has all the features
-- of the original simple script language 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'.
--
-- However we opt for a single type level tag 'SimpleScript'' as the second version of
-- of the language introduced in the Allegra era is a superset of the language introduced
-- in the Shelley era.

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

data PlutusScriptV3

instance HasTypeProxy SimpleScript' where
  data AsType SimpleScript' = AsSimpleScript
  proxyToAsType :: Proxy SimpleScript' -> AsType SimpleScript'
proxyToAsType Proxy SimpleScript'
_ = AsType SimpleScript'
AsSimpleScript

instance HasTypeProxy PlutusScriptV1 where
  data AsType PlutusScriptV1 = AsPlutusScriptV1
  proxyToAsType :: Proxy PlutusScriptV1 -> AsType PlutusScriptV1
  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

instance HasTypeProxy PlutusScriptV3 where
  data AsType PlutusScriptV3 = AsPlutusScriptV3
  proxyToAsType :: Proxy PlutusScriptV3 -> AsType PlutusScriptV3
proxyToAsType Proxy PlutusScriptV3
_ = AsType PlutusScriptV3
AsPlutusScriptV3

-- ----------------------------------------------------------------------------
-- Value level representation for script languages
--
data ScriptLanguage lang where
  SimpleScriptLanguage :: ScriptLanguage SimpleScript'
  PlutusScriptLanguage :: PlutusScriptVersion lang -> ScriptLanguage lang

deriving instance (Eq (ScriptLanguage lang))

deriving instance (Show (ScriptLanguage lang))

instance TestEquality ScriptLanguage where
  testEquality :: forall a b. ScriptLanguage a -> ScriptLanguage b -> Maybe (a :~: b)
testEquality ScriptLanguage a
SimpleScriptLanguage ScriptLanguage b
SimpleScriptLanguage = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality
    (PlutusScriptLanguage PlutusScriptVersion a
lang)
    (PlutusScriptLanguage PlutusScriptVersion b
lang') = PlutusScriptVersion a -> PlutusScriptVersion b -> Maybe (a :~: b)
forall a b.
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 PlutusScriptVersion lang where
  PlutusScriptV1 :: PlutusScriptVersion PlutusScriptV1
  PlutusScriptV2 :: PlutusScriptVersion PlutusScriptV2
  PlutusScriptV3 :: PlutusScriptVersion PlutusScriptV3

deriving instance (Eq (PlutusScriptVersion lang))

deriving instance (Show (PlutusScriptVersion lang))

instance TestEquality PlutusScriptVersion where
  testEquality :: forall a b.
PlutusScriptVersion a -> PlutusScriptVersion b -> Maybe (a :~: b)
testEquality PlutusScriptVersion a
PlutusScriptV1 PlutusScriptVersion b
PlutusScriptV1 = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality PlutusScriptVersion a
PlutusScriptV2 PlutusScriptVersion b
PlutusScriptV2 = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
  testEquality PlutusScriptVersion a
PlutusScriptV3 PlutusScriptVersion b
PlutusScriptV3 = (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
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 SimpleScript' -> AnyScriptLanguage
forall lang. ScriptLanguage lang -> AnyScriptLanguage
AnyScriptLanguage ScriptLanguage SimpleScript'
SimpleScriptLanguage
  toEnum Int
1 = 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
2 = 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
3 = ScriptLanguage PlutusScriptV3 -> AnyScriptLanguage
forall lang. ScriptLanguage lang -> AnyScriptLanguage
AnyScriptLanguage (PlutusScriptVersion PlutusScriptV3 -> ScriptLanguage PlutusScriptV3
forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion PlutusScriptV3
PlutusScriptV3)
  toEnum Int
err = [Char] -> AnyScriptLanguage
forall a. HasCallStack => [Char] -> a
error ([Char] -> AnyScriptLanguage) -> [Char] -> AnyScriptLanguage
forall a b. (a -> b) -> a -> b
$ [Char]
"AnyScriptLanguage.toEnum: bad argument: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
err

  fromEnum :: AnyScriptLanguage -> Int
fromEnum (AnyScriptLanguage ScriptLanguage lang
SimpleScriptLanguage) = Int
0
  fromEnum (AnyScriptLanguage (PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptV1)) = Int
1
  fromEnum (AnyScriptLanguage (PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptV2)) = Int
2
  fromEnum (AnyScriptLanguage (PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptV3)) = Int
3

instance Bounded AnyScriptLanguage where
  minBound :: AnyScriptLanguage
minBound = ScriptLanguage SimpleScript' -> AnyScriptLanguage
forall lang. ScriptLanguage lang -> AnyScriptLanguage
AnyScriptLanguage ScriptLanguage SimpleScript'
SimpleScriptLanguage
  maxBound :: AnyScriptLanguage
maxBound = ScriptLanguage PlutusScriptV3 -> AnyScriptLanguage
forall lang. ScriptLanguage lang -> AnyScriptLanguage
AnyScriptLanguage (PlutusScriptVersion PlutusScriptV3 -> ScriptLanguage PlutusScriptV3
forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion PlutusScriptV3
PlutusScriptV3)

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
2 = PlutusScriptVersion PlutusScriptV3 -> AnyPlutusScriptVersion
forall lang. PlutusScriptVersion lang -> AnyPlutusScriptVersion
AnyPlutusScriptVersion PlutusScriptVersion PlutusScriptV3
PlutusScriptV3
  toEnum Int
err = [Char] -> AnyPlutusScriptVersion
forall a. HasCallStack => [Char] -> a
error ([Char] -> AnyPlutusScriptVersion)
-> [Char] -> AnyPlutusScriptVersion
forall a b. (a -> b) -> a -> b
$ [Char]
"AnyPlutusScriptVersion.toEnum: bad argument: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
err

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

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

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 :: forall s. Decoder s AnyPlutusScriptVersion
fromCBOR = do
    Int
n <- Decoder s Int
forall s. 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 a. a -> Decoder s a
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 [Char] -> Decoder s AnyPlutusScriptVersion
forall a. [Char] -> Decoder s a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"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"
  toJSON (AnyPlutusScriptVersion PlutusScriptVersion lang
PlutusScriptV3) =
    Text -> Value
Aeson.String Text
"PlutusScriptV3"

parsePlutusScriptVersion :: Text -> Aeson.Parser AnyPlutusScriptVersion
parsePlutusScriptVersion :: Text -> Parser AnyPlutusScriptVersion
parsePlutusScriptVersion Text
t =
  case Text
t of
    Text
"PlutusScriptV1" -> AnyPlutusScriptVersion -> Parser AnyPlutusScriptVersion
forall a. a -> Parser a
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 a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (PlutusScriptVersion PlutusScriptV2 -> AnyPlutusScriptVersion
forall lang. PlutusScriptVersion lang -> AnyPlutusScriptVersion
AnyPlutusScriptVersion PlutusScriptVersion PlutusScriptV2
PlutusScriptV2)
    Text
"PlutusScriptV3" -> AnyPlutusScriptVersion -> Parser AnyPlutusScriptVersion
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (PlutusScriptVersion PlutusScriptV3 -> AnyPlutusScriptVersion
forall lang. PlutusScriptVersion lang -> AnyPlutusScriptVersion
AnyPlutusScriptVersion PlutusScriptVersion PlutusScriptV3
PlutusScriptV3)
    Text
_ -> [Char] -> Parser AnyPlutusScriptVersion
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Expected PlutusScriptVX, for X = 1, 2, or 3"

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

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

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

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

fromAlonzoLanguage :: Plutus.Language -> AnyPlutusScriptVersion
fromAlonzoLanguage :: Language -> AnyPlutusScriptVersion
fromAlonzoLanguage Language
Plutus.PlutusV1 = PlutusScriptVersion PlutusScriptV1 -> AnyPlutusScriptVersion
forall lang. PlutusScriptVersion lang -> AnyPlutusScriptVersion
AnyPlutusScriptVersion PlutusScriptVersion PlutusScriptV1
PlutusScriptV1
fromAlonzoLanguage Language
Plutus.PlutusV2 = PlutusScriptVersion PlutusScriptV2 -> AnyPlutusScriptVersion
forall lang. PlutusScriptVersion lang -> AnyPlutusScriptVersion
AnyPlutusScriptVersion PlutusScriptVersion PlutusScriptV2
PlutusScriptV2
fromAlonzoLanguage Language
Plutus.PlutusV3 = PlutusScriptVersion PlutusScriptV3 -> AnyPlutusScriptVersion
forall lang. PlutusScriptVersion lang -> AnyPlutusScriptVersion
AnyPlutusScriptVersion PlutusScriptVersion PlutusScriptV3
PlutusScriptV3

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

instance IsScriptLanguage SimpleScript' where
  scriptLanguage :: ScriptLanguage SimpleScript'
scriptLanguage = ScriptLanguage SimpleScript'
SimpleScriptLanguage

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

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

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

instance IsPlutusScriptLanguage PlutusScriptV3 where
  plutusScriptVersion :: PlutusScriptVersion PlutusScriptV3
plutusScriptVersion = PlutusScriptVersion PlutusScriptV3
PlutusScriptV3

-- ----------------------------------------------------------------------------
-- 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
    :: !SimpleScript
    -> Script SimpleScript'
  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 SimpleScript
s) =
    Timelock StandardAllegra -> ByteString
forall a. ToCBOR a => a -> ByteString
CBOR.serialize' (SimpleScript -> NativeScript StandardAllegra
forall era.
(AllegraEraScript era, EraCrypto era ~ StandardCrypto,
 NativeScript era ~ Timelock era) =>
SimpleScript -> NativeScript era
toAllegraTimelock SimpleScript
s :: Timelock.Timelock (ShelleyLedgerEra AllegraEra))
  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
  serialiseToCBOR (PlutusScript PlutusScriptVersion lang
PlutusScriptV3 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
      ScriptLanguage lang
SimpleScriptLanguage ->
        let version :: Version
version = forall era. Era era => Version
Ledger.eraProtVerLow @(ShelleyLedgerEra AllegraEra)
         in SimpleScript -> Script lang
SimpleScript -> Script SimpleScript'
SimpleScript (SimpleScript -> Script lang)
-> (Timelock StandardAllegra -> SimpleScript)
-> Timelock StandardAllegra
-> Script lang
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(AllegraEraScript era, EraCrypto era ~ StandardCrypto) =>
NativeScript era -> SimpleScript
fromAllegraTimelock @(ShelleyLedgerEra AllegraEra)
              (Timelock StandardAllegra -> Script lang)
-> Either DecoderError (Timelock StandardAllegra)
-> Either DecoderError (Script lang)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version
-> Text
-> (forall s. Decoder s (Annotator (Timelock StandardAllegra)))
-> ByteString
-> Either DecoderError (Timelock StandardAllegra)
forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
Binary.decodeFullAnnotator Version
version Text
"Script" Decoder s (Annotator (Timelock StandardAllegra))
forall s. Decoder s (Annotator (Timelock StandardAllegra))
forall a s. DecCBOR a => Decoder s a
Binary.decCBOR (ByteString -> ByteString
LBS.fromStrict ByteString
bs)
      PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptV1 ->
        PlutusScriptVersion lang -> PlutusScript lang -> Script lang
forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
PlutusScript PlutusScriptVersion lang
PlutusScriptVersion PlutusScriptV1
PlutusScriptV1
          (PlutusScript lang -> Script lang)
-> Either DecoderError (PlutusScript lang)
-> Either DecoderError (Script lang)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either DecoderError (PlutusScript lang)
forall a. FromCBOR a => ByteString -> Either DecoderError a
CBOR.decodeFull' ByteString
bs
      PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptV2 ->
        PlutusScriptVersion lang -> PlutusScript lang -> Script lang
forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
PlutusScript PlutusScriptVersion lang
PlutusScriptVersion PlutusScriptV2
PlutusScriptV2
          (PlutusScript lang -> Script lang)
-> Either DecoderError (PlutusScript lang)
-> Either DecoderError (Script lang)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either DecoderError (PlutusScript lang)
forall a. FromCBOR a => ByteString -> Either DecoderError a
CBOR.decodeFull' ByteString
bs
      PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptV3 ->
        PlutusScriptVersion lang -> PlutusScript lang -> Script lang
forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
PlutusScript PlutusScriptVersion lang
PlutusScriptVersion PlutusScriptV3
PlutusScriptV3
          (PlutusScript lang -> Script lang)
-> Either DecoderError (PlutusScript lang)
-> Either DecoderError (Script lang)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either DecoderError (PlutusScript lang)
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
      ScriptLanguage lang
SimpleScriptLanguage -> TextEnvelopeType
"SimpleScript"
      PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptV1 -> TextEnvelopeType
"PlutusScriptV1"
      PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptV2 -> TextEnvelopeType
"PlutusScriptV2"
      PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptV3 -> TextEnvelopeType
"PlutusScriptV3"

-- ----------------------------------------------------------------------------
-- 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 a b. ScriptLanguage a -> ScriptLanguage b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality ScriptLanguage lang
lang ScriptLanguage lang
lang' of
        Maybe (lang :~: lang)
Nothing -> Bool
False
        Just lang :~: lang
Refl -> Script lang
script Script lang -> Script lang -> Bool
forall a. Eq a => a -> a -> Bool
== Script lang
Script lang
script'

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

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

-- | Convert a script in a specific statically-known language to a
-- 'ScriptInAnyLang'.
--
-- No inverse to this is provided, just do case analysis on the 'ScriptLanguage'
-- field within the 'ScriptInAnyLang' constructor.
toScriptInAnyLang :: Script lang -> ScriptInAnyLang
toScriptInAnyLang :: forall lang. Script lang -> ScriptInAnyLang
toScriptInAnyLang s :: Script lang
s@(SimpleScript SimpleScript
_) =
  ScriptLanguage SimpleScript'
-> Script SimpleScript' -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang ScriptLanguage SimpleScript'
SimpleScriptLanguage Script lang
Script SimpleScript'
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 a b. ScriptLanguage a -> ScriptLanguage b -> Maybe (a :~: b)
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
  SimpleScriptInShelley :: ScriptLanguageInEra SimpleScript' ShelleyEra
  SimpleScriptInAllegra :: ScriptLanguageInEra SimpleScript' AllegraEra
  SimpleScriptInMary :: ScriptLanguageInEra SimpleScript' MaryEra
  SimpleScriptInAlonzo :: ScriptLanguageInEra SimpleScript' AlonzoEra
  SimpleScriptInBabbage :: ScriptLanguageInEra SimpleScript' BabbageEra
  SimpleScriptInConway :: ScriptLanguageInEra SimpleScript' ConwayEra
  PlutusScriptV1InAlonzo :: ScriptLanguageInEra PlutusScriptV1 AlonzoEra
  PlutusScriptV1InBabbage :: ScriptLanguageInEra PlutusScriptV1 BabbageEra
  PlutusScriptV1InConway :: ScriptLanguageInEra PlutusScriptV1 ConwayEra
  PlutusScriptV2InBabbage :: ScriptLanguageInEra PlutusScriptV2 BabbageEra
  PlutusScriptV2InConway :: ScriptLanguageInEra PlutusScriptV2 ConwayEra
  PlutusScriptV3InConway :: ScriptLanguageInEra PlutusScriptV3 ConwayEra

deriving instance Eq (ScriptLanguageInEra lang era)

deriving instance Show (ScriptLanguageInEra lang era)

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

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

-- | Check if a given script language is supported in a given era, and if so
-- return the evidence.
scriptLanguageSupportedInEra
  :: ShelleyBasedEra era
  -> ScriptLanguage lang
  -> Maybe (ScriptLanguageInEra lang era)
scriptLanguageSupportedInEra :: forall era lang.
ShelleyBasedEra era
-> ScriptLanguage lang -> Maybe (ScriptLanguageInEra lang era)
scriptLanguageSupportedInEra ShelleyBasedEra era
era ScriptLanguage lang
lang =
  case (ShelleyBasedEra era
era, ScriptLanguage lang
lang) of
    (ShelleyBasedEra era
ShelleyBasedEraShelley, ScriptLanguage lang
SimpleScriptLanguage) ->
      ScriptLanguageInEra lang era
-> Maybe (ScriptLanguageInEra lang era)
forall a. a -> Maybe a
Just ScriptLanguageInEra lang era
ScriptLanguageInEra SimpleScript' ShelleyEra
SimpleScriptInShelley
    (ShelleyBasedEra era
ShelleyBasedEraAllegra, ScriptLanguage lang
SimpleScriptLanguage) ->
      ScriptLanguageInEra lang era
-> Maybe (ScriptLanguageInEra lang era)
forall a. a -> Maybe a
Just ScriptLanguageInEra lang era
ScriptLanguageInEra SimpleScript' AllegraEra
SimpleScriptInAllegra
    (ShelleyBasedEra era
ShelleyBasedEraMary, ScriptLanguage lang
SimpleScriptLanguage) ->
      ScriptLanguageInEra lang era
-> Maybe (ScriptLanguageInEra lang era)
forall a. a -> Maybe a
Just ScriptLanguageInEra lang era
ScriptLanguageInEra SimpleScript' MaryEra
SimpleScriptInMary
    (ShelleyBasedEra era
ShelleyBasedEraAlonzo, ScriptLanguage lang
SimpleScriptLanguage) ->
      ScriptLanguageInEra lang era
-> Maybe (ScriptLanguageInEra lang era)
forall a. a -> Maybe a
Just ScriptLanguageInEra lang era
ScriptLanguageInEra SimpleScript' AlonzoEra
SimpleScriptInAlonzo
    (ShelleyBasedEra era
ShelleyBasedEraBabbage, ScriptLanguage lang
SimpleScriptLanguage) ->
      ScriptLanguageInEra lang era
-> Maybe (ScriptLanguageInEra lang era)
forall a. a -> Maybe a
Just ScriptLanguageInEra lang era
ScriptLanguageInEra SimpleScript' BabbageEra
SimpleScriptInBabbage
    (ShelleyBasedEra era
ShelleyBasedEraConway, ScriptLanguage lang
SimpleScriptLanguage) ->
      ScriptLanguageInEra lang era
-> Maybe (ScriptLanguageInEra lang era)
forall a. a -> Maybe a
Just ScriptLanguageInEra lang era
ScriptLanguageInEra SimpleScript' ConwayEra
SimpleScriptInConway
    (ShelleyBasedEra era
ShelleyBasedEraAlonzo, PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptV1) ->
      ScriptLanguageInEra lang era
-> Maybe (ScriptLanguageInEra lang era)
forall a. a -> Maybe a
Just ScriptLanguageInEra lang era
ScriptLanguageInEra PlutusScriptV1 AlonzoEra
PlutusScriptV1InAlonzo
    (ShelleyBasedEra era
ShelleyBasedEraBabbage, PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptV1) ->
      ScriptLanguageInEra lang era
-> Maybe (ScriptLanguageInEra lang era)
forall a. a -> Maybe a
Just ScriptLanguageInEra lang era
ScriptLanguageInEra PlutusScriptV1 BabbageEra
PlutusScriptV1InBabbage
    (ShelleyBasedEra era
ShelleyBasedEraBabbage, PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptV2) ->
      ScriptLanguageInEra lang era
-> Maybe (ScriptLanguageInEra lang era)
forall a. a -> Maybe a
Just ScriptLanguageInEra lang era
ScriptLanguageInEra PlutusScriptV2 BabbageEra
PlutusScriptV2InBabbage
    (ShelleyBasedEra era
ShelleyBasedEraConway, PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptV1) ->
      ScriptLanguageInEra lang era
-> Maybe (ScriptLanguageInEra lang era)
forall a. a -> Maybe a
Just ScriptLanguageInEra lang era
ScriptLanguageInEra PlutusScriptV1 ConwayEra
PlutusScriptV1InConway
    (ShelleyBasedEra era
ShelleyBasedEraConway, PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptV2) ->
      ScriptLanguageInEra lang era
-> Maybe (ScriptLanguageInEra lang era)
forall a. a -> Maybe a
Just ScriptLanguageInEra lang era
ScriptLanguageInEra PlutusScriptV2 ConwayEra
PlutusScriptV2InConway
    (ShelleyBasedEra era
ShelleyBasedEraConway, PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptV3) ->
      ScriptLanguageInEra lang era
-> Maybe (ScriptLanguageInEra lang era)
forall a. a -> Maybe a
Just ScriptLanguageInEra lang era
ScriptLanguageInEra PlutusScriptV3 ConwayEra
PlutusScriptV3InConway
    (ShelleyBasedEra era, ScriptLanguage lang)
_ -> Maybe (ScriptLanguageInEra lang era)
forall a. Maybe a
Nothing

languageOfScriptLanguageInEra
  :: ScriptLanguageInEra lang era
  -> ScriptLanguage lang
languageOfScriptLanguageInEra :: forall lang era.
ScriptLanguageInEra lang era -> ScriptLanguage lang
languageOfScriptLanguageInEra ScriptLanguageInEra lang era
langInEra =
  case ScriptLanguageInEra lang era
langInEra of
    ScriptLanguageInEra lang era
SimpleScriptInShelley -> ScriptLanguage lang
ScriptLanguage SimpleScript'
SimpleScriptLanguage
    ScriptLanguageInEra lang era
SimpleScriptInAllegra -> ScriptLanguage lang
ScriptLanguage SimpleScript'
SimpleScriptLanguage
    ScriptLanguageInEra lang era
SimpleScriptInMary -> ScriptLanguage lang
ScriptLanguage SimpleScript'
SimpleScriptLanguage
    ScriptLanguageInEra lang era
SimpleScriptInAlonzo -> ScriptLanguage lang
ScriptLanguage SimpleScript'
SimpleScriptLanguage
    ScriptLanguageInEra lang era
SimpleScriptInBabbage -> ScriptLanguage lang
ScriptLanguage SimpleScript'
SimpleScriptLanguage
    ScriptLanguageInEra lang era
SimpleScriptInConway -> ScriptLanguage lang
ScriptLanguage SimpleScript'
SimpleScriptLanguage
    ScriptLanguageInEra lang era
PlutusScriptV1InAlonzo -> PlutusScriptVersion lang -> ScriptLanguage lang
forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptVersion PlutusScriptV1
PlutusScriptV1
    ScriptLanguageInEra lang era
PlutusScriptV1InBabbage -> PlutusScriptVersion lang -> ScriptLanguage lang
forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptVersion PlutusScriptV1
PlutusScriptV1
    ScriptLanguageInEra lang era
PlutusScriptV1InConway -> PlutusScriptVersion lang -> ScriptLanguage lang
forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptVersion PlutusScriptV1
PlutusScriptV1
    ScriptLanguageInEra lang era
PlutusScriptV2InBabbage -> PlutusScriptVersion lang -> ScriptLanguage lang
forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptVersion PlutusScriptV2
PlutusScriptV2
    ScriptLanguageInEra lang era
PlutusScriptV2InConway -> PlutusScriptVersion lang -> ScriptLanguage lang
forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptVersion PlutusScriptV2
PlutusScriptV2
    ScriptLanguageInEra lang era
PlutusScriptV3InConway -> PlutusScriptVersion lang -> ScriptLanguage lang
forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptVersion PlutusScriptV3
PlutusScriptV3

eraOfScriptLanguageInEra
  :: ScriptLanguageInEra lang era
  -> ShelleyBasedEra era
eraOfScriptLanguageInEra :: forall lang era.
ScriptLanguageInEra lang era -> ShelleyBasedEra era
eraOfScriptLanguageInEra ScriptLanguageInEra lang era
langInEra =
  case ScriptLanguageInEra lang era
langInEra of
    ScriptLanguageInEra lang era
SimpleScriptInShelley -> ShelleyBasedEra era
ShelleyBasedEra ShelleyEra
ShelleyBasedEraShelley
    ScriptLanguageInEra lang era
SimpleScriptInAllegra -> ShelleyBasedEra era
ShelleyBasedEra AllegraEra
ShelleyBasedEraAllegra
    ScriptLanguageInEra lang era
SimpleScriptInMary -> ShelleyBasedEra era
ShelleyBasedEra MaryEra
ShelleyBasedEraMary
    ScriptLanguageInEra lang era
SimpleScriptInAlonzo -> ShelleyBasedEra era
ShelleyBasedEra AlonzoEra
ShelleyBasedEraAlonzo
    ScriptLanguageInEra lang era
SimpleScriptInBabbage -> ShelleyBasedEra era
ShelleyBasedEra BabbageEra
ShelleyBasedEraBabbage
    ScriptLanguageInEra lang era
SimpleScriptInConway -> ShelleyBasedEra era
ShelleyBasedEra ConwayEra
ShelleyBasedEraConway
    ScriptLanguageInEra lang era
PlutusScriptV1InAlonzo -> ShelleyBasedEra era
ShelleyBasedEra AlonzoEra
ShelleyBasedEraAlonzo
    ScriptLanguageInEra lang era
PlutusScriptV1InBabbage -> ShelleyBasedEra era
ShelleyBasedEra BabbageEra
ShelleyBasedEraBabbage
    ScriptLanguageInEra lang era
PlutusScriptV1InConway -> ShelleyBasedEra era
ShelleyBasedEra ConwayEra
ShelleyBasedEraConway
    ScriptLanguageInEra lang era
PlutusScriptV2InBabbage -> ShelleyBasedEra era
ShelleyBasedEra BabbageEra
ShelleyBasedEraBabbage
    ScriptLanguageInEra lang era
PlutusScriptV2InConway -> ShelleyBasedEra era
ShelleyBasedEra ConwayEra
ShelleyBasedEraConway
    ScriptLanguageInEra lang era
PlutusScriptV3InConway -> ShelleyBasedEra era
ShelleyBasedEra ConwayEra
ShelleyBasedEraConway

-- | 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 :: ShelleyBasedEra era -> ScriptInAnyLang -> Maybe (ScriptInEra era)
toScriptInEra :: forall era.
ShelleyBasedEra era -> ScriptInAnyLang -> Maybe (ScriptInEra era)
toScriptInEra ShelleyBasedEra era
era (ScriptInAnyLang ScriptLanguage lang
lang Script lang
s) = do
  ScriptLanguageInEra lang era
lang' <- ShelleyBasedEra era
-> ScriptLanguage lang -> Maybe (ScriptLanguageInEra lang era)
forall era lang.
ShelleyBasedEra era
-> ScriptLanguage lang -> Maybe (ScriptLanguageInEra lang era)
scriptLanguageSupportedInEra ShelleyBasedEra era
era ScriptLanguage lang
lang
  ScriptInEra era -> Maybe (ScriptInEra era)
forall a. a -> Maybe a
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 :: forall era. 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
-- certificates, withdrawals, voting and proposals.
data WitCtxStake

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

-- | Scripts can now exist in the UTxO at a transaction output. We can
-- reference these scripts via specification of a reference transaction input
-- in order to witness spending inputs, withdrawals, certificates
-- or to mint tokens. This datatype encapsulates this concept.
data PlutusScriptOrReferenceInput lang
  = PScript (PlutusScript lang)
  | -- | Needed to construct the redeemer pointer map
    -- in the case of minting reference scripts where we don't
    -- have direct access to the script
    PReferenceScript
      TxIn
      (Maybe ScriptHash)
  deriving (PlutusScriptOrReferenceInput lang
-> PlutusScriptOrReferenceInput lang -> Bool
(PlutusScriptOrReferenceInput lang
 -> PlutusScriptOrReferenceInput lang -> Bool)
-> (PlutusScriptOrReferenceInput lang
    -> PlutusScriptOrReferenceInput lang -> Bool)
-> Eq (PlutusScriptOrReferenceInput lang)
forall lang.
PlutusScriptOrReferenceInput lang
-> PlutusScriptOrReferenceInput lang -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall lang.
PlutusScriptOrReferenceInput lang
-> PlutusScriptOrReferenceInput lang -> Bool
== :: PlutusScriptOrReferenceInput lang
-> PlutusScriptOrReferenceInput lang -> Bool
$c/= :: forall lang.
PlutusScriptOrReferenceInput lang
-> PlutusScriptOrReferenceInput lang -> Bool
/= :: PlutusScriptOrReferenceInput lang
-> PlutusScriptOrReferenceInput lang -> Bool
Eq, Int -> PlutusScriptOrReferenceInput lang -> ShowS
[PlutusScriptOrReferenceInput lang] -> ShowS
PlutusScriptOrReferenceInput lang -> [Char]
(Int -> PlutusScriptOrReferenceInput lang -> ShowS)
-> (PlutusScriptOrReferenceInput lang -> [Char])
-> ([PlutusScriptOrReferenceInput lang] -> ShowS)
-> Show (PlutusScriptOrReferenceInput lang)
forall lang. Int -> PlutusScriptOrReferenceInput lang -> ShowS
forall lang. [PlutusScriptOrReferenceInput lang] -> ShowS
forall lang. PlutusScriptOrReferenceInput lang -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall lang. Int -> PlutusScriptOrReferenceInput lang -> ShowS
showsPrec :: Int -> PlutusScriptOrReferenceInput lang -> ShowS
$cshow :: forall lang. PlutusScriptOrReferenceInput lang -> [Char]
show :: PlutusScriptOrReferenceInput lang -> [Char]
$cshowList :: forall lang. [PlutusScriptOrReferenceInput lang] -> ShowS
showList :: [PlutusScriptOrReferenceInput lang] -> ShowS
Show)

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

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

deriving instance Show (ScriptWitness witctx era)

-- The GADT in the SimpleScriptWitness constructor requires a custom instance
instance Eq (ScriptWitness witctx era) where
  == :: ScriptWitness witctx era -> ScriptWitness witctx era -> Bool
(==)
    (SimpleScriptWitness ScriptLanguageInEra SimpleScript' era
langInEra SimpleScriptOrReferenceInput SimpleScript'
script)
    (SimpleScriptWitness ScriptLanguageInEra SimpleScript' era
langInEra' SimpleScriptOrReferenceInput SimpleScript'
script') =
      case ScriptLanguage SimpleScript'
-> ScriptLanguage SimpleScript'
-> Maybe (SimpleScript' :~: SimpleScript')
forall a b. ScriptLanguage a -> ScriptLanguage b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality
        (ScriptLanguageInEra SimpleScript' era
-> ScriptLanguage SimpleScript'
forall lang era.
ScriptLanguageInEra lang era -> ScriptLanguage lang
languageOfScriptLanguageInEra ScriptLanguageInEra SimpleScript' era
langInEra)
        (ScriptLanguageInEra SimpleScript' era
-> ScriptLanguage SimpleScript'
forall lang era.
ScriptLanguageInEra lang era -> ScriptLanguage lang
languageOfScriptLanguageInEra ScriptLanguageInEra SimpleScript' era
langInEra') of
        Maybe (SimpleScript' :~: SimpleScript')
Nothing -> Bool
False
        Just SimpleScript' :~: SimpleScript'
Refl -> SimpleScriptOrReferenceInput SimpleScript'
script SimpleScriptOrReferenceInput SimpleScript'
-> SimpleScriptOrReferenceInput SimpleScript' -> Bool
forall a. Eq a => a -> a -> Bool
== SimpleScriptOrReferenceInput SimpleScript'
script'
  (==)
    ( PlutusScriptWitness
        ScriptLanguageInEra lang era
langInEra
        PlutusScriptVersion lang
version
        PlutusScriptOrReferenceInput lang
script
        ScriptDatum witctx
datum
        HashableScriptData
redeemer
        ExecutionUnits
execUnits
      )
    ( PlutusScriptWitness
        ScriptLanguageInEra lang era
langInEra'
        PlutusScriptVersion lang
version'
        PlutusScriptOrReferenceInput lang
script'
        ScriptDatum witctx
datum'
        HashableScriptData
redeemer'
        ExecutionUnits
execUnits'
      ) =
      case ScriptLanguage lang -> ScriptLanguage lang -> Maybe (lang :~: lang)
forall a b. ScriptLanguage a -> ScriptLanguage b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality
        (ScriptLanguageInEra lang era -> ScriptLanguage lang
forall lang era.
ScriptLanguageInEra lang era -> ScriptLanguage lang
languageOfScriptLanguageInEra ScriptLanguageInEra lang era
langInEra)
        (ScriptLanguageInEra lang era -> ScriptLanguage lang
forall lang era.
ScriptLanguageInEra lang era -> ScriptLanguage lang
languageOfScriptLanguageInEra ScriptLanguageInEra lang era
langInEra') of
        Maybe (lang :~: lang)
Nothing -> Bool
False
        Just lang :~: lang
Refl ->
          PlutusScriptVersion lang
version PlutusScriptVersion lang -> PlutusScriptVersion lang -> Bool
forall a. Eq a => a -> a -> Bool
== PlutusScriptVersion lang
PlutusScriptVersion lang
version'
            Bool -> Bool -> Bool
&& PlutusScriptOrReferenceInput lang
script PlutusScriptOrReferenceInput lang
-> PlutusScriptOrReferenceInput lang -> Bool
forall a. Eq a => a -> a -> Bool
== PlutusScriptOrReferenceInput lang
PlutusScriptOrReferenceInput lang
script'
            Bool -> Bool -> Bool
&& ScriptDatum witctx
datum ScriptDatum witctx -> ScriptDatum witctx -> Bool
forall a. Eq a => a -> a -> Bool
== ScriptDatum witctx
datum'
            Bool -> Bool -> Bool
&& HashableScriptData
redeemer HashableScriptData -> HashableScriptData -> Bool
forall a. Eq a => a -> a -> Bool
== HashableScriptData
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 = HashableScriptData

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

deriving instance Eq (ScriptDatum witctx)

deriving instance Show (ScriptDatum witctx)

-- We cannot always extract a script from a script witness due to reference scripts.
-- Reference scripts exist in the UTxO, so without access to the UTxO we cannot
-- retrieve the script.
scriptWitnessScript :: ScriptWitness witctx era -> Maybe (ScriptInEra era)
scriptWitnessScript :: forall witctx era.
ScriptWitness witctx era -> Maybe (ScriptInEra era)
scriptWitnessScript (SimpleScriptWitness ScriptLanguageInEra SimpleScript' era
SimpleScriptInShelley (SScript SimpleScript
script)) =
  ScriptInEra era -> Maybe (ScriptInEra era)
forall a. a -> Maybe a
Just (ScriptInEra era -> Maybe (ScriptInEra era))
-> ScriptInEra era -> Maybe (ScriptInEra era)
forall a b. (a -> b) -> a -> b
$ ScriptLanguageInEra SimpleScript' era
-> Script SimpleScript' -> ScriptInEra era
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScript' era
ScriptLanguageInEra SimpleScript' ShelleyEra
SimpleScriptInShelley (SimpleScript -> Script SimpleScript'
SimpleScript SimpleScript
script)
scriptWitnessScript (SimpleScriptWitness ScriptLanguageInEra SimpleScript' era
SimpleScriptInAllegra (SScript SimpleScript
script)) =
  ScriptInEra era -> Maybe (ScriptInEra era)
forall a. a -> Maybe a
Just (ScriptInEra era -> Maybe (ScriptInEra era))
-> ScriptInEra era -> Maybe (ScriptInEra era)
forall a b. (a -> b) -> a -> b
$ ScriptLanguageInEra SimpleScript' era
-> Script SimpleScript' -> ScriptInEra era
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScript' era
ScriptLanguageInEra SimpleScript' AllegraEra
SimpleScriptInAllegra (SimpleScript -> Script SimpleScript'
SimpleScript SimpleScript
script)
scriptWitnessScript (SimpleScriptWitness ScriptLanguageInEra SimpleScript' era
SimpleScriptInMary (SScript SimpleScript
script)) =
  ScriptInEra era -> Maybe (ScriptInEra era)
forall a. a -> Maybe a
Just (ScriptInEra era -> Maybe (ScriptInEra era))
-> ScriptInEra era -> Maybe (ScriptInEra era)
forall a b. (a -> b) -> a -> b
$ ScriptLanguageInEra SimpleScript' era
-> Script SimpleScript' -> ScriptInEra era
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScript' era
ScriptLanguageInEra SimpleScript' MaryEra
SimpleScriptInMary (SimpleScript -> Script SimpleScript'
SimpleScript SimpleScript
script)
scriptWitnessScript (SimpleScriptWitness ScriptLanguageInEra SimpleScript' era
SimpleScriptInAlonzo (SScript SimpleScript
script)) =
  ScriptInEra era -> Maybe (ScriptInEra era)
forall a. a -> Maybe a
Just (ScriptInEra era -> Maybe (ScriptInEra era))
-> ScriptInEra era -> Maybe (ScriptInEra era)
forall a b. (a -> b) -> a -> b
$ ScriptLanguageInEra SimpleScript' era
-> Script SimpleScript' -> ScriptInEra era
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScript' era
ScriptLanguageInEra SimpleScript' AlonzoEra
SimpleScriptInAlonzo (SimpleScript -> Script SimpleScript'
SimpleScript SimpleScript
script)
scriptWitnessScript (SimpleScriptWitness ScriptLanguageInEra SimpleScript' era
SimpleScriptInBabbage (SScript SimpleScript
script)) =
  ScriptInEra era -> Maybe (ScriptInEra era)
forall a. a -> Maybe a
Just (ScriptInEra era -> Maybe (ScriptInEra era))
-> ScriptInEra era -> Maybe (ScriptInEra era)
forall a b. (a -> b) -> a -> b
$ ScriptLanguageInEra SimpleScript' era
-> Script SimpleScript' -> ScriptInEra era
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScript' era
ScriptLanguageInEra SimpleScript' BabbageEra
SimpleScriptInBabbage (SimpleScript -> Script SimpleScript'
SimpleScript SimpleScript
script)
scriptWitnessScript (SimpleScriptWitness ScriptLanguageInEra SimpleScript' era
SimpleScriptInConway (SScript SimpleScript
script)) =
  ScriptInEra era -> Maybe (ScriptInEra era)
forall a. a -> Maybe a
Just (ScriptInEra era -> Maybe (ScriptInEra era))
-> ScriptInEra era -> Maybe (ScriptInEra era)
forall a b. (a -> b) -> a -> b
$ ScriptLanguageInEra SimpleScript' era
-> Script SimpleScript' -> ScriptInEra era
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScript' era
ScriptLanguageInEra SimpleScript' ConwayEra
SimpleScriptInConway (SimpleScript -> Script SimpleScript'
SimpleScript SimpleScript
script)
scriptWitnessScript (PlutusScriptWitness ScriptLanguageInEra lang era
langInEra PlutusScriptVersion lang
version (PScript PlutusScript lang
script) ScriptDatum witctx
_ HashableScriptData
_ ExecutionUnits
_) =
  ScriptInEra era -> Maybe (ScriptInEra era)
forall a. a -> Maybe a
Just (ScriptInEra era -> Maybe (ScriptInEra era))
-> ScriptInEra era -> Maybe (ScriptInEra era)
forall a b. (a -> b) -> a -> b
$ ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra lang era
langInEra (PlutusScriptVersion lang -> PlutusScript lang -> Script lang
forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
PlutusScript PlutusScriptVersion lang
version PlutusScript lang
script)
scriptWitnessScript (SimpleScriptWitness ScriptLanguageInEra SimpleScript' era
_ (SReferenceScript TxIn
_ Maybe ScriptHash
_)) =
  Maybe (ScriptInEra era)
forall a. Maybe a
Nothing
scriptWitnessScript (PlutusScriptWitness ScriptLanguageInEra lang era
_ PlutusScriptVersion lang
_ (PReferenceScript TxIn
_ Maybe ScriptHash
_) ScriptDatum witctx
_ HashableScriptData
_ ExecutionUnits
_) =
  Maybe (ScriptInEra era)
forall a. Maybe a
Nothing

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

data Witness witctx era where
  KeyWitness
    :: KeyWitnessInCtx witctx
    -> Witness witctx era
  ScriptWitness
    :: ScriptWitnessInCtx witctx
    -> ScriptWitness witctx era
    -> Witness witctx era

deriving instance Eq (Witness witctx era)

deriving instance Show (Witness witctx era)

data KeyWitnessInCtx witctx where
  KeyWitnessForSpending :: KeyWitnessInCtx WitCtxTxIn
  KeyWitnessForStakeAddr :: KeyWitnessInCtx WitCtxStake

data ScriptWitnessInCtx witctx where
  ScriptWitnessForSpending :: ScriptWitnessInCtx WitCtxTxIn
  ScriptWitnessForMinting :: ScriptWitnessInCtx WitCtxMint
  ScriptWitnessForStakeAddr :: ScriptWitnessInCtx WitCtxStake

deriving instance Eq (KeyWitnessInCtx witctx)

deriving instance Show (KeyWitnessInCtx witctx)

deriving instance Eq (ScriptWitnessInCtx witctx)

deriving instance Show (ScriptWitnessInCtx witctx)

class IsScriptWitnessInCtx ctx where
  scriptWitnessInCtx :: ScriptWitnessInCtx ctx

instance IsScriptWitnessInCtx WitCtxTxIn where
  scriptWitnessInCtx :: ScriptWitnessInCtx WitCtxTxIn
scriptWitnessInCtx = ScriptWitnessInCtx WitCtxTxIn
ScriptWitnessForSpending

instance IsScriptWitnessInCtx WitCtxMint where
  scriptWitnessInCtx :: ScriptWitnessInCtx WitCtxMint
scriptWitnessInCtx = ScriptWitnessInCtx WitCtxMint
ScriptWitnessForMinting

instance IsScriptWitnessInCtx WitCtxStake where
  scriptWitnessInCtx :: ScriptWitnessInCtx WitCtxStake
scriptWitnessInCtx = ScriptWitnessInCtx WitCtxStake
ScriptWitnessForStakeAddr

-- ----------------------------------------------------------------------------
-- 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
  { ExecutionUnits -> Nat
executionSteps :: Natural
  -- ^ This corresponds roughly to the time to execute a script.
  , ExecutionUnits -> Nat
executionMemory :: Natural
  -- ^ This corresponds roughly to the peak memory used during script
  -- execution.
  }
  deriving (ExecutionUnits -> ExecutionUnits -> Bool
(ExecutionUnits -> ExecutionUnits -> Bool)
-> (ExecutionUnits -> ExecutionUnits -> Bool) -> Eq ExecutionUnits
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExecutionUnits -> ExecutionUnits -> Bool
== :: ExecutionUnits -> ExecutionUnits -> Bool
$c/= :: ExecutionUnits -> ExecutionUnits -> Bool
/= :: ExecutionUnits -> ExecutionUnits -> Bool
Eq, Int -> ExecutionUnits -> ShowS
[ExecutionUnits] -> ShowS
ExecutionUnits -> [Char]
(Int -> ExecutionUnits -> ShowS)
-> (ExecutionUnits -> [Char])
-> ([ExecutionUnits] -> ShowS)
-> Show ExecutionUnits
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExecutionUnits -> ShowS
showsPrec :: Int -> ExecutionUnits -> ShowS
$cshow :: ExecutionUnits -> [Char]
show :: ExecutionUnits -> [Char]
$cshowList :: [ExecutionUnits] -> ShowS
showList :: [ExecutionUnits] -> ShowS
Show)

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

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

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

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

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

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

-- ----------------------------------------------------------------------------
-- Alonzo mediator pattern
--

pattern PlutusScriptBinary :: Plutus.PlutusLanguage l => ShortByteString -> Plutus.Plutus l
pattern $mPlutusScriptBinary :: forall {r} {l :: Language}.
PlutusLanguage l =>
Plutus l -> (ShortByteString -> r) -> ((# #) -> r) -> r
$bPlutusScriptBinary :: forall (l :: Language).
PlutusLanguage l =>
ShortByteString -> Plutus l
PlutusScriptBinary script = Plutus.Plutus (Plutus.PlutusBinary script)

{-# COMPLETE PlutusScriptBinary #-}

-- ----------------------------------------------------------------------------
-- 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
$c== :: ScriptHash -> ScriptHash -> Bool
== :: ScriptHash -> ScriptHash -> Bool
$c/= :: ScriptHash -> ScriptHash -> Bool
/= :: 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
$ccompare :: ScriptHash -> ScriptHash -> Ordering
compare :: ScriptHash -> ScriptHash -> Ordering
$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
>= :: ScriptHash -> ScriptHash -> Bool
$cmax :: ScriptHash -> ScriptHash -> ScriptHash
max :: ScriptHash -> ScriptHash -> ScriptHash
$cmin :: ScriptHash -> ScriptHash -> ScriptHash
min :: ScriptHash -> ScriptHash -> ScriptHash
Ord)
  deriving (Int -> ScriptHash -> ShowS
[ScriptHash] -> ShowS
ScriptHash -> [Char]
(Int -> ScriptHash -> ShowS)
-> (ScriptHash -> [Char])
-> ([ScriptHash] -> ShowS)
-> Show ScriptHash
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScriptHash -> ShowS
showsPrec :: Int -> ScriptHash -> ShowS
$cshow :: ScriptHash -> [Char]
show :: ScriptHash -> [Char]
$cshowList :: [ScriptHash] -> ShowS
showList :: [ScriptHash] -> ShowS
Show, [Char] -> ScriptHash
([Char] -> ScriptHash) -> IsString ScriptHash
forall a. ([Char] -> a) -> IsString a
$cfromString :: [Char] -> ScriptHash
fromString :: [Char] -> ScriptHash
IsString) via UsingRawBytesHex ScriptHash
  deriving ([ScriptHash] -> Value
[ScriptHash] -> Encoding
ScriptHash -> Bool
ScriptHash -> Value
ScriptHash -> Encoding
(ScriptHash -> Value)
-> (ScriptHash -> Encoding)
-> ([ScriptHash] -> Value)
-> ([ScriptHash] -> Encoding)
-> (ScriptHash -> Bool)
-> ToJSON ScriptHash
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ScriptHash -> Value
toJSON :: ScriptHash -> Value
$ctoEncoding :: ScriptHash -> Encoding
toEncoding :: ScriptHash -> Encoding
$ctoJSONList :: [ScriptHash] -> Value
toJSONList :: [ScriptHash] -> Value
$ctoEncodingList :: [ScriptHash] -> Encoding
toEncodingList :: [ScriptHash] -> Encoding
$comitField :: ScriptHash -> Bool
omitField :: ScriptHash -> Bool
ToJSON, Maybe ScriptHash
Value -> Parser [ScriptHash]
Value -> Parser ScriptHash
(Value -> Parser ScriptHash)
-> (Value -> Parser [ScriptHash])
-> Maybe ScriptHash
-> FromJSON ScriptHash
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ScriptHash
parseJSON :: Value -> Parser ScriptHash
$cparseJSONList :: Value -> Parser [ScriptHash]
parseJSONList :: Value -> Parser [ScriptHash]
$comittedField :: Maybe ScriptHash
omittedField :: Maybe ScriptHash
FromJSON) via UsingRawBytesHex ScriptHash

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

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

  deserialiseFromRawBytes :: AsType ScriptHash
-> ByteString -> Either SerialiseAsRawBytesError ScriptHash
deserialiseFromRawBytes AsType ScriptHash
R:AsTypeScriptHash
AsScriptHash ByteString
bs =
    SerialiseAsRawBytesError
-> Maybe ScriptHash -> Either SerialiseAsRawBytesError ScriptHash
forall b a. b -> Maybe a -> Either b a
maybeToRight ([Char] -> SerialiseAsRawBytesError
SerialiseAsRawBytesError [Char]
"Unable to deserialise ScriptHash") (Maybe ScriptHash -> Either SerialiseAsRawBytesError ScriptHash)
-> Maybe ScriptHash -> Either SerialiseAsRawBytesError ScriptHash
forall a b. (a -> b) -> a -> b
$
      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
Hash (ADDRHASH StandardCrypto) EraIndependentScript
-> ScriptHash StandardCrypto
forall c. Hash (ADDRHASH c) EraIndependentScript -> ScriptHash c
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 :: forall lang. Script lang -> ScriptHash
hashScript (SimpleScript SimpleScript
s) =
  -- 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 -> ScriptHash StandardCrypto)
-> SimpleScript
-> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
Ledger.hashScript @(ShelleyLedgerEra AllegraEra)
    (Timelock StandardAllegra -> ScriptHash StandardCrypto)
-> (SimpleScript -> Timelock StandardAllegra)
-> SimpleScript
-> ScriptHash StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SimpleScript -> Timelock (ShelleyLedgerEra AllegraEra)
SimpleScript -> NativeScript StandardAllegra
forall era.
(AllegraEraScript era, EraCrypto era ~ StandardCrypto,
 NativeScript era ~ Timelock era) =>
SimpleScript -> NativeScript era
toAllegraTimelock :: SimpleScript -> Timelock.Timelock (ShelleyLedgerEra AllegraEra))
    (SimpleScript -> ScriptHash) -> SimpleScript -> ScriptHash
forall a b. (a -> b) -> a -> b
$ SimpleScript
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)
-> (PlutusBinary -> ScriptHash StandardCrypto)
-> PlutusBinary
-> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
Ledger.hashScript @(ShelleyLedgerEra AlonzoEra)
    (AlonzoScript StandardAlonzo -> ScriptHash StandardCrypto)
-> (PlutusBinary -> AlonzoScript StandardAlonzo)
-> PlutusBinary
-> ScriptHash StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusScript StandardAlonzo -> AlonzoScript StandardAlonzo
forall era. PlutusScript era -> AlonzoScript era
Alonzo.PlutusScript
    (PlutusScript StandardAlonzo -> AlonzoScript StandardAlonzo)
-> (PlutusBinary -> PlutusScript StandardAlonzo)
-> PlutusBinary
-> AlonzoScript StandardAlonzo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Plutus 'PlutusV1 -> PlutusScript StandardAlonzo
forall c. Plutus 'PlutusV1 -> PlutusScript (AlonzoEra c)
Alonzo.AlonzoPlutusV1
    (Plutus 'PlutusV1 -> PlutusScript StandardAlonzo)
-> (PlutusBinary -> Plutus 'PlutusV1)
-> PlutusBinary
-> PlutusScript StandardAlonzo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusBinary -> Plutus 'PlutusV1
forall (l :: Language). PlutusBinary -> Plutus l
Plutus.Plutus
    (PlutusBinary -> ScriptHash) -> PlutusBinary -> ScriptHash
forall a b. (a -> b) -> a -> b
$ ShortByteString -> PlutusBinary
Plutus.PlutusBinary ShortByteString
script
hashScript (PlutusScript PlutusScriptVersion lang
PlutusScriptV2 (PlutusScriptSerialised ShortByteString
script)) =
  ScriptHash StandardCrypto -> ScriptHash
ScriptHash
    (ScriptHash StandardCrypto -> ScriptHash)
-> (PlutusBinary -> ScriptHash StandardCrypto)
-> PlutusBinary
-> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
Ledger.hashScript @(ShelleyLedgerEra BabbageEra)
    (AlonzoScript StandardBabbage -> ScriptHash StandardCrypto)
-> (PlutusBinary -> AlonzoScript StandardBabbage)
-> PlutusBinary
-> ScriptHash StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusScript StandardBabbage -> AlonzoScript StandardBabbage
forall era. PlutusScript era -> AlonzoScript era
Alonzo.PlutusScript
    (PlutusScript StandardBabbage -> AlonzoScript StandardBabbage)
-> (PlutusBinary -> PlutusScript StandardBabbage)
-> PlutusBinary
-> AlonzoScript StandardBabbage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Plutus 'PlutusV2 -> PlutusScript StandardBabbage
forall c. Plutus 'PlutusV2 -> PlutusScript (BabbageEra c)
Babbage.BabbagePlutusV2
    (Plutus 'PlutusV2 -> PlutusScript StandardBabbage)
-> (PlutusBinary -> Plutus 'PlutusV2)
-> PlutusBinary
-> PlutusScript StandardBabbage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusBinary -> Plutus 'PlutusV2
forall (l :: Language). PlutusBinary -> Plutus l
Plutus.Plutus
    (PlutusBinary -> ScriptHash) -> PlutusBinary -> ScriptHash
forall a b. (a -> b) -> a -> b
$ ShortByteString -> PlutusBinary
Plutus.PlutusBinary ShortByteString
script
hashScript (PlutusScript PlutusScriptVersion lang
PlutusScriptV3 (PlutusScriptSerialised ShortByteString
script)) =
  ScriptHash StandardCrypto -> ScriptHash
ScriptHash
    (ScriptHash StandardCrypto -> ScriptHash)
-> (PlutusBinary -> ScriptHash StandardCrypto)
-> PlutusBinary
-> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
Ledger.hashScript @(ShelleyLedgerEra ConwayEra)
    (AlonzoScript StandardConway -> ScriptHash StandardCrypto)
-> (PlutusBinary -> AlonzoScript StandardConway)
-> PlutusBinary
-> ScriptHash StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusScript StandardConway -> AlonzoScript StandardConway
forall era. PlutusScript era -> AlonzoScript era
Alonzo.PlutusScript
    (PlutusScript StandardConway -> AlonzoScript StandardConway)
-> (PlutusBinary -> PlutusScript StandardConway)
-> PlutusBinary
-> AlonzoScript StandardConway
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Plutus 'PlutusV3 -> PlutusScript StandardConway
forall c. Plutus 'PlutusV3 -> PlutusScript (ConwayEra c)
Conway.ConwayPlutusV3
    (Plutus 'PlutusV3 -> PlutusScript StandardConway)
-> (PlutusBinary -> Plutus 'PlutusV3)
-> PlutusBinary
-> PlutusScript StandardConway
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusBinary -> Plutus 'PlutusV3
forall (l :: Language). PlutusBinary -> Plutus l
Plutus.Plutus
    (PlutusBinary -> ScriptHash) -> PlutusBinary -> ScriptHash
forall a b. (a -> b) -> a -> b
$ ShortByteString -> PlutusBinary
Plutus.PlutusBinary ShortByteString
script

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

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

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

data SimpleScript
  = RequireSignature !(Hash PaymentKey)
  | RequireTimeBefore !SlotNo
  | RequireTimeAfter !SlotNo
  | RequireAllOf ![SimpleScript]
  | RequireAnyOf ![SimpleScript]
  | RequireMOf !Int ![SimpleScript]
  deriving (SimpleScript -> SimpleScript -> Bool
(SimpleScript -> SimpleScript -> Bool)
-> (SimpleScript -> SimpleScript -> Bool) -> Eq SimpleScript
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SimpleScript -> SimpleScript -> Bool
== :: SimpleScript -> SimpleScript -> Bool
$c/= :: SimpleScript -> SimpleScript -> Bool
/= :: SimpleScript -> SimpleScript -> Bool
Eq, Int -> SimpleScript -> ShowS
[SimpleScript] -> ShowS
SimpleScript -> [Char]
(Int -> SimpleScript -> ShowS)
-> (SimpleScript -> [Char])
-> ([SimpleScript] -> ShowS)
-> Show SimpleScript
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SimpleScript -> ShowS
showsPrec :: Int -> SimpleScript -> ShowS
$cshow :: SimpleScript -> [Char]
show :: SimpleScript -> [Char]
$cshowList :: [SimpleScript] -> ShowS
showList :: [SimpleScript] -> ShowS
Show)

-- ----------------------------------------------------------------------------
-- 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
$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
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
$ccompare :: forall lang. PlutusScript lang -> PlutusScript lang -> Ordering
compare :: PlutusScript lang -> PlutusScript lang -> Ordering
$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
>= :: PlutusScript lang -> PlutusScript lang -> Bool
$cmax :: forall lang.
PlutusScript lang -> PlutusScript lang -> PlutusScript lang
max :: PlutusScript lang -> PlutusScript lang -> PlutusScript lang
$cmin :: forall lang.
PlutusScript lang -> PlutusScript lang -> PlutusScript lang
min :: PlutusScript lang -> PlutusScript lang -> PlutusScript lang
Ord)
  deriving stock Int -> PlutusScript lang -> ShowS
[PlutusScript lang] -> ShowS
PlutusScript lang -> [Char]
(Int -> PlutusScript lang -> ShowS)
-> (PlutusScript lang -> [Char])
-> ([PlutusScript lang] -> ShowS)
-> Show (PlutusScript lang)
forall lang. Int -> PlutusScript lang -> ShowS
forall lang. [PlutusScript lang] -> ShowS
forall lang. PlutusScript lang -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall lang. Int -> PlutusScript lang -> ShowS
showsPrec :: Int -> PlutusScript lang -> ShowS
$cshow :: forall lang. PlutusScript lang -> [Char]
show :: PlutusScript lang -> [Char]
$cshowList :: forall lang. [PlutusScript lang] -> ShowS
showList :: [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 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
forall lang. HasTypeProxy lang => Typeable (PlutusScript lang)
forall lang. HasTypeProxy lang => PlutusScript lang -> Encoding
forall lang.
HasTypeProxy lang =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PlutusScript lang] -> Size
forall lang.
HasTypeProxy lang =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PlutusScript lang) -> Size
$ctoCBOR :: forall lang. HasTypeProxy lang => PlutusScript lang -> Encoding
toCBOR :: PlutusScript lang -> Encoding
$cencodedSizeExpr :: forall 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
$cencodedListSizeExpr :: forall lang.
HasTypeProxy lang =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PlutusScript lang] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PlutusScript lang] -> Size
ToCBOR, Typeable (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 a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
forall lang. HasTypeProxy lang => Typeable (PlutusScript lang)
forall lang. HasTypeProxy lang => Proxy (PlutusScript lang) -> Text
forall lang s. HasTypeProxy lang => Decoder s (PlutusScript lang)
$cfromCBOR :: forall lang s. HasTypeProxy lang => Decoder s (PlutusScript lang)
fromCBOR :: forall s. Decoder s (PlutusScript lang)
$clabel :: forall lang. HasTypeProxy lang => Proxy (PlutusScript lang) -> Text
label :: Proxy (PlutusScript lang) -> Text
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 => HasTypeProxy (PlutusScript lang)
forall lang.
HasTypeProxy lang =>
AsType (PlutusScript lang)
-> ByteString -> Either DecoderError (PlutusScript lang)
forall lang. HasTypeProxy lang => PlutusScript lang -> ByteString
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: forall lang. HasTypeProxy lang => PlutusScript lang -> ByteString
serialiseToCBOR :: PlutusScript lang -> ByteString
$cdeserialiseFromCBOR :: forall lang.
HasTypeProxy lang =>
AsType (PlutusScript lang)
-> ByteString -> Either DecoderError (PlutusScript lang)
deserialiseFromCBOR :: AsType (PlutusScript lang)
-> ByteString -> Either DecoderError (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
-> Either SerialiseAsRawBytesError (PlutusScript lang)
deserialiseFromRawBytes (AsPlutusScript AsType lang
_) ByteString
bs =
    -- TODO alonzo: validate the script syntax and fail decoding if invalid
    PlutusScript lang
-> Either SerialiseAsRawBytesError (PlutusScript lang)
forall a b. b -> Either a b
Right (ShortByteString -> PlutusScript lang
forall lang. ShortByteString -> PlutusScript lang
PlutusScriptSerialised (ByteString -> ShortByteString
SBS.toShort ByteString
bs))

instance IsPlutusScriptLanguage 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"
      PlutusScriptVersion lang
PlutusScriptV3 -> TextEnvelopeType
"PlutusScriptV3"

-- | Smart-constructor for 'ScriptLanguageInEra' to write functions
-- manipulating scripts that do not commit to a particular era.
class HasScriptLanguageInEra lang era where
  scriptLanguageInEra :: ScriptLanguageInEra lang era

instance HasScriptLanguageInEra PlutusScriptV1 AlonzoEra where
  scriptLanguageInEra :: ScriptLanguageInEra PlutusScriptV1 AlonzoEra
scriptLanguageInEra = ScriptLanguageInEra PlutusScriptV1 AlonzoEra
PlutusScriptV1InAlonzo

instance HasScriptLanguageInEra PlutusScriptV1 BabbageEra where
  scriptLanguageInEra :: ScriptLanguageInEra PlutusScriptV1 BabbageEra
scriptLanguageInEra = ScriptLanguageInEra PlutusScriptV1 BabbageEra
PlutusScriptV1InBabbage

instance HasScriptLanguageInEra PlutusScriptV2 BabbageEra where
  scriptLanguageInEra :: ScriptLanguageInEra PlutusScriptV2 BabbageEra
scriptLanguageInEra = ScriptLanguageInEra PlutusScriptV2 BabbageEra
PlutusScriptV2InBabbage

instance HasScriptLanguageInEra PlutusScriptV1 ConwayEra where
  scriptLanguageInEra :: ScriptLanguageInEra PlutusScriptV1 ConwayEra
scriptLanguageInEra = ScriptLanguageInEra PlutusScriptV1 ConwayEra
PlutusScriptV1InConway

instance HasScriptLanguageInEra PlutusScriptV2 ConwayEra where
  scriptLanguageInEra :: ScriptLanguageInEra PlutusScriptV2 ConwayEra
scriptLanguageInEra = ScriptLanguageInEra PlutusScriptV2 ConwayEra
PlutusScriptV2InConway

instance HasScriptLanguageInEra PlutusScriptV3 ConwayEra where
  scriptLanguageInEra :: ScriptLanguageInEra PlutusScriptV3 ConwayEra
scriptLanguageInEra = ScriptLanguageInEra PlutusScriptV3 ConwayEra
PlutusScriptV3InConway

class ToAlonzoScript lang era where
  toLedgerScript
    :: PlutusScript lang
    -> Conway.AlonzoScript (ShelleyLedgerEra era)

instance ToAlonzoScript PlutusScriptV1 BabbageEra where
  toLedgerScript :: PlutusScript PlutusScriptV1
-> AlonzoScript (ShelleyLedgerEra BabbageEra)
toLedgerScript (PlutusScriptSerialised ShortByteString
bytes) =
    PlutusScript (ShelleyLedgerEra BabbageEra)
-> AlonzoScript (ShelleyLedgerEra BabbageEra)
forall era. PlutusScript era -> AlonzoScript era
Conway.PlutusScript (PlutusScript (ShelleyLedgerEra BabbageEra)
 -> AlonzoScript (ShelleyLedgerEra BabbageEra))
-> PlutusScript (ShelleyLedgerEra BabbageEra)
-> AlonzoScript (ShelleyLedgerEra BabbageEra)
forall a b. (a -> b) -> a -> b
$ Plutus 'PlutusV1 -> PlutusScript StandardBabbage
forall c. Plutus 'PlutusV1 -> PlutusScript (BabbageEra c)
Conway.BabbagePlutusV1 (Plutus 'PlutusV1 -> PlutusScript StandardBabbage)
-> Plutus 'PlutusV1 -> PlutusScript StandardBabbage
forall a b. (a -> b) -> a -> b
$ PlutusBinary -> Plutus 'PlutusV1
forall (l :: Language). PlutusBinary -> Plutus l
Plutus.Plutus (PlutusBinary -> Plutus 'PlutusV1)
-> PlutusBinary -> Plutus 'PlutusV1
forall a b. (a -> b) -> a -> b
$ ShortByteString -> PlutusBinary
Plutus.PlutusBinary ShortByteString
bytes

instance ToAlonzoScript PlutusScriptV2 BabbageEra where
  toLedgerScript :: PlutusScript PlutusScriptV2
-> AlonzoScript (ShelleyLedgerEra BabbageEra)
toLedgerScript (PlutusScriptSerialised ShortByteString
bytes) =
    PlutusScript (ShelleyLedgerEra BabbageEra)
-> AlonzoScript (ShelleyLedgerEra BabbageEra)
forall era. PlutusScript era -> AlonzoScript era
Conway.PlutusScript (PlutusScript (ShelleyLedgerEra BabbageEra)
 -> AlonzoScript (ShelleyLedgerEra BabbageEra))
-> PlutusScript (ShelleyLedgerEra BabbageEra)
-> AlonzoScript (ShelleyLedgerEra BabbageEra)
forall a b. (a -> b) -> a -> b
$ Plutus 'PlutusV2 -> PlutusScript StandardBabbage
forall c. Plutus 'PlutusV2 -> PlutusScript (BabbageEra c)
Conway.BabbagePlutusV2 (Plutus 'PlutusV2 -> PlutusScript StandardBabbage)
-> Plutus 'PlutusV2 -> PlutusScript StandardBabbage
forall a b. (a -> b) -> a -> b
$ PlutusBinary -> Plutus 'PlutusV2
forall (l :: Language). PlutusBinary -> Plutus l
Plutus.Plutus (PlutusBinary -> Plutus 'PlutusV2)
-> PlutusBinary -> Plutus 'PlutusV2
forall a b. (a -> b) -> a -> b
$ ShortByteString -> PlutusBinary
Plutus.PlutusBinary ShortByteString
bytes

instance ToAlonzoScript PlutusScriptV1 ConwayEra where
  toLedgerScript :: PlutusScript PlutusScriptV1
-> AlonzoScript (ShelleyLedgerEra ConwayEra)
toLedgerScript (PlutusScriptSerialised ShortByteString
bytes) =
    PlutusScript (ShelleyLedgerEra ConwayEra)
-> AlonzoScript (ShelleyLedgerEra ConwayEra)
forall era. PlutusScript era -> AlonzoScript era
Conway.PlutusScript (PlutusScript (ShelleyLedgerEra ConwayEra)
 -> AlonzoScript (ShelleyLedgerEra ConwayEra))
-> PlutusScript (ShelleyLedgerEra ConwayEra)
-> AlonzoScript (ShelleyLedgerEra ConwayEra)
forall a b. (a -> b) -> a -> b
$ Plutus 'PlutusV1 -> PlutusScript StandardConway
forall c. Plutus 'PlutusV1 -> PlutusScript (ConwayEra c)
Conway.ConwayPlutusV1 (Plutus 'PlutusV1 -> PlutusScript StandardConway)
-> Plutus 'PlutusV1 -> PlutusScript StandardConway
forall a b. (a -> b) -> a -> b
$ PlutusBinary -> Plutus 'PlutusV1
forall (l :: Language). PlutusBinary -> Plutus l
Plutus.Plutus (PlutusBinary -> Plutus 'PlutusV1)
-> PlutusBinary -> Plutus 'PlutusV1
forall a b. (a -> b) -> a -> b
$ ShortByteString -> PlutusBinary
Plutus.PlutusBinary ShortByteString
bytes

instance ToAlonzoScript PlutusScriptV2 ConwayEra where
  toLedgerScript :: PlutusScript PlutusScriptV2
-> AlonzoScript (ShelleyLedgerEra ConwayEra)
toLedgerScript (PlutusScriptSerialised ShortByteString
bytes) =
    PlutusScript (ShelleyLedgerEra ConwayEra)
-> AlonzoScript (ShelleyLedgerEra ConwayEra)
forall era. PlutusScript era -> AlonzoScript era
Conway.PlutusScript (PlutusScript (ShelleyLedgerEra ConwayEra)
 -> AlonzoScript (ShelleyLedgerEra ConwayEra))
-> PlutusScript (ShelleyLedgerEra ConwayEra)
-> AlonzoScript (ShelleyLedgerEra ConwayEra)
forall a b. (a -> b) -> a -> b
$ Plutus 'PlutusV2 -> PlutusScript StandardConway
forall c. Plutus 'PlutusV2 -> PlutusScript (ConwayEra c)
Conway.ConwayPlutusV2 (Plutus 'PlutusV2 -> PlutusScript StandardConway)
-> Plutus 'PlutusV2 -> PlutusScript StandardConway
forall a b. (a -> b) -> a -> b
$ PlutusBinary -> Plutus 'PlutusV2
forall (l :: Language). PlutusBinary -> Plutus l
Plutus.Plutus (PlutusBinary -> Plutus 'PlutusV2)
-> PlutusBinary -> Plutus 'PlutusV2
forall a b. (a -> b) -> a -> b
$ ShortByteString -> PlutusBinary
Plutus.PlutusBinary ShortByteString
bytes

instance ToAlonzoScript PlutusScriptV3 ConwayEra where
  toLedgerScript :: PlutusScript PlutusScriptV3
-> AlonzoScript (ShelleyLedgerEra ConwayEra)
toLedgerScript (PlutusScriptSerialised ShortByteString
bytes) =
    PlutusScript (ShelleyLedgerEra ConwayEra)
-> AlonzoScript (ShelleyLedgerEra ConwayEra)
forall era. PlutusScript era -> AlonzoScript era
Conway.PlutusScript (PlutusScript (ShelleyLedgerEra ConwayEra)
 -> AlonzoScript (ShelleyLedgerEra ConwayEra))
-> PlutusScript (ShelleyLedgerEra ConwayEra)
-> AlonzoScript (ShelleyLedgerEra ConwayEra)
forall a b. (a -> b) -> a -> b
$ Plutus 'PlutusV3 -> PlutusScript StandardConway
forall c. Plutus 'PlutusV3 -> PlutusScript (ConwayEra c)
Conway.ConwayPlutusV3 (Plutus 'PlutusV3 -> PlutusScript StandardConway)
-> Plutus 'PlutusV3 -> PlutusScript StandardConway
forall a b. (a -> b) -> a -> b
$ PlutusBinary -> Plutus 'PlutusV3
forall (l :: Language). PlutusBinary -> Plutus l
Plutus.Plutus (PlutusBinary -> Plutus 'PlutusV3)
-> PlutusBinary -> Plutus 'PlutusV3
forall a b. (a -> b) -> a -> b
$ ShortByteString -> PlutusBinary
Plutus.PlutusBinary ShortByteString
bytes

-- | 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 :: forall witctx. 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
. Nat -> ShortByteString
Plutus.alwaysSucceedingNAryFunction
    (Nat -> ShortByteString)
-> (WitCtx witctx -> Nat) -> WitCtx witctx -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WitCtx witctx -> Nat
forall witctx. WitCtx witctx -> Nat
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 :: forall witctx. 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
. Nat -> ShortByteString
Plutus.alwaysFailingNAryFunction
    (Nat -> ShortByteString)
-> (WitCtx witctx -> Nat) -> WitCtx witctx -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WitCtx witctx -> Nat
forall witctx. WitCtx witctx -> Nat
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 :: forall witctx. WitCtx witctx -> Nat
scriptArityForWitCtx WitCtx witctx
WitCtxTxIn = Nat
3
scriptArityForWitCtx WitCtx witctx
WitCtxMint = Nat
2
scriptArityForWitCtx WitCtx witctx
WitCtxStake = Nat
2

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

toShelleyScript :: ScriptInEra era -> Ledger.Script (ShelleyLedgerEra era)
toShelleyScript :: forall era. ScriptInEra era -> Script (ShelleyLedgerEra era)
toShelleyScript (ScriptInEra ScriptLanguageInEra lang era
langInEra (SimpleScript SimpleScript
script)) =
  case ScriptLanguageInEra lang era
langInEra of
    ScriptLanguageInEra lang era
SimpleScriptInShelley -> (MultiSigError -> MultiSig (ShelleyEra StandardCrypto))
-> (MultiSig (ShelleyEra StandardCrypto)
    -> MultiSig (ShelleyEra StandardCrypto))
-> Either MultiSigError (MultiSig (ShelleyEra StandardCrypto))
-> MultiSig (ShelleyEra StandardCrypto)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> MultiSig (ShelleyEra StandardCrypto)
forall a. HasCallStack => [Char] -> a
error ([Char] -> MultiSig (ShelleyEra StandardCrypto))
-> (MultiSigError -> [Char])
-> MultiSigError
-> MultiSig (ShelleyEra StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiSigError -> [Char]
forall a. Show a => a -> [Char]
show) MultiSig (ShelleyEra StandardCrypto)
-> MultiSig (ShelleyEra StandardCrypto)
forall a. a -> a
id (SimpleScript
-> Either MultiSigError (MultiSig (ShelleyLedgerEra ShelleyEra))
toShelleyMultiSig SimpleScript
script)
    ScriptLanguageInEra lang era
SimpleScriptInAllegra -> SimpleScript -> NativeScript StandardAllegra
forall era.
(AllegraEraScript era, EraCrypto era ~ StandardCrypto,
 NativeScript era ~ Timelock era) =>
SimpleScript -> NativeScript era
toAllegraTimelock SimpleScript
script
    ScriptLanguageInEra lang era
SimpleScriptInMary -> SimpleScript -> NativeScript (MaryEra StandardCrypto)
forall era.
(AllegraEraScript era, EraCrypto era ~ StandardCrypto,
 NativeScript era ~ Timelock era) =>
SimpleScript -> NativeScript era
toAllegraTimelock SimpleScript
script
    ScriptLanguageInEra lang era
SimpleScriptInAlonzo -> Timelock StandardAlonzo -> AlonzoScript StandardAlonzo
forall era. Timelock era -> AlonzoScript era
Alonzo.TimelockScript (SimpleScript -> NativeScript StandardAlonzo
forall era.
(AllegraEraScript era, EraCrypto era ~ StandardCrypto,
 NativeScript era ~ Timelock era) =>
SimpleScript -> NativeScript era
toAllegraTimelock SimpleScript
script)
    ScriptLanguageInEra lang era
SimpleScriptInBabbage -> Timelock StandardBabbage -> AlonzoScript StandardBabbage
forall era. Timelock era -> AlonzoScript era
Alonzo.TimelockScript (SimpleScript -> NativeScript StandardBabbage
forall era.
(AllegraEraScript era, EraCrypto era ~ StandardCrypto,
 NativeScript era ~ Timelock era) =>
SimpleScript -> NativeScript era
toAllegraTimelock SimpleScript
script)
    ScriptLanguageInEra lang era
SimpleScriptInConway -> Timelock StandardConway -> AlonzoScript StandardConway
forall era. Timelock era -> AlonzoScript era
Alonzo.TimelockScript (SimpleScript -> NativeScript StandardConway
forall era.
(AllegraEraScript era, EraCrypto era ~ StandardCrypto,
 NativeScript era ~ Timelock era) =>
SimpleScript -> NativeScript era
toAllegraTimelock SimpleScript
script)
toShelleyScript
  ( ScriptInEra
      ScriptLanguageInEra lang era
langInEra
      ( PlutusScript
          PlutusScriptVersion lang
PlutusScriptV1
          (PlutusScriptSerialised ShortByteString
script)
        )
    ) =
    case ScriptLanguageInEra lang era
langInEra of
      ScriptLanguageInEra lang era
PlutusScriptV1InAlonzo ->
        PlutusScript StandardAlonzo -> Script (ShelleyLedgerEra era)
PlutusScript StandardAlonzo -> AlonzoScript StandardAlonzo
forall era. PlutusScript era -> AlonzoScript era
Alonzo.PlutusScript (PlutusScript StandardAlonzo -> Script (ShelleyLedgerEra era))
-> (PlutusBinary -> PlutusScript StandardAlonzo)
-> PlutusBinary
-> Script (ShelleyLedgerEra era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Plutus 'PlutusV1 -> PlutusScript StandardAlonzo
forall c. Plutus 'PlutusV1 -> PlutusScript (AlonzoEra c)
Alonzo.AlonzoPlutusV1 (Plutus 'PlutusV1 -> PlutusScript StandardAlonzo)
-> (PlutusBinary -> Plutus 'PlutusV1)
-> PlutusBinary
-> PlutusScript StandardAlonzo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusBinary -> Plutus 'PlutusV1
forall (l :: Language). PlutusBinary -> Plutus l
Plutus.Plutus (PlutusBinary -> Script (ShelleyLedgerEra era))
-> PlutusBinary -> Script (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$ ShortByteString -> PlutusBinary
Plutus.PlutusBinary ShortByteString
script
      ScriptLanguageInEra lang era
PlutusScriptV1InBabbage ->
        PlutusScript StandardBabbage -> Script (ShelleyLedgerEra era)
PlutusScript StandardBabbage -> AlonzoScript StandardBabbage
forall era. PlutusScript era -> AlonzoScript era
Alonzo.PlutusScript (PlutusScript StandardBabbage -> Script (ShelleyLedgerEra era))
-> (PlutusBinary -> PlutusScript StandardBabbage)
-> PlutusBinary
-> Script (ShelleyLedgerEra era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Plutus 'PlutusV1 -> PlutusScript StandardBabbage
forall c. Plutus 'PlutusV1 -> PlutusScript (BabbageEra c)
Babbage.BabbagePlutusV1 (Plutus 'PlutusV1 -> PlutusScript StandardBabbage)
-> (PlutusBinary -> Plutus 'PlutusV1)
-> PlutusBinary
-> PlutusScript StandardBabbage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusBinary -> Plutus 'PlutusV1
forall (l :: Language). PlutusBinary -> Plutus l
Plutus.Plutus (PlutusBinary -> Script (ShelleyLedgerEra era))
-> PlutusBinary -> Script (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$ ShortByteString -> PlutusBinary
Plutus.PlutusBinary ShortByteString
script
      ScriptLanguageInEra lang era
PlutusScriptV1InConway ->
        PlutusScript StandardConway -> Script (ShelleyLedgerEra era)
PlutusScript StandardConway -> AlonzoScript StandardConway
forall era. PlutusScript era -> AlonzoScript era
Alonzo.PlutusScript (PlutusScript StandardConway -> Script (ShelleyLedgerEra era))
-> (PlutusBinary -> PlutusScript StandardConway)
-> PlutusBinary
-> Script (ShelleyLedgerEra era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Plutus 'PlutusV1 -> PlutusScript StandardConway
forall c. Plutus 'PlutusV1 -> PlutusScript (ConwayEra c)
Conway.ConwayPlutusV1 (Plutus 'PlutusV1 -> PlutusScript StandardConway)
-> (PlutusBinary -> Plutus 'PlutusV1)
-> PlutusBinary
-> PlutusScript StandardConway
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusBinary -> Plutus 'PlutusV1
forall (l :: Language). PlutusBinary -> Plutus l
Plutus.Plutus (PlutusBinary -> Script (ShelleyLedgerEra era))
-> PlutusBinary -> Script (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$ ShortByteString -> PlutusBinary
Plutus.PlutusBinary ShortByteString
script
toShelleyScript
  ( ScriptInEra
      ScriptLanguageInEra lang era
langInEra
      ( PlutusScript
          PlutusScriptVersion lang
PlutusScriptV2
          (PlutusScriptSerialised ShortByteString
script)
        )
    ) =
    case ScriptLanguageInEra lang era
langInEra of
      ScriptLanguageInEra lang era
PlutusScriptV2InBabbage ->
        PlutusScript StandardBabbage -> Script (ShelleyLedgerEra era)
PlutusScript StandardBabbage -> AlonzoScript StandardBabbage
forall era. PlutusScript era -> AlonzoScript era
Alonzo.PlutusScript (PlutusScript StandardBabbage -> Script (ShelleyLedgerEra era))
-> (PlutusBinary -> PlutusScript StandardBabbage)
-> PlutusBinary
-> Script (ShelleyLedgerEra era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Plutus 'PlutusV2 -> PlutusScript StandardBabbage
forall c. Plutus 'PlutusV2 -> PlutusScript (BabbageEra c)
Babbage.BabbagePlutusV2 (Plutus 'PlutusV2 -> PlutusScript StandardBabbage)
-> (PlutusBinary -> Plutus 'PlutusV2)
-> PlutusBinary
-> PlutusScript StandardBabbage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusBinary -> Plutus 'PlutusV2
forall (l :: Language). PlutusBinary -> Plutus l
Plutus.Plutus (PlutusBinary -> Script (ShelleyLedgerEra era))
-> PlutusBinary -> Script (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$ ShortByteString -> PlutusBinary
Plutus.PlutusBinary ShortByteString
script
      ScriptLanguageInEra lang era
PlutusScriptV2InConway ->
        PlutusScript StandardConway -> Script (ShelleyLedgerEra era)
PlutusScript StandardConway -> AlonzoScript StandardConway
forall era. PlutusScript era -> AlonzoScript era
Alonzo.PlutusScript (PlutusScript StandardConway -> Script (ShelleyLedgerEra era))
-> (PlutusBinary -> PlutusScript StandardConway)
-> PlutusBinary
-> Script (ShelleyLedgerEra era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Plutus 'PlutusV2 -> PlutusScript StandardConway
forall c. Plutus 'PlutusV2 -> PlutusScript (ConwayEra c)
Conway.ConwayPlutusV2 (Plutus 'PlutusV2 -> PlutusScript StandardConway)
-> (PlutusBinary -> Plutus 'PlutusV2)
-> PlutusBinary
-> PlutusScript StandardConway
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusBinary -> Plutus 'PlutusV2
forall (l :: Language). PlutusBinary -> Plutus l
Plutus.Plutus (PlutusBinary -> Script (ShelleyLedgerEra era))
-> PlutusBinary -> Script (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$ ShortByteString -> PlutusBinary
Plutus.PlutusBinary ShortByteString
script
toShelleyScript
  ( ScriptInEra
      ScriptLanguageInEra lang era
langInEra
      ( PlutusScript
          PlutusScriptVersion lang
PlutusScriptV3
          (PlutusScriptSerialised ShortByteString
script)
        )
    ) =
    case ScriptLanguageInEra lang era
langInEra of
      ScriptLanguageInEra lang era
PlutusScriptV3InConway ->
        PlutusScript StandardConway -> Script (ShelleyLedgerEra era)
PlutusScript StandardConway -> AlonzoScript StandardConway
forall era. PlutusScript era -> AlonzoScript era
Alonzo.PlutusScript (PlutusScript StandardConway -> Script (ShelleyLedgerEra era))
-> (PlutusBinary -> PlutusScript StandardConway)
-> PlutusBinary
-> Script (ShelleyLedgerEra era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Plutus 'PlutusV3 -> PlutusScript StandardConway
forall c. Plutus 'PlutusV3 -> PlutusScript (ConwayEra c)
Conway.ConwayPlutusV3 (Plutus 'PlutusV3 -> PlutusScript StandardConway)
-> (PlutusBinary -> Plutus 'PlutusV3)
-> PlutusBinary
-> PlutusScript StandardConway
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusBinary -> Plutus 'PlutusV3
forall (l :: Language). PlutusBinary -> Plutus l
Plutus.Plutus (PlutusBinary -> Script (ShelleyLedgerEra era))
-> PlutusBinary -> Script (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$ ShortByteString -> PlutusBinary
Plutus.PlutusBinary ShortByteString
script

fromShelleyBasedScript
  :: ShelleyBasedEra era
  -> Ledger.Script (ShelleyLedgerEra era)
  -> ScriptInEra era
fromShelleyBasedScript :: forall era.
ShelleyBasedEra era
-> Script (ShelleyLedgerEra era) -> ScriptInEra era
fromShelleyBasedScript ShelleyBasedEra era
sbe Script (ShelleyLedgerEra era)
script =
  case ShelleyBasedEra era
sbe of
    ShelleyBasedEra era
ShelleyBasedEraShelley ->
      ScriptLanguageInEra SimpleScript' era
-> Script SimpleScript' -> ScriptInEra era
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScript' era
ScriptLanguageInEra SimpleScript' ShelleyEra
SimpleScriptInShelley
        (Script SimpleScript' -> ScriptInEra era)
-> (SimpleScript -> Script SimpleScript')
-> SimpleScript
-> ScriptInEra era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleScript -> Script SimpleScript'
SimpleScript
        (SimpleScript -> ScriptInEra era)
-> SimpleScript -> ScriptInEra era
forall a b. (a -> b) -> a -> b
$ MultiSig (ShelleyLedgerEra ShelleyEra) -> SimpleScript
fromShelleyMultiSig Script (ShelleyLedgerEra era)
MultiSig (ShelleyLedgerEra ShelleyEra)
script
    ShelleyBasedEra era
ShelleyBasedEraAllegra ->
      ScriptLanguageInEra SimpleScript' era
-> Script SimpleScript' -> ScriptInEra era
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScript' era
ScriptLanguageInEra SimpleScript' AllegraEra
SimpleScriptInAllegra
        (Script SimpleScript' -> ScriptInEra era)
-> (SimpleScript -> Script SimpleScript')
-> SimpleScript
-> ScriptInEra era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleScript -> Script SimpleScript'
SimpleScript
        (SimpleScript -> ScriptInEra era)
-> SimpleScript -> ScriptInEra era
forall a b. (a -> b) -> a -> b
$ NativeScript StandardAllegra -> SimpleScript
forall era.
(AllegraEraScript era, EraCrypto era ~ StandardCrypto) =>
NativeScript era -> SimpleScript
fromAllegraTimelock NativeScript StandardAllegra
Script (ShelleyLedgerEra era)
script
    ShelleyBasedEra era
ShelleyBasedEraMary ->
      ScriptLanguageInEra SimpleScript' era
-> Script SimpleScript' -> ScriptInEra era
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScript' era
ScriptLanguageInEra SimpleScript' MaryEra
SimpleScriptInMary
        (Script SimpleScript' -> ScriptInEra era)
-> (SimpleScript -> Script SimpleScript')
-> SimpleScript
-> ScriptInEra era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleScript -> Script SimpleScript'
SimpleScript
        (SimpleScript -> ScriptInEra era)
-> SimpleScript -> ScriptInEra era
forall a b. (a -> b) -> a -> b
$ NativeScript (MaryEra StandardCrypto) -> SimpleScript
forall era.
(AllegraEraScript era, EraCrypto era ~ StandardCrypto) =>
NativeScript era -> SimpleScript
fromAllegraTimelock NativeScript (MaryEra StandardCrypto)
Script (ShelleyLedgerEra era)
script
    ShelleyBasedEra era
ShelleyBasedEraAlonzo ->
      case Script (ShelleyLedgerEra era)
script of
        Alonzo.PlutusScript (Alonzo.AlonzoPlutusV1 (PlutusScriptBinary ShortByteString
s)) ->
          ScriptLanguageInEra PlutusScriptV1 era
-> Script PlutusScriptV1 -> ScriptInEra era
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra PlutusScriptV1 era
ScriptLanguageInEra PlutusScriptV1 AlonzoEra
PlutusScriptV1InAlonzo
            (Script PlutusScriptV1 -> ScriptInEra era)
-> (PlutusScript PlutusScriptV1 -> Script PlutusScriptV1)
-> PlutusScript PlutusScriptV1
-> ScriptInEra era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusScriptVersion PlutusScriptV1
-> PlutusScript PlutusScriptV1 -> Script PlutusScriptV1
forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
PlutusScript PlutusScriptVersion PlutusScriptV1
PlutusScriptV1
            (PlutusScript PlutusScriptV1 -> ScriptInEra era)
-> PlutusScript PlutusScriptV1 -> ScriptInEra era
forall a b. (a -> b) -> a -> b
$ ShortByteString -> PlutusScript PlutusScriptV1
forall lang. ShortByteString -> PlutusScript lang
PlutusScriptSerialised ShortByteString
s
        Alonzo.TimelockScript Timelock StandardAlonzo
s ->
          ScriptLanguageInEra SimpleScript' era
-> Script SimpleScript' -> ScriptInEra era
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScript' era
ScriptLanguageInEra SimpleScript' AlonzoEra
SimpleScriptInAlonzo
            (Script SimpleScript' -> ScriptInEra era)
-> (SimpleScript -> Script SimpleScript')
-> SimpleScript
-> ScriptInEra era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleScript -> Script SimpleScript'
SimpleScript
            (SimpleScript -> ScriptInEra era)
-> SimpleScript -> ScriptInEra era
forall a b. (a -> b) -> a -> b
$ NativeScript StandardAlonzo -> SimpleScript
forall era.
(AllegraEraScript era, EraCrypto era ~ StandardCrypto) =>
NativeScript era -> SimpleScript
fromAllegraTimelock Timelock StandardAlonzo
NativeScript StandardAlonzo
s
    ShelleyBasedEra era
ShelleyBasedEraBabbage ->
      case Script (ShelleyLedgerEra era)
script of
        Alonzo.PlutusScript PlutusScript StandardBabbage
plutusV ->
          case PlutusScript StandardBabbage
plutusV of
            Babbage.BabbagePlutusV1 (PlutusScriptBinary ShortByteString
s) ->
              ScriptLanguageInEra PlutusScriptV1 era
-> Script PlutusScriptV1 -> ScriptInEra era
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra PlutusScriptV1 era
ScriptLanguageInEra PlutusScriptV1 BabbageEra
PlutusScriptV1InBabbage
                (Script PlutusScriptV1 -> ScriptInEra era)
-> (PlutusScript PlutusScriptV1 -> Script PlutusScriptV1)
-> PlutusScript PlutusScriptV1
-> ScriptInEra era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusScriptVersion PlutusScriptV1
-> PlutusScript PlutusScriptV1 -> Script PlutusScriptV1
forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
PlutusScript PlutusScriptVersion PlutusScriptV1
PlutusScriptV1
                (PlutusScript PlutusScriptV1 -> ScriptInEra era)
-> PlutusScript PlutusScriptV1 -> ScriptInEra era
forall a b. (a -> b) -> a -> b
$ ShortByteString -> PlutusScript PlutusScriptV1
forall lang. ShortByteString -> PlutusScript lang
PlutusScriptSerialised ShortByteString
s
            Babbage.BabbagePlutusV2 (PlutusScriptBinary ShortByteString
s) ->
              ScriptLanguageInEra PlutusScriptV2 era
-> Script PlutusScriptV2 -> ScriptInEra era
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra PlutusScriptV2 era
ScriptLanguageInEra PlutusScriptV2 BabbageEra
PlutusScriptV2InBabbage
                (Script PlutusScriptV2 -> ScriptInEra era)
-> (PlutusScript PlutusScriptV2 -> Script PlutusScriptV2)
-> PlutusScript PlutusScriptV2
-> ScriptInEra era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusScriptVersion PlutusScriptV2
-> PlutusScript PlutusScriptV2 -> Script PlutusScriptV2
forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
PlutusScript PlutusScriptVersion PlutusScriptV2
PlutusScriptV2
                (PlutusScript PlutusScriptV2 -> ScriptInEra era)
-> PlutusScript PlutusScriptV2 -> ScriptInEra era
forall a b. (a -> b) -> a -> b
$ ShortByteString -> PlutusScript PlutusScriptV2
forall lang. ShortByteString -> PlutusScript lang
PlutusScriptSerialised ShortByteString
s
        Alonzo.TimelockScript Timelock StandardBabbage
s ->
          ScriptLanguageInEra SimpleScript' era
-> Script SimpleScript' -> ScriptInEra era
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScript' era
ScriptLanguageInEra SimpleScript' BabbageEra
SimpleScriptInBabbage
            (Script SimpleScript' -> ScriptInEra era)
-> (SimpleScript -> Script SimpleScript')
-> SimpleScript
-> ScriptInEra era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleScript -> Script SimpleScript'
SimpleScript
            (SimpleScript -> ScriptInEra era)
-> SimpleScript -> ScriptInEra era
forall a b. (a -> b) -> a -> b
$ NativeScript StandardBabbage -> SimpleScript
forall era.
(AllegraEraScript era, EraCrypto era ~ StandardCrypto) =>
NativeScript era -> SimpleScript
fromAllegraTimelock Timelock StandardBabbage
NativeScript StandardBabbage
s
    ShelleyBasedEra era
ShelleyBasedEraConway ->
      case Script (ShelleyLedgerEra era)
script of
        Alonzo.PlutusScript PlutusScript StandardConway
plutusV ->
          case PlutusScript StandardConway
plutusV of
            Conway.ConwayPlutusV1 (PlutusScriptBinary ShortByteString
s) ->
              ScriptLanguageInEra PlutusScriptV1 era
-> Script PlutusScriptV1 -> ScriptInEra era
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra PlutusScriptV1 era
ScriptLanguageInEra PlutusScriptV1 ConwayEra
PlutusScriptV1InConway
                (Script PlutusScriptV1 -> ScriptInEra era)
-> (PlutusScript PlutusScriptV1 -> Script PlutusScriptV1)
-> PlutusScript PlutusScriptV1
-> ScriptInEra era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusScriptVersion PlutusScriptV1
-> PlutusScript PlutusScriptV1 -> Script PlutusScriptV1
forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
PlutusScript PlutusScriptVersion PlutusScriptV1
PlutusScriptV1
                (PlutusScript PlutusScriptV1 -> ScriptInEra era)
-> PlutusScript PlutusScriptV1 -> ScriptInEra era
forall a b. (a -> b) -> a -> b
$ ShortByteString -> PlutusScript PlutusScriptV1
forall lang. ShortByteString -> PlutusScript lang
PlutusScriptSerialised ShortByteString
s
            Conway.ConwayPlutusV2 (PlutusScriptBinary ShortByteString
s) ->
              ScriptLanguageInEra PlutusScriptV2 era
-> Script PlutusScriptV2 -> ScriptInEra era
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra PlutusScriptV2 era
ScriptLanguageInEra PlutusScriptV2 ConwayEra
PlutusScriptV2InConway
                (Script PlutusScriptV2 -> ScriptInEra era)
-> (PlutusScript PlutusScriptV2 -> Script PlutusScriptV2)
-> PlutusScript PlutusScriptV2
-> ScriptInEra era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusScriptVersion PlutusScriptV2
-> PlutusScript PlutusScriptV2 -> Script PlutusScriptV2
forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
PlutusScript PlutusScriptVersion PlutusScriptV2
PlutusScriptV2
                (PlutusScript PlutusScriptV2 -> ScriptInEra era)
-> PlutusScript PlutusScriptV2 -> ScriptInEra era
forall a b. (a -> b) -> a -> b
$ ShortByteString -> PlutusScript PlutusScriptV2
forall lang. ShortByteString -> PlutusScript lang
PlutusScriptSerialised ShortByteString
s
            Conway.ConwayPlutusV3 (PlutusScriptBinary ShortByteString
s) ->
              ScriptLanguageInEra PlutusScriptV3 era
-> Script PlutusScriptV3 -> ScriptInEra era
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra PlutusScriptV3 era
ScriptLanguageInEra PlutusScriptV3 ConwayEra
PlutusScriptV3InConway
                (Script PlutusScriptV3 -> ScriptInEra era)
-> (PlutusScript PlutusScriptV3 -> Script PlutusScriptV3)
-> PlutusScript PlutusScriptV3
-> ScriptInEra era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusScriptVersion PlutusScriptV3
-> PlutusScript PlutusScriptV3 -> Script PlutusScriptV3
forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
PlutusScript PlutusScriptVersion PlutusScriptV3
PlutusScriptV3
                (PlutusScript PlutusScriptV3 -> ScriptInEra era)
-> PlutusScript PlutusScriptV3 -> ScriptInEra era
forall a b. (a -> b) -> a -> b
$ ShortByteString -> PlutusScript PlutusScriptV3
forall lang. ShortByteString -> PlutusScript lang
PlutusScriptSerialised ShortByteString
s
        Alonzo.TimelockScript Timelock StandardConway
s ->
          ScriptLanguageInEra SimpleScript' era
-> Script SimpleScript' -> ScriptInEra era
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScript' era
ScriptLanguageInEra SimpleScript' ConwayEra
SimpleScriptInConway
            (Script SimpleScript' -> ScriptInEra era)
-> (SimpleScript -> Script SimpleScript')
-> SimpleScript
-> ScriptInEra era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleScript -> Script SimpleScript'
SimpleScript
            (SimpleScript -> ScriptInEra era)
-> SimpleScript -> ScriptInEra era
forall a b. (a -> b) -> a -> b
$ NativeScript StandardConway -> SimpleScript
forall era.
(AllegraEraScript era, EraCrypto era ~ StandardCrypto) =>
NativeScript era -> SimpleScript
fromAllegraTimelock Timelock StandardConway
NativeScript StandardConway
s

data MultiSigError = MultiSigErrorTimelockNotsupported deriving Int -> MultiSigError -> ShowS
[MultiSigError] -> ShowS
MultiSigError -> [Char]
(Int -> MultiSigError -> ShowS)
-> (MultiSigError -> [Char])
-> ([MultiSigError] -> ShowS)
-> Show MultiSigError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MultiSigError -> ShowS
showsPrec :: Int -> MultiSigError -> ShowS
$cshow :: MultiSigError -> [Char]
show :: MultiSigError -> [Char]
$cshowList :: [MultiSigError] -> ShowS
showList :: [MultiSigError] -> ShowS
Show

-- | Conversion for the 'Shelley.MultiSig' language used by the Shelley era.
toShelleyMultiSig
  :: SimpleScript
  -> Either MultiSigError (Shelley.MultiSig (ShelleyLedgerEra ShelleyEra))
toShelleyMultiSig :: SimpleScript
-> Either MultiSigError (MultiSig (ShelleyLedgerEra ShelleyEra))
toShelleyMultiSig = SimpleScript
-> Either MultiSigError (MultiSig (ShelleyLedgerEra ShelleyEra))
go
 where
  go :: SimpleScript -> Either MultiSigError (Shelley.MultiSig (ShelleyLedgerEra ShelleyEra))
  go :: SimpleScript
-> Either MultiSigError (MultiSig (ShelleyLedgerEra ShelleyEra))
go (RequireSignature (PaymentKeyHash KeyHash 'Payment StandardCrypto
kh)) =
    MultiSig (ShelleyLedgerEra ShelleyEra)
-> Either MultiSigError (MultiSig (ShelleyLedgerEra ShelleyEra))
forall a. a -> Either MultiSigError a
forall (m :: * -> *) a. Monad m => a -> m a
return (MultiSig (ShelleyLedgerEra ShelleyEra)
 -> Either MultiSigError (MultiSig (ShelleyLedgerEra ShelleyEra)))
-> MultiSig (ShelleyLedgerEra ShelleyEra)
-> Either MultiSigError (MultiSig (ShelleyLedgerEra ShelleyEra))
forall a b. (a -> b) -> a -> b
$ KeyHash 'Witness (EraCrypto (ShelleyEra StandardCrypto))
-> NativeScript (ShelleyEra StandardCrypto)
forall era.
ShelleyEraScript era =>
KeyHash 'Witness (EraCrypto era) -> NativeScript era
Shelley.RequireSignature (KeyHash 'Payment StandardCrypto -> KeyHash 'Witness StandardCrypto
forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
Shelley.asWitness KeyHash 'Payment StandardCrypto
kh)
  go (RequireAllOf [SimpleScript]
s) = (SimpleScript
 -> Either MultiSigError (MultiSig (ShelleyEra StandardCrypto)))
-> [SimpleScript]
-> Either MultiSigError [MultiSig (ShelleyEra StandardCrypto)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM SimpleScript
-> Either MultiSigError (MultiSig (ShelleyEra StandardCrypto))
SimpleScript
-> Either MultiSigError (MultiSig (ShelleyLedgerEra ShelleyEra))
go [SimpleScript]
s Either MultiSigError [MultiSig (ShelleyEra StandardCrypto)]
-> ([MultiSig (ShelleyEra StandardCrypto)]
    -> MultiSig (ShelleyEra StandardCrypto))
-> Either MultiSigError (MultiSig (ShelleyEra StandardCrypto))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> StrictSeq (NativeScript (ShelleyEra StandardCrypto))
-> NativeScript (ShelleyEra StandardCrypto)
StrictSeq (NativeScript (ShelleyEra StandardCrypto))
-> MultiSig (ShelleyEra StandardCrypto)
forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
Shelley.RequireAllOf (StrictSeq (NativeScript (ShelleyEra StandardCrypto))
 -> MultiSig (ShelleyEra StandardCrypto))
-> ([MultiSig (ShelleyEra StandardCrypto)]
    -> StrictSeq (NativeScript (ShelleyEra StandardCrypto)))
-> [MultiSig (ShelleyEra StandardCrypto)]
-> MultiSig (ShelleyEra StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Item (StrictSeq (NativeScript (ShelleyEra StandardCrypto)))]
-> StrictSeq (NativeScript (ShelleyEra StandardCrypto))
[MultiSig (ShelleyEra StandardCrypto)]
-> StrictSeq (NativeScript (ShelleyEra StandardCrypto))
forall l. IsList l => [Item l] -> l
fromList
  go (RequireAnyOf [SimpleScript]
s) = (SimpleScript
 -> Either MultiSigError (MultiSig (ShelleyEra StandardCrypto)))
-> [SimpleScript]
-> Either MultiSigError [MultiSig (ShelleyEra StandardCrypto)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM SimpleScript
-> Either MultiSigError (MultiSig (ShelleyEra StandardCrypto))
SimpleScript
-> Either MultiSigError (MultiSig (ShelleyLedgerEra ShelleyEra))
go [SimpleScript]
s Either MultiSigError [MultiSig (ShelleyEra StandardCrypto)]
-> ([MultiSig (ShelleyEra StandardCrypto)]
    -> MultiSig (ShelleyEra StandardCrypto))
-> Either MultiSigError (MultiSig (ShelleyEra StandardCrypto))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> StrictSeq (NativeScript (ShelleyEra StandardCrypto))
-> NativeScript (ShelleyEra StandardCrypto)
StrictSeq (NativeScript (ShelleyEra StandardCrypto))
-> MultiSig (ShelleyEra StandardCrypto)
forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
Shelley.RequireAnyOf (StrictSeq (NativeScript (ShelleyEra StandardCrypto))
 -> MultiSig (ShelleyEra StandardCrypto))
-> ([MultiSig (ShelleyEra StandardCrypto)]
    -> StrictSeq (NativeScript (ShelleyEra StandardCrypto)))
-> [MultiSig (ShelleyEra StandardCrypto)]
-> MultiSig (ShelleyEra StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Item (StrictSeq (NativeScript (ShelleyEra StandardCrypto)))]
-> StrictSeq (NativeScript (ShelleyEra StandardCrypto))
[MultiSig (ShelleyEra StandardCrypto)]
-> StrictSeq (NativeScript (ShelleyEra StandardCrypto))
forall l. IsList l => [Item l] -> l
fromList
  go (RequireMOf Int
m [SimpleScript]
s) = (SimpleScript
 -> Either MultiSigError (MultiSig (ShelleyEra StandardCrypto)))
-> [SimpleScript]
-> Either MultiSigError [MultiSig (ShelleyEra StandardCrypto)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM SimpleScript
-> Either MultiSigError (MultiSig (ShelleyEra StandardCrypto))
SimpleScript
-> Either MultiSigError (MultiSig (ShelleyLedgerEra ShelleyEra))
go [SimpleScript]
s Either MultiSigError [MultiSig (ShelleyEra StandardCrypto)]
-> ([MultiSig (ShelleyEra StandardCrypto)]
    -> MultiSig (ShelleyEra StandardCrypto))
-> Either MultiSigError (MultiSig (ShelleyEra StandardCrypto))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Int
-> StrictSeq (NativeScript (ShelleyEra StandardCrypto))
-> NativeScript (ShelleyEra StandardCrypto)
forall era.
ShelleyEraScript era =>
Int -> StrictSeq (NativeScript era) -> NativeScript era
Shelley.RequireMOf Int
m (StrictSeq (NativeScript (ShelleyEra StandardCrypto))
 -> MultiSig (ShelleyEra StandardCrypto))
-> ([MultiSig (ShelleyEra StandardCrypto)]
    -> StrictSeq (NativeScript (ShelleyEra StandardCrypto)))
-> [MultiSig (ShelleyEra StandardCrypto)]
-> MultiSig (ShelleyEra StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Item (StrictSeq (NativeScript (ShelleyEra StandardCrypto)))]
-> StrictSeq (NativeScript (ShelleyEra StandardCrypto))
[MultiSig (ShelleyEra StandardCrypto)]
-> StrictSeq (NativeScript (ShelleyEra StandardCrypto))
forall l. IsList l => [Item l] -> l
fromList
  go SimpleScript
_ = MultiSigError
-> Either MultiSigError (MultiSig (ShelleyEra StandardCrypto))
forall a b. a -> Either a b
Left MultiSigError
MultiSigErrorTimelockNotsupported

-- | Conversion for the 'Shelley.MultiSig' language used by the Shelley era.
fromShelleyMultiSig :: Shelley.MultiSig (ShelleyLedgerEra ShelleyEra) -> SimpleScript
fromShelleyMultiSig :: MultiSig (ShelleyLedgerEra ShelleyEra) -> SimpleScript
fromShelleyMultiSig = NativeScript (ShelleyEra StandardCrypto) -> SimpleScript
MultiSig (ShelleyLedgerEra ShelleyEra) -> SimpleScript
forall {era}.
(EraCrypto era ~ StandardCrypto,
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ShelleyEraScript era) =>
NativeScript era -> SimpleScript
go
 where
  go :: Item (StrictSeq (NativeScript era)) -> SimpleScript
go (Shelley.RequireSignature KeyHash 'Witness (EraCrypto era)
kh) =
    Hash PaymentKey -> SimpleScript
RequireSignature
      (KeyHash 'Payment StandardCrypto -> Hash PaymentKey
PaymentKeyHash (KeyHash 'Witness StandardCrypto -> KeyHash 'Payment StandardCrypto
forall (r :: KeyRole) c (r' :: KeyRole).
KeyHash r c -> KeyHash r' c
forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
Shelley.coerceKeyRole KeyHash 'Witness (EraCrypto era)
KeyHash 'Witness StandardCrypto
kh))
  go (Shelley.RequireAllOf StrictSeq (NativeScript era)
s) = [SimpleScript] -> SimpleScript
RequireAllOf ((Item (StrictSeq (NativeScript era)) -> SimpleScript)
-> [Item (StrictSeq (NativeScript era))] -> [SimpleScript]
forall a b. (a -> b) -> [a] -> [b]
map Item (StrictSeq (NativeScript era)) -> SimpleScript
go ([Item (StrictSeq (NativeScript era))] -> [SimpleScript])
-> [Item (StrictSeq (NativeScript era))] -> [SimpleScript]
forall a b. (a -> b) -> a -> b
$ StrictSeq (NativeScript era)
-> [Item (StrictSeq (NativeScript era))]
forall l. IsList l => l -> [Item l]
toList StrictSeq (NativeScript era)
s)
  go (Shelley.RequireAnyOf StrictSeq (NativeScript era)
s) = [SimpleScript] -> SimpleScript
RequireAnyOf ((Item (StrictSeq (NativeScript era)) -> SimpleScript)
-> [Item (StrictSeq (NativeScript era))] -> [SimpleScript]
forall a b. (a -> b) -> [a] -> [b]
map Item (StrictSeq (NativeScript era)) -> SimpleScript
go ([Item (StrictSeq (NativeScript era))] -> [SimpleScript])
-> [Item (StrictSeq (NativeScript era))] -> [SimpleScript]
forall a b. (a -> b) -> a -> b
$ StrictSeq (NativeScript era)
-> [Item (StrictSeq (NativeScript era))]
forall l. IsList l => l -> [Item l]
toList StrictSeq (NativeScript era)
s)
  go (Shelley.RequireMOf Int
m StrictSeq (NativeScript era)
s) = Int -> [SimpleScript] -> SimpleScript
RequireMOf Int
m ((Item (StrictSeq (NativeScript era)) -> SimpleScript)
-> [Item (StrictSeq (NativeScript era))] -> [SimpleScript]
forall a b. (a -> b) -> [a] -> [b]
map Item (StrictSeq (NativeScript era)) -> SimpleScript
go ([Item (StrictSeq (NativeScript era))] -> [SimpleScript])
-> [Item (StrictSeq (NativeScript era))] -> [SimpleScript]
forall a b. (a -> b) -> a -> b
$ StrictSeq (NativeScript era)
-> [Item (StrictSeq (NativeScript era))]
forall l. IsList l => l -> [Item l]
toList StrictSeq (NativeScript era)
s)
  go NativeScript era
_ = [Char] -> SimpleScript
forall a. HasCallStack => [Char] -> a
error [Char]
""

-- | Conversion for the 'Timelock.Timelock' language that is shared between the
-- Allegra and Mary eras.
toAllegraTimelock
  :: forall era
   . ( Allegra.AllegraEraScript era
     , EraCrypto era ~ StandardCrypto
     , Ledger.NativeScript era ~ Allegra.Timelock era
     )
  => SimpleScript -> Ledger.NativeScript era
toAllegraTimelock :: forall era.
(AllegraEraScript era, EraCrypto era ~ StandardCrypto,
 NativeScript era ~ Timelock era) =>
SimpleScript -> NativeScript era
toAllegraTimelock = SimpleScript -> Timelock era
SimpleScript -> NativeScript era
go
 where
  go :: SimpleScript -> Timelock.Timelock era
  go :: SimpleScript -> Timelock era
go (RequireSignature (PaymentKeyHash KeyHash 'Payment StandardCrypto
kh)) =
    KeyHash 'Witness (EraCrypto era) -> NativeScript era
forall era.
ShelleyEraScript era =>
KeyHash 'Witness (EraCrypto era) -> NativeScript era
Shelley.RequireSignature (KeyHash 'Payment StandardCrypto -> KeyHash 'Witness StandardCrypto
forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
Shelley.asWitness KeyHash 'Payment StandardCrypto
kh)
  go (RequireAllOf [SimpleScript]
s) = StrictSeq (NativeScript era) -> NativeScript era
forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
Shelley.RequireAllOf ([Item (StrictSeq (Timelock era))] -> StrictSeq (Timelock era)
forall l. IsList l => [Item l] -> l
fromList ((SimpleScript -> Timelock era) -> [SimpleScript] -> [Timelock era]
forall a b. (a -> b) -> [a] -> [b]
map SimpleScript -> Timelock era
go [SimpleScript]
s))
  go (RequireAnyOf [SimpleScript]
s) = StrictSeq (NativeScript era) -> NativeScript era
forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
Shelley.RequireAnyOf ([Item (StrictSeq (Timelock era))] -> StrictSeq (Timelock era)
forall l. IsList l => [Item l] -> l
fromList ((SimpleScript -> Timelock era) -> [SimpleScript] -> [Timelock era]
forall a b. (a -> b) -> [a] -> [b]
map SimpleScript -> Timelock era
go [SimpleScript]
s))
  go (RequireMOf Int
m [SimpleScript]
s) = Int -> StrictSeq (NativeScript era) -> NativeScript era
forall era.
ShelleyEraScript era =>
Int -> StrictSeq (NativeScript era) -> NativeScript era
Shelley.RequireMOf Int
m ([Item (StrictSeq (Timelock era))] -> StrictSeq (Timelock era)
forall l. IsList l => [Item l] -> l
fromList ((SimpleScript -> Timelock era) -> [SimpleScript] -> [Timelock era]
forall a b. (a -> b) -> [a] -> [b]
map SimpleScript -> Timelock era
go [SimpleScript]
s))
  go (RequireTimeBefore SlotNo
t) = SlotNo -> NativeScript era
forall era. AllegraEraScript era => SlotNo -> NativeScript era
Allegra.RequireTimeExpire SlotNo
t
  go (RequireTimeAfter SlotNo
t) = SlotNo -> NativeScript era
forall era. AllegraEraScript era => SlotNo -> NativeScript era
Allegra.RequireTimeStart SlotNo
t

-- | Conversion for the 'Timelock.Timelock' language that is shared between the
-- Allegra and Mary eras.
fromAllegraTimelock
  :: (Allegra.AllegraEraScript era, EraCrypto era ~ StandardCrypto)
  => Ledger.NativeScript era -> SimpleScript
fromAllegraTimelock :: forall era.
(AllegraEraScript era, EraCrypto era ~ StandardCrypto) =>
NativeScript era -> SimpleScript
fromAllegraTimelock = NativeScript era -> SimpleScript
forall {era}.
(EraCrypto era ~ StandardCrypto,
 Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AllegraEraScript era) =>
NativeScript era -> SimpleScript
go
 where
  go :: Item (StrictSeq (NativeScript era)) -> SimpleScript
go (Shelley.RequireSignature KeyHash 'Witness (EraCrypto era)
kh) = Hash PaymentKey -> SimpleScript
RequireSignature (KeyHash 'Payment StandardCrypto -> Hash PaymentKey
PaymentKeyHash (KeyHash 'Witness StandardCrypto -> KeyHash 'Payment StandardCrypto
forall (r :: KeyRole) c (r' :: KeyRole).
KeyHash r c -> KeyHash r' c
forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
Shelley.coerceKeyRole KeyHash 'Witness (EraCrypto era)
KeyHash 'Witness StandardCrypto
kh))
  go (Allegra.RequireTimeExpire SlotNo
t) = SlotNo -> SimpleScript
RequireTimeBefore SlotNo
t
  go (Allegra.RequireTimeStart SlotNo
t) = SlotNo -> SimpleScript
RequireTimeAfter SlotNo
t
  go (Shelley.RequireAllOf StrictSeq (NativeScript era)
s) = [SimpleScript] -> SimpleScript
RequireAllOf ((Item (StrictSeq (NativeScript era)) -> SimpleScript)
-> [Item (StrictSeq (NativeScript era))] -> [SimpleScript]
forall a b. (a -> b) -> [a] -> [b]
map Item (StrictSeq (NativeScript era)) -> SimpleScript
go (StrictSeq (NativeScript era)
-> [Item (StrictSeq (NativeScript era))]
forall l. IsList l => l -> [Item l]
toList StrictSeq (NativeScript era)
s))
  go (Shelley.RequireAnyOf StrictSeq (NativeScript era)
s) = [SimpleScript] -> SimpleScript
RequireAnyOf ((Item (StrictSeq (NativeScript era)) -> SimpleScript)
-> [Item (StrictSeq (NativeScript era))] -> [SimpleScript]
forall a b. (a -> b) -> [a] -> [b]
map Item (StrictSeq (NativeScript era)) -> SimpleScript
go (StrictSeq (NativeScript era)
-> [Item (StrictSeq (NativeScript era))]
forall l. IsList l => l -> [Item l]
toList StrictSeq (NativeScript era)
s))
  go (Shelley.RequireMOf Int
i StrictSeq (NativeScript era)
s) = Int -> [SimpleScript] -> SimpleScript
RequireMOf Int
i ((Item (StrictSeq (NativeScript era)) -> SimpleScript)
-> [Item (StrictSeq (NativeScript era))] -> [SimpleScript]
forall a b. (a -> b) -> [a] -> [b]
map Item (StrictSeq (NativeScript era)) -> SimpleScript
go (StrictSeq (NativeScript era)
-> [Item (StrictSeq (NativeScript era))]
forall l. IsList l => l -> [Item l]
toList StrictSeq (NativeScript era)
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 where
  toJSON :: SimpleScript -> Value
toJSON (RequireSignature Hash PaymentKey
pKeyHash) =
    [Pair] -> Value
object
      [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"sig"
      , Key
"keyHash" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Hash PaymentKey -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText Hash PaymentKey
pKeyHash
      ]
  toJSON (RequireTimeBefore SlotNo
slot) =
    [Pair] -> Value
object
      [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"before"
      , Key
"slot" Key -> SlotNo -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SlotNo
slot
      ]
  toJSON (RequireTimeAfter SlotNo
slot) =
    [Pair] -> Value
object
      [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"after"
      , Key
"slot" Key -> SlotNo -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SlotNo
slot
      ]
  toJSON (RequireAnyOf [SimpleScript]
reqScripts) =
    [Pair] -> Value
object [Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"any", Key
"scripts" Key -> [Value] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (SimpleScript -> Value) -> [SimpleScript] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map SimpleScript -> Value
forall a. ToJSON a => a -> Value
toJSON [SimpleScript]
reqScripts]
  toJSON (RequireAllOf [SimpleScript]
reqScripts) =
    [Pair] -> Value
object [Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"all", Key
"scripts" Key -> [Value] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (SimpleScript -> Value) -> [SimpleScript] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map SimpleScript -> Value
forall a. ToJSON a => a -> Value
toJSON [SimpleScript]
reqScripts]
  toJSON (RequireMOf Int
reqNum [SimpleScript]
reqScripts) =
    [Pair] -> Value
object
      [ Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"atLeast"
      , Key
"required" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
reqNum
      , Key
"scripts" Key -> [Value] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (SimpleScript -> Value) -> [SimpleScript] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map SimpleScript -> Value
forall a. ToJSON a => a -> Value
toJSON [SimpleScript]
reqScripts
      ]

instance FromJSON SimpleScript where
  parseJSON :: Value -> Parser SimpleScript
parseJSON = Value -> Parser SimpleScript
parseSimpleScript

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

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

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

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

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

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

parseScriptBefore :: Value -> Aeson.Parser SimpleScript
parseScriptBefore :: Value -> Parser SimpleScript
parseScriptBefore =
  [Char]
-> (Object -> Parser SimpleScript) -> Value -> Parser SimpleScript
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject [Char]
"before" ((Object -> Parser SimpleScript) -> Value -> Parser SimpleScript)
-> (Object -> Parser SimpleScript) -> Value -> Parser SimpleScript
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    Text
v <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    case Text
v :: Text of
      Text
"before" -> SlotNo -> SimpleScript
RequireTimeBefore (SlotNo -> SimpleScript) -> Parser SlotNo -> Parser SimpleScript
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser SlotNo
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"slot"
      Text
_ -> [Char] -> Parser SimpleScript
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"\"before\" script value not found"

parseScriptAfter :: Value -> Aeson.Parser SimpleScript
parseScriptAfter :: Value -> Parser SimpleScript
parseScriptAfter =
  [Char]
-> (Object -> Parser SimpleScript) -> Value -> Parser SimpleScript
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject [Char]
"after" ((Object -> Parser SimpleScript) -> Value -> Parser SimpleScript)
-> (Object -> Parser SimpleScript) -> Value -> Parser SimpleScript
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    Text
v <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    case Text
v :: Text of
      Text
"after" -> SlotNo -> SimpleScript
RequireTimeAfter (SlotNo -> SimpleScript) -> Parser SlotNo -> Parser SimpleScript
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser SlotNo
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"slot"
      Text
_ -> [Char] -> Parser SimpleScript
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"\"after\" script value not found"

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

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

-- | A reference scripts is a script that can exist at a transaction output. This greatly
-- reduces the size of transactions that use scripts as the script no longer
-- has to be added to the transaction, they can now be referenced via a transaction output.
data ReferenceScript era where
  ReferenceScript
    :: BabbageEraOnwards era
    -> ScriptInAnyLang
    -> ReferenceScript era
  ReferenceScriptNone :: ReferenceScript era

deriving instance Eq (ReferenceScript era)

deriving instance Show (ReferenceScript era)

deriving instance Typeable (ReferenceScript era)

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

instance IsCardanoEra era => FromJSON (ReferenceScript era) where
  parseJSON :: Value -> Parser (ReferenceScript era)
parseJSON = [Char]
-> (Object -> Parser (ReferenceScript era))
-> Value
-> Parser (ReferenceScript era)
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject [Char]
"ReferenceScript" ((Object -> Parser (ReferenceScript era))
 -> Value -> Parser (ReferenceScript era))
-> (Object -> Parser (ReferenceScript era))
-> Value
-> Parser (ReferenceScript era)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    (ByronToAlonzoEraConstraints era =>
 ByronToAlonzoEra era -> Parser (ReferenceScript era))
-> (BabbageEraOnwardsConstraints era =>
    BabbageEraOnwards era -> Parser (ReferenceScript era))
-> CardanoEra era
-> Parser (ReferenceScript era)
forall era a.
(ByronToAlonzoEraConstraints era => ByronToAlonzoEra era -> a)
-> (BabbageEraOnwardsConstraints era => BabbageEraOnwards era -> a)
-> CardanoEra era
-> a
caseByronToAlonzoOrBabbageEraOnwards
      (Parser (ReferenceScript era)
-> ByronToAlonzoEra era -> Parser (ReferenceScript era)
forall a b. a -> b -> a
const (ReferenceScript era -> Parser (ReferenceScript era)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReferenceScript era
forall era. ReferenceScript era
ReferenceScriptNone))
      (\BabbageEraOnwards era
w -> BabbageEraOnwards era -> ScriptInAnyLang -> ReferenceScript era
forall era.
BabbageEraOnwards era -> ScriptInAnyLang -> ReferenceScript era
ReferenceScript BabbageEraOnwards era
w (ScriptInAnyLang -> ReferenceScript era)
-> Parser ScriptInAnyLang -> Parser (ReferenceScript era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ScriptInAnyLang
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"referenceScript")
      (CardanoEra era
forall era. IsCardanoEra era => CardanoEra era
cardanoEra :: CardanoEra era)

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

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

scriptInEraToRefScript :: ScriptInEra era -> ReferenceScript era
scriptInEraToRefScript :: forall era. ScriptInEra era -> ReferenceScript era
scriptInEraToRefScript sIne :: ScriptInEra era
sIne@(ScriptInEra ScriptLanguageInEra lang era
_ Script lang
s) =
  (ShelleyToAlonzoEraConstraints era =>
 ShelleyToAlonzoEra era -> ReferenceScript era)
-> (BabbageEraOnwardsConstraints era =>
    BabbageEraOnwards era -> ReferenceScript era)
-> ShelleyBasedEra era
-> ReferenceScript era
forall era a.
(ShelleyToAlonzoEraConstraints era => ShelleyToAlonzoEra era -> a)
-> (BabbageEraOnwardsConstraints era => BabbageEraOnwards era -> a)
-> ShelleyBasedEra era
-> a
caseShelleyToAlonzoOrBabbageEraOnwards
    (ReferenceScript era
-> ShelleyToAlonzoEra era -> ReferenceScript era
forall a b. a -> b -> a
const ReferenceScript era
forall era. ReferenceScript era
ReferenceScriptNone)
    (\BabbageEraOnwards era
w -> BabbageEraOnwards era -> ScriptInAnyLang -> ReferenceScript era
forall era.
BabbageEraOnwards era -> ScriptInAnyLang -> ReferenceScript era
ReferenceScript BabbageEraOnwards era
w (ScriptInAnyLang -> ReferenceScript era)
-> ScriptInAnyLang -> ReferenceScript era
forall a b. (a -> b) -> a -> b
$ Script lang -> ScriptInAnyLang
forall lang. Script lang -> ScriptInAnyLang
toScriptInAnyLang Script lang
s) -- Any script can be a reference script
    (ScriptInEra era -> ShelleyBasedEra era
forall era. ScriptInEra era -> ShelleyBasedEra era
eraOfScriptInEra ScriptInEra era
sIne)

-- Helpers

textEnvelopeToScript :: TextEnvelope -> Either TextEnvelopeError ScriptInAnyLang
textEnvelopeToScript :: TextEnvelope -> Either TextEnvelopeError ScriptInAnyLang
textEnvelopeToScript = [FromSomeType HasTextEnvelope ScriptInAnyLang]
-> TextEnvelope -> Either TextEnvelopeError ScriptInAnyLang
forall b.
[FromSomeType HasTextEnvelope b]
-> TextEnvelope -> Either TextEnvelopeError b
deserialiseFromTextEnvelopeAnyOf [FromSomeType HasTextEnvelope ScriptInAnyLang]
textEnvTypes
 where
  textEnvTypes :: [FromSomeType HasTextEnvelope ScriptInAnyLang]
  textEnvTypes :: [FromSomeType HasTextEnvelope ScriptInAnyLang]
textEnvTypes =
    [ AsType (Script SimpleScript')
-> (Script SimpleScript' -> ScriptInAnyLang)
-> FromSomeType HasTextEnvelope ScriptInAnyLang
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType
        (AsType SimpleScript' -> AsType (Script SimpleScript')
forall lang. AsType lang -> AsType (Script lang)
AsScript AsType SimpleScript'
AsSimpleScript)
        (ScriptLanguage SimpleScript'
-> Script SimpleScript' -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang ScriptLanguage SimpleScript'
SimpleScriptLanguage)
    , AsType (Script PlutusScriptV1)
-> (Script PlutusScriptV1 -> ScriptInAnyLang)
-> FromSomeType HasTextEnvelope ScriptInAnyLang
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType
        (AsType PlutusScriptV1 -> AsType (Script PlutusScriptV1)
forall lang. AsType lang -> AsType (Script lang)
AsScript AsType PlutusScriptV1
AsPlutusScriptV1)
        (ScriptLanguage PlutusScriptV1
-> Script PlutusScriptV1 -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang (PlutusScriptVersion PlutusScriptV1 -> ScriptLanguage PlutusScriptV1
forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion PlutusScriptV1
PlutusScriptV1))
    , AsType (Script PlutusScriptV2)
-> (Script PlutusScriptV2 -> ScriptInAnyLang)
-> FromSomeType HasTextEnvelope ScriptInAnyLang
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType
        (AsType PlutusScriptV2 -> AsType (Script PlutusScriptV2)
forall lang. AsType lang -> AsType (Script lang)
AsScript AsType PlutusScriptV2
AsPlutusScriptV2)
        (ScriptLanguage PlutusScriptV2
-> Script PlutusScriptV2 -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang (PlutusScriptVersion PlutusScriptV2 -> ScriptLanguage PlutusScriptV2
forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion PlutusScriptV2
PlutusScriptV2))
    , AsType (Script PlutusScriptV3)
-> (Script PlutusScriptV3 -> ScriptInAnyLang)
-> FromSomeType HasTextEnvelope ScriptInAnyLang
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType
        (AsType PlutusScriptV3 -> AsType (Script PlutusScriptV3)
forall lang. AsType lang -> AsType (Script lang)
AsScript AsType PlutusScriptV3
AsPlutusScriptV3)
        (ScriptLanguage PlutusScriptV3
-> Script PlutusScriptV3 -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang (PlutusScriptVersion PlutusScriptV3 -> ScriptLanguage PlutusScriptV3
forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion PlutusScriptV3
PlutusScriptV3))
    ]