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

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

module Cardano.Api.Script (
    -- * Languages
    SimpleScript',
    PlutusScriptV1,
    PlutusScriptV2,
    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,

    -- * Reference scripts
    ReferenceScript(..),
    ReferenceTxInsScriptsInlineDatumsSupportedInEra(..),
    refInsScriptsAndInlineDatsSupportedInEra,
    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,

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

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.Foldable (toList)
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           Numeric.Natural (Natural)

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

import           Control.Applicative
import           Control.Monad

import qualified Cardano.Binary as CBOR

import qualified Cardano.Crypto.Hash.Class as Crypto

import           Cardano.Slotting.Slot (SlotNo)

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

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

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

import qualified PlutusLedgerApi.Test.Examples as Plutus

import           Cardano.Api.EraCast
import           Cardano.Api.Eras
import           Cardano.Api.Error
import           Cardano.Api.Hash
import           Cardano.Api.HasTypeProxy
import           Cardano.Api.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 Data.Sequence.Strict as Seq

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

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

-- ----------------------------------------------------------------------------
-- 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 = forall a. a -> Maybe a
Just forall {k} (a :: k). a :~: a
Refl

    testEquality (PlutusScriptLanguage PlutusScriptVersion a
lang)
                 (PlutusScriptLanguage PlutusScriptVersion b
lang') = 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
_ = forall a. Maybe a
Nothing


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

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

instance TestEquality PlutusScriptVersion where
    testEquality :: forall a b.
PlutusScriptVersion a -> PlutusScriptVersion b -> Maybe (a :~: b)
testEquality PlutusScriptVersion a
PlutusScriptV1 PlutusScriptVersion b
PlutusScriptV1 = forall a. a -> Maybe a
Just forall {k} (a :: k). a :~: a
Refl
    testEquality PlutusScriptVersion a
PlutusScriptV2 PlutusScriptVersion b
PlutusScriptV2 = forall a. a -> Maybe a
Just forall {k} (a :: k). a :~: a
Refl
    testEquality PlutusScriptVersion a
_ PlutusScriptVersion 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 = forall a. Enum a => a -> Int
fromEnum AnyScriptLanguage
a forall a. Eq a => a -> a -> Bool
== forall a. Enum a => a -> Int
fromEnum AnyScriptLanguage
b

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

instance Enum AnyScriptLanguage where
    toEnum :: Int -> AnyScriptLanguage
toEnum Int
0 = forall a. ScriptLanguage a -> AnyScriptLanguage
AnyScriptLanguage ScriptLanguage SimpleScript'
SimpleScriptLanguage
    toEnum Int
1 = forall a. ScriptLanguage a -> AnyScriptLanguage
AnyScriptLanguage (forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion PlutusScriptV1
PlutusScriptV1)
    toEnum Int
2 = forall a. ScriptLanguage a -> AnyScriptLanguage
AnyScriptLanguage (forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion PlutusScriptV2
PlutusScriptV2)
    toEnum Int
err = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"AnyScriptLanguage.toEnum: bad argument: " forall a. Semigroup a => a -> a -> a
<> 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

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


data AnyPlutusScriptVersion where
     AnyPlutusScriptVersion :: PlutusScriptVersion lang
                            -> AnyPlutusScriptVersion

deriving instance (Show AnyPlutusScriptVersion)

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

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

instance Enum AnyPlutusScriptVersion where
    toEnum :: Int -> AnyPlutusScriptVersion
toEnum Int
0 = forall a. PlutusScriptVersion a -> AnyPlutusScriptVersion
AnyPlutusScriptVersion PlutusScriptVersion PlutusScriptV1
PlutusScriptV1
    toEnum Int
1 = forall a. PlutusScriptVersion a -> AnyPlutusScriptVersion
AnyPlutusScriptVersion PlutusScriptVersion PlutusScriptV2
PlutusScriptV2
    toEnum Int
err = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"AnyPlutusScriptVersion.toEnum: bad argument: " forall a. Semigroup a => a -> a -> a
<> 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

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

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

instance FromCBOR AnyPlutusScriptVersion where
    fromCBOR :: forall s. Decoder s AnyPlutusScriptVersion
fromCBOR = do
      Int
n <- forall a s. FromCBOR a => Decoder s a
fromCBOR
      if Int
n forall a. Ord a => a -> a -> Bool
>= forall a. Enum a => a -> Int
fromEnum (forall a. Bounded a => a
minBound :: AnyPlutusScriptVersion) Bool -> Bool -> Bool
&&
         Int
n forall a. Ord a => a -> a -> Bool
<= forall a. Enum a => a -> Int
fromEnum (forall a. Bounded a => a
maxBound :: AnyPlutusScriptVersion)
        then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Enum a => Int -> a
toEnum Int
n
        else 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"

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

instance FromJSON AnyPlutusScriptVersion where
    parseJSON :: Value -> Parser AnyPlutusScriptVersion
parseJSON = 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 = forall a. (Text -> Parser a) -> FromJSONKeyFunction a
Aeson.FromJSONKeyTextParser Text -> Parser AnyPlutusScriptVersion
parsePlutusScriptVersion

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

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

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


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 = forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion PlutusScriptV1
PlutusScriptV1

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

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

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

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

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

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

     SimpleScript :: !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)
_ = forall lang. AsType lang -> AsType (Script lang)
AsScript (forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType (forall {k} (t :: k). Proxy t
Proxy :: Proxy lang))

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

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

    serialiseToCBOR (PlutusScript PlutusScriptVersion lang
PlutusScriptV2 PlutusScript lang
s) =
      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 forall lang. IsScriptLanguage lang => ScriptLanguage lang
scriptLanguage :: ScriptLanguage lang of
        ScriptLanguage lang
SimpleScriptLanguage ->
              SimpleScript -> Script SimpleScript'
SimpleScript forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timelock StandardCrypto -> SimpleScript
fromAllegraTimelock
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
CBOR.decodeAnnotator Text
"Script" forall a s. FromCBOR a => Decoder s a
fromCBOR (ByteString -> ByteString
LBS.fromStrict ByteString
bs)

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

        PlutusScriptLanguage PlutusScriptVersion lang
PlutusScriptV2 ->
              forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
PlutusScript PlutusScriptVersion PlutusScriptV2
PlutusScriptV2
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 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"


-- ----------------------------------------------------------------------------
-- 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 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 forall a. Eq a => a -> a -> Bool
== Script lang
script'

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

instance FromJSON ScriptInAnyLang where
  parseJSON :: Value -> Parser ScriptInAnyLang
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject [Char]
"ScriptInAnyLang" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    TextEnvelope
textEnvelopeScript <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"script"
    case TextEnvelope -> Either TextEnvelopeError ScriptInAnyLang
textEnvelopeToScript TextEnvelope
textEnvelopeScript of
      Left TextEnvelopeError
textEnvErr -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ forall e. Error e => e -> [Char]
displayError TextEnvelopeError
textEnvErr
      Right (ScriptInAnyLang ScriptLanguage lang
l Script lang
s) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. ScriptLanguage a -> Script a -> 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
_) =
    forall a. ScriptLanguage a -> Script a -> ScriptInAnyLang
ScriptInAnyLang ScriptLanguage SimpleScript'
SimpleScriptLanguage Script lang
s
toScriptInAnyLang s :: Script lang
s@(PlutusScript PlutusScriptVersion lang
v PlutusScript lang
_) =
    forall a. ScriptLanguage a -> Script a -> ScriptInAnyLang
ScriptInAnyLang (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 forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall lang era.
ScriptLanguageInEra lang era -> ScriptLanguage lang
languageOfScriptLanguageInEra ScriptLanguageInEra lang era
langInEra)
                        (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 forall a. Eq a => a -> a -> Bool
== 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



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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ 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)
_ = forall era. AsType era -> AsType (ScriptInEra era)
AsScriptInEra (forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType (forall {k} (t :: k). Proxy t
Proxy :: Proxy era))


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

      (CardanoEra era
AllegraEra, ScriptLanguage lang
SimpleScriptLanguage) ->
        forall a. a -> Maybe a
Just ScriptLanguageInEra SimpleScript' AllegraEra
SimpleScriptInAllegra

      (CardanoEra era
MaryEra, ScriptLanguage lang
SimpleScriptLanguage) ->
        forall a. a -> Maybe a
Just ScriptLanguageInEra SimpleScript' MaryEra
SimpleScriptInMary

      (CardanoEra era
AlonzoEra, ScriptLanguage lang
SimpleScriptLanguage) ->
        forall a. a -> Maybe a
Just ScriptLanguageInEra SimpleScript' AlonzoEra
SimpleScriptInAlonzo

      (CardanoEra era
BabbageEra, ScriptLanguage lang
SimpleScriptLanguage) ->
        forall a. a -> Maybe a
Just ScriptLanguageInEra SimpleScript' BabbageEra
SimpleScriptInBabbage

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

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

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

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

      (CardanoEra era, ScriptLanguage lang)
_ -> 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 SimpleScript'
SimpleScriptLanguage
      ScriptLanguageInEra lang era
SimpleScriptInAllegra   -> ScriptLanguage SimpleScript'
SimpleScriptLanguage
      ScriptLanguageInEra lang era
SimpleScriptInMary      -> ScriptLanguage SimpleScript'
SimpleScriptLanguage
      ScriptLanguageInEra lang era
SimpleScriptInAlonzo    -> ScriptLanguage SimpleScript'
SimpleScriptLanguage
      ScriptLanguageInEra lang era
SimpleScriptInBabbage   -> ScriptLanguage SimpleScript'
SimpleScriptLanguage
      ScriptLanguageInEra lang era
SimpleScriptInConway    -> ScriptLanguage SimpleScript'
SimpleScriptLanguage

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

      ScriptLanguageInEra lang era
PlutusScriptV2InBabbage -> forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion PlutusScriptV2
PlutusScriptV2
      ScriptLanguageInEra lang era
PlutusScriptV2InConway  -> forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion PlutusScriptV2
PlutusScriptV2

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

      ScriptLanguageInEra lang era
SimpleScriptInAllegra   -> ShelleyBasedEra AllegraEra
ShelleyBasedEraAllegra

      ScriptLanguageInEra lang era
SimpleScriptInMary      -> ShelleyBasedEra MaryEra
ShelleyBasedEraMary

      ScriptLanguageInEra lang era
SimpleScriptInAlonzo    -> ShelleyBasedEra AlonzoEra
ShelleyBasedEraAlonzo
      ScriptLanguageInEra lang era
PlutusScriptV1InAlonzo  -> ShelleyBasedEra AlonzoEra
ShelleyBasedEraAlonzo

      ScriptLanguageInEra lang era
SimpleScriptInBabbage   -> ShelleyBasedEra BabbageEra
ShelleyBasedEraBabbage
      ScriptLanguageInEra lang era
SimpleScriptInConway    -> ShelleyBasedEra ConwayEra
ShelleyBasedEraConway

      ScriptLanguageInEra lang era
PlutusScriptV1InBabbage -> ShelleyBasedEra BabbageEra
ShelleyBasedEraBabbage
      ScriptLanguageInEra lang era
PlutusScriptV1InConway  -> ShelleyBasedEra ConwayEra
ShelleyBasedEraConway
      ScriptLanguageInEra lang era
PlutusScriptV2InBabbage -> ShelleyBasedEra BabbageEra
ShelleyBasedEraBabbage
      ScriptLanguageInEra lang era
PlutusScriptV2InConway  -> 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 :: CardanoEra era -> ScriptInAnyLang -> Maybe (ScriptInEra era)
toScriptInEra :: forall era.
CardanoEra era -> ScriptInAnyLang -> Maybe (ScriptInEra era)
toScriptInEra CardanoEra era
era (ScriptInAnyLang ScriptLanguage lang
lang Script lang
s) = do
    ScriptLanguageInEra lang era
lang' <- forall era lang.
CardanoEra era
-> ScriptLanguage lang -> Maybe (ScriptLanguageInEra lang era)
scriptLanguageSupportedInEra CardanoEra era
era ScriptLanguage lang
lang
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a era.
ScriptLanguageInEra a era -> Script a -> 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
_) = forall lang era.
ScriptLanguageInEra lang era -> ShelleyBasedEra era
eraOfScriptLanguageInEra ScriptLanguageInEra lang era
langInEra

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

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

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

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


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

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


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

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

     SimpleScriptWitness :: ScriptLanguageInEra 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 forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall lang era.
ScriptLanguageInEra lang era -> ScriptLanguage lang
languageOfScriptLanguageInEra ScriptLanguageInEra SimpleScript' era
langInEra)
                        (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 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 forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall lang era.
ScriptLanguageInEra lang era -> ScriptLanguage lang
languageOfScriptLanguageInEra ScriptLanguageInEra lang era
langInEra)
                        (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   forall a. Eq a => a -> a -> Bool
== PlutusScriptVersion lang
version'
                     Bool -> Bool -> Bool
&& PlutusScriptOrReferenceInput lang
script    forall a. Eq a => a -> a -> Bool
== PlutusScriptOrReferenceInput lang
script'
                     Bool -> Bool -> Bool
&& ScriptDatum witctx
datum     forall a. Eq a => a -> a -> Bool
== ScriptDatum witctx
datum'
                     Bool -> Bool -> Bool
&& HashableScriptData
redeemer  forall a. Eq a => a -> a -> Bool
== HashableScriptData
redeemer'
                     Bool -> Bool -> Bool
&& ExecutionUnits
execUnits 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    :: 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)) =
    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a era.
ScriptLanguageInEra a era -> Script a -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScript' ShelleyEra
SimpleScriptInShelley (SimpleScript -> Script SimpleScript'
SimpleScript SimpleScript
script)

scriptWitnessScript (SimpleScriptWitness ScriptLanguageInEra SimpleScript' era
SimpleScriptInAllegra (SScript SimpleScript
script)) =
    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a era.
ScriptLanguageInEra a era -> Script a -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScript' AllegraEra
SimpleScriptInAllegra (SimpleScript -> Script SimpleScript'
SimpleScript SimpleScript
script)

scriptWitnessScript (SimpleScriptWitness ScriptLanguageInEra SimpleScript' era
SimpleScriptInMary (SScript SimpleScript
script)) =
    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a era.
ScriptLanguageInEra a era -> Script a -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScript' MaryEra
SimpleScriptInMary (SimpleScript -> Script SimpleScript'
SimpleScript SimpleScript
script)

scriptWitnessScript (SimpleScriptWitness ScriptLanguageInEra SimpleScript' era
SimpleScriptInAlonzo (SScript SimpleScript
script)) =
    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a era.
ScriptLanguageInEra a era -> Script a -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScript' AlonzoEra
SimpleScriptInAlonzo (SimpleScript -> Script SimpleScript'
SimpleScript SimpleScript
script)

scriptWitnessScript (SimpleScriptWitness ScriptLanguageInEra SimpleScript' era
SimpleScriptInBabbage (SScript SimpleScript
script)) =
    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a era.
ScriptLanguageInEra a era -> Script a -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScript' BabbageEra
SimpleScriptInBabbage (SimpleScript -> Script SimpleScript'
SimpleScript SimpleScript
script)

scriptWitnessScript (SimpleScriptWitness ScriptLanguageInEra SimpleScript' era
SimpleScriptInConway (SScript SimpleScript
script)) =
    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a era.
ScriptLanguageInEra a era -> Script a -> ScriptInEra era
ScriptInEra 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
_) =
    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a era.
ScriptLanguageInEra a era -> Script a -> ScriptInEra era
ScriptInEra ScriptLanguageInEra lang era
langInEra (forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
PlutusScript PlutusScriptVersion lang
version PlutusScript lang
script)

scriptWitnessScript (SimpleScriptWitness ScriptLanguageInEra SimpleScript' era
_ (SReferenceScript TxIn
_ Maybe ScriptHash
_)) =
    forall a. Maybe a
Nothing

scriptWitnessScript (PlutusScriptWitness ScriptLanguageInEra lang era
_ PlutusScriptVersion lang
_ (PReferenceScript TxIn
_ Maybe ScriptHash
_) ScriptDatum witctx
_ HashableScriptData
_ ExecutionUnits
_) =
    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 {
        -- | This corresponds roughly to the time to execute a script.
        ExecutionUnits -> Natural
executionSteps  :: Natural,

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

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

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

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

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

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

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


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

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

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

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

    deserialiseFromRawBytes :: AsType ScriptHash
-> ByteString -> Either SerialiseAsRawBytesError ScriptHash
deserialiseFromRawBytes AsType ScriptHash
R:AsTypeScriptHash
AsScriptHash ByteString
bs =
      forall b a. b -> Maybe a -> Either b a
maybeToRight ([Char] -> SerialiseAsRawBytesError
SerialiseAsRawBytesError [Char]
"Enable to deserialise ScriptHash") forall a b. (a -> b) -> a -> b
$
        ScriptHash StandardCrypto -> ScriptHash
ScriptHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall crypto.
Hash (ADDRHASH crypto) EraIndependentScript -> ScriptHash crypto
Shelley.ScriptHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraScript era => Script era -> ScriptHash (Crypto era)
Ledger.hashScript @(ShelleyLedgerEra AllegraEra)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SimpleScript -> Timelock StandardCrypto
toAllegraTimelock :: SimpleScript -> Timelock.Timelock StandardCrypto)
  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
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraScript era => Script era -> ScriptHash (Crypto era)
Ledger.hashScript @(ShelleyLedgerEra AlonzoEra)
  forall a b. (a -> b) -> a -> b
$ forall era. Language -> ShortByteString -> AlonzoScript era
Alonzo.PlutusScript Language
Alonzo.PlutusV1 ShortByteString
script

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

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

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


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

data SimpleScript
  = RequireSignature !(Hash PaymentKey)
  | RequireTimeBefore !SlotNo
  | RequireTimeAfter !SlotNo
  | RequireAllOf ![SimpleScript]
  | RequireAnyOf ![SimpleScript]
  | RequireMOf !Int ![SimpleScript]
  deriving (SimpleScript -> SimpleScript -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimpleScript -> SimpleScript -> Bool
$c/= :: SimpleScript -> SimpleScript -> Bool
== :: SimpleScript -> SimpleScript -> Bool
$c== :: SimpleScript -> SimpleScript -> Bool
Eq, Int -> SimpleScript -> ShowS
[SimpleScript] -> ShowS
SimpleScript -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SimpleScript] -> ShowS
$cshowList :: [SimpleScript] -> ShowS
show :: SimpleScript -> [Char]
$cshow :: SimpleScript -> [Char]
showsPrec :: Int -> SimpleScript -> ShowS
$cshowsPrec :: Int -> 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
forall lang. PlutusScript lang -> PlutusScript lang -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlutusScript lang -> PlutusScript lang -> Bool
$c/= :: forall lang. PlutusScript lang -> PlutusScript lang -> Bool
== :: PlutusScript lang -> PlutusScript lang -> Bool
$c== :: forall lang. PlutusScript lang -> PlutusScript lang -> Bool
Eq, PlutusScript lang -> PlutusScript lang -> Bool
PlutusScript lang -> PlutusScript lang -> Ordering
forall lang. Eq (PlutusScript lang)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall lang. PlutusScript lang -> PlutusScript lang -> Bool
forall lang. PlutusScript lang -> PlutusScript lang -> Ordering
forall lang.
PlutusScript lang -> PlutusScript lang -> PlutusScript lang
min :: PlutusScript lang -> PlutusScript lang -> PlutusScript lang
$cmin :: forall lang.
PlutusScript lang -> PlutusScript lang -> PlutusScript lang
max :: PlutusScript lang -> PlutusScript lang -> PlutusScript lang
$cmax :: forall lang.
PlutusScript lang -> PlutusScript lang -> PlutusScript lang
>= :: PlutusScript lang -> PlutusScript lang -> Bool
$c>= :: forall lang. PlutusScript lang -> PlutusScript lang -> Bool
> :: PlutusScript lang -> PlutusScript lang -> Bool
$c> :: forall lang. PlutusScript lang -> PlutusScript lang -> Bool
<= :: PlutusScript lang -> PlutusScript lang -> Bool
$c<= :: forall lang. PlutusScript lang -> PlutusScript lang -> Bool
< :: PlutusScript lang -> PlutusScript lang -> Bool
$c< :: forall lang. PlutusScript lang -> PlutusScript lang -> Bool
compare :: PlutusScript lang -> PlutusScript lang -> Ordering
$ccompare :: forall lang. PlutusScript lang -> PlutusScript lang -> Ordering
Ord)
  deriving stock (Int -> PlutusScript lang -> ShowS
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
showList :: [PlutusScript lang] -> ShowS
$cshowList :: forall lang. [PlutusScript lang] -> ShowS
show :: PlutusScript lang -> [Char]
$cshow :: forall lang. PlutusScript lang -> [Char]
showsPrec :: Int -> PlutusScript lang -> ShowS
$cshowsPrec :: forall lang. Int -> PlutusScript lang -> ShowS
Show) -- TODO: would be nice to use via UsingRawBytesHex
                        -- however that adds an awkward HasTypeProxy lang =>
                        -- constraint to other Show instances elsewhere
  deriving (PlutusScript lang -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PlutusScript lang] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PlutusScript lang) -> Size
forall {lang}.
(Typeable lang, HasTypeProxy lang) =>
Typeable (PlutusScript lang)
forall lang.
(Typeable lang, HasTypeProxy lang) =>
PlutusScript lang -> Encoding
forall lang.
(Typeable lang, HasTypeProxy lang) =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PlutusScript lang] -> Size
forall lang.
(Typeable lang, HasTypeProxy lang) =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PlutusScript lang) -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PlutusScript lang] -> Size
$cencodedListSizeExpr :: forall lang.
(Typeable lang, HasTypeProxy lang) =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [PlutusScript lang] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PlutusScript lang) -> Size
$cencodedSizeExpr :: forall lang.
(Typeable lang, HasTypeProxy lang) =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (PlutusScript lang) -> Size
toCBOR :: PlutusScript lang -> Encoding
$ctoCBOR :: forall lang.
(Typeable lang, HasTypeProxy lang) =>
PlutusScript lang -> Encoding
ToCBOR, Proxy (PlutusScript lang) -> Text
forall s. Decoder s (PlutusScript lang)
forall {lang}.
(Typeable lang, HasTypeProxy lang) =>
Typeable (PlutusScript lang)
forall lang.
(Typeable lang, HasTypeProxy lang) =>
Proxy (PlutusScript lang) -> Text
forall lang s.
(Typeable lang, HasTypeProxy lang) =>
Decoder s (PlutusScript lang)
forall a.
Typeable a
-> (forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
label :: Proxy (PlutusScript lang) -> Text
$clabel :: forall lang.
(Typeable lang, HasTypeProxy lang) =>
Proxy (PlutusScript lang) -> Text
fromCBOR :: forall s. Decoder s (PlutusScript lang)
$cfromCBOR :: forall lang s.
(Typeable lang, HasTypeProxy lang) =>
Decoder s (PlutusScript lang)
FromCBOR) via (UsingRawBytes (PlutusScript lang))
  deriving anyclass forall {lang}.
(HasTypeProxy lang, Typeable lang) =>
HasTypeProxy (PlutusScript lang)
forall lang.
(HasTypeProxy lang, Typeable lang) =>
AsType (PlutusScript lang)
-> ByteString -> Either DecoderError (PlutusScript lang)
forall lang.
(HasTypeProxy lang, Typeable lang) =>
PlutusScript lang -> ByteString
forall a.
HasTypeProxy a
-> (a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
deserialiseFromCBOR :: AsType (PlutusScript lang)
-> ByteString -> Either DecoderError (PlutusScript lang)
$cdeserialiseFromCBOR :: forall lang.
(HasTypeProxy lang, Typeable lang) =>
AsType (PlutusScript lang)
-> ByteString -> Either DecoderError (PlutusScript lang)
serialiseToCBOR :: PlutusScript lang -> ByteString
$cserialiseToCBOR :: forall lang.
(HasTypeProxy lang, Typeable lang) =>
PlutusScript lang -> ByteString
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)
_ = forall lang. AsType lang -> AsType (PlutusScript lang)
AsPlutusScript (forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType (forall {k} (t :: k). Proxy t
Proxy :: Proxy lang))

instance (HasTypeProxy lang, Typeable 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
      forall a b. b -> Either a b
Right (forall lang. ShortByteString -> PlutusScript lang
PlutusScriptSerialised (ByteString -> ShortByteString
SBS.toShort ByteString
bs))

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


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

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

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


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

toShelleyScript :: ScriptInEra era -> Ledger.Script (ShelleyLedgerEra era)
toShelleyScript :: 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 -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => [Char] -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) forall a. a -> a
id (SimpleScript -> Either MultiSigError (MultiSig StandardCrypto)
toShelleyMultiSig SimpleScript
script)
      ScriptLanguageInEra lang era
SimpleScriptInAllegra -> SimpleScript -> Timelock StandardCrypto
toAllegraTimelock SimpleScript
script
      ScriptLanguageInEra lang era
SimpleScriptInMary    -> SimpleScript -> Timelock StandardCrypto
toAllegraTimelock SimpleScript
script
      ScriptLanguageInEra lang era
SimpleScriptInAlonzo  -> forall era. Timelock (Crypto era) -> AlonzoScript era
Alonzo.TimelockScript (SimpleScript -> Timelock StandardCrypto
toAllegraTimelock SimpleScript
script)
      ScriptLanguageInEra lang era
SimpleScriptInBabbage -> forall era. Timelock (Crypto era) -> AlonzoScript era
Alonzo.TimelockScript (SimpleScript -> Timelock StandardCrypto
toAllegraTimelock SimpleScript
script)
      ScriptLanguageInEra lang era
SimpleScriptInConway  -> forall era. Timelock (Crypto era) -> AlonzoScript era
Alonzo.TimelockScript (SimpleScript -> Timelock StandardCrypto
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  -> forall era. Language -> ShortByteString -> AlonzoScript era
Alonzo.PlutusScript Language
Alonzo.PlutusV1 ShortByteString
script
      ScriptLanguageInEra lang era
PlutusScriptV1InBabbage -> forall era. Language -> ShortByteString -> AlonzoScript era
Alonzo.PlutusScript Language
Alonzo.PlutusV1 ShortByteString
script
      ScriptLanguageInEra lang era
PlutusScriptV1InConway  -> forall era. Language -> ShortByteString -> AlonzoScript era
Alonzo.PlutusScript Language
Alonzo.PlutusV1 ShortByteString
script

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

fromShelleyBasedScript  :: ShelleyBasedEra era
                        -> Ledger.Script (ShelleyLedgerEra era)
                        -> ScriptInEra era
fromShelleyBasedScript :: forall era.
ShelleyBasedEra era
-> Script (ShelleyLedgerEra era) -> ScriptInEra era
fromShelleyBasedScript ShelleyBasedEra era
era Script (ShelleyLedgerEra era)
script =
  case ShelleyBasedEra era
era of
    ShelleyBasedEra era
ShelleyBasedEraShelley ->
      forall a era.
ScriptLanguageInEra a era -> Script a -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScript' ShelleyEra
SimpleScriptInShelley
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleScript -> Script SimpleScript'
SimpleScript forall a b. (a -> b) -> a -> b
$ MultiSig StandardCrypto -> SimpleScript
fromShelleyMultiSig Script (ShelleyLedgerEra era)
script
    ShelleyBasedEra era
ShelleyBasedEraAllegra ->
      forall a era.
ScriptLanguageInEra a era -> Script a -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScript' AllegraEra
SimpleScriptInAllegra
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleScript -> Script SimpleScript'
SimpleScript forall a b. (a -> b) -> a -> b
$ Timelock StandardCrypto -> SimpleScript
fromAllegraTimelock Script (ShelleyLedgerEra era)
script
    ShelleyBasedEra era
ShelleyBasedEraMary ->
      forall a era.
ScriptLanguageInEra a era -> Script a -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScript' MaryEra
SimpleScriptInMary
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleScript -> Script SimpleScript'
SimpleScript forall a b. (a -> b) -> a -> b
$ Timelock StandardCrypto -> SimpleScript
fromAllegraTimelock Script (ShelleyLedgerEra era)
script
    ShelleyBasedEra era
ShelleyBasedEraAlonzo ->
      case Script (ShelleyLedgerEra era)
script of
        Alonzo.TimelockScript Timelock (Crypto StandardAlonzo)
s ->
          forall a era.
ScriptLanguageInEra a era -> Script a -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScript' AlonzoEra
SimpleScriptInAlonzo
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleScript -> Script SimpleScript'
SimpleScript forall a b. (a -> b) -> a -> b
$ Timelock StandardCrypto -> SimpleScript
fromAllegraTimelock Timelock (Crypto StandardAlonzo)
s
        Alonzo.PlutusScript Language
Alonzo.PlutusV1 ShortByteString
s ->
          forall a era.
ScriptLanguageInEra a era -> Script a -> ScriptInEra era
ScriptInEra ScriptLanguageInEra PlutusScriptV1 AlonzoEra
PlutusScriptV1InAlonzo
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
PlutusScript PlutusScriptVersion PlutusScriptV1
PlutusScriptV1
            forall a b. (a -> b) -> a -> b
$ forall lang. ShortByteString -> PlutusScript lang
PlutusScriptSerialised ShortByteString
s
        Alonzo.PlutusScript Language
Alonzo.PlutusV2 ShortByteString
_ ->
          forall a. HasCallStack => [Char] -> a
error [Char]
"fromShelleyBasedScript: PlutusV2 not supported in Alonzo era"
    ShelleyBasedEra era
ShelleyBasedEraBabbage ->
      case Script (ShelleyLedgerEra era)
script of
        Alonzo.TimelockScript Timelock (Crypto StandardBabbage)
s ->
          forall a era.
ScriptLanguageInEra a era -> Script a -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScript' BabbageEra
SimpleScriptInBabbage
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleScript -> Script SimpleScript'
SimpleScript forall a b. (a -> b) -> a -> b
$ Timelock StandardCrypto -> SimpleScript
fromAllegraTimelock  Timelock (Crypto StandardBabbage)
s
        Alonzo.PlutusScript Language
Alonzo.PlutusV1 ShortByteString
s ->
          forall a era.
ScriptLanguageInEra a era -> Script a -> ScriptInEra era
ScriptInEra ScriptLanguageInEra PlutusScriptV1 BabbageEra
PlutusScriptV1InBabbage
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
PlutusScript PlutusScriptVersion PlutusScriptV1
PlutusScriptV1 forall a b. (a -> b) -> a -> b
$ forall lang. ShortByteString -> PlutusScript lang
PlutusScriptSerialised ShortByteString
s
        Alonzo.PlutusScript Language
Alonzo.PlutusV2 ShortByteString
s ->
          forall a era.
ScriptLanguageInEra a era -> Script a -> ScriptInEra era
ScriptInEra ScriptLanguageInEra PlutusScriptV2 BabbageEra
PlutusScriptV2InBabbage
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
PlutusScript PlutusScriptVersion PlutusScriptV2
PlutusScriptV2 forall a b. (a -> b) -> a -> b
$ forall lang. ShortByteString -> PlutusScript lang
PlutusScriptSerialised ShortByteString
s

    ShelleyBasedEra era
ShelleyBasedEraConway ->
      case Script (ShelleyLedgerEra era)
script of
        Alonzo.TimelockScript Timelock (Crypto (ConwayEra StandardCrypto))
s ->
          forall a era.
ScriptLanguageInEra a era -> Script a -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScript' ConwayEra
SimpleScriptInConway
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleScript -> Script SimpleScript'
SimpleScript forall a b. (a -> b) -> a -> b
$ Timelock StandardCrypto -> SimpleScript
fromAllegraTimelock  Timelock (Crypto (ConwayEra StandardCrypto))
s
        Alonzo.PlutusScript Language
Alonzo.PlutusV1 ShortByteString
s ->
          forall a era.
ScriptLanguageInEra a era -> Script a -> ScriptInEra era
ScriptInEra ScriptLanguageInEra PlutusScriptV1 ConwayEra
PlutusScriptV1InConway
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
PlutusScript PlutusScriptVersion PlutusScriptV1
PlutusScriptV1 forall a b. (a -> b) -> a -> b
$ forall lang. ShortByteString -> PlutusScript lang
PlutusScriptSerialised ShortByteString
s
        Alonzo.PlutusScript Language
Alonzo.PlutusV2 ShortByteString
s ->
          forall a era.
ScriptLanguageInEra a era -> Script a -> ScriptInEra era
ScriptInEra ScriptLanguageInEra PlutusScriptV2 ConwayEra
PlutusScriptV2InConway
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
PlutusScript PlutusScriptVersion PlutusScriptV2
PlutusScriptV2 forall a b. (a -> b) -> a -> b
$ forall lang. ShortByteString -> PlutusScript lang
PlutusScriptSerialised ShortByteString
s


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

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

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

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

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


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

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

instance ToJSON SimpleScript where
  toJSON :: SimpleScript -> Value
toJSON (RequireSignature Hash PaymentKey
pKeyHash) =
    [Pair] -> Value
object [ Key
"type"    forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"sig"
           , Key
"keyHash" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText Hash PaymentKey
pKeyHash
           ]
  toJSON (RequireTimeBefore SlotNo
slot) =
    [Pair] -> Value
object [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"before"
           , Key
"slot" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SlotNo
slot
           ]
  toJSON (RequireTimeAfter SlotNo
slot) =
    [Pair] -> Value
object [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"after"
           , Key
"slot" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SlotNo
slot
           ]
  toJSON (RequireAnyOf [SimpleScript]
reqScripts) =
    [Pair] -> Value
object [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"any", Key
"scripts" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a b. (a -> b) -> [a] -> [b]
map forall a. ToJSON a => a -> Value
toJSON [SimpleScript]
reqScripts ]
  toJSON (RequireAllOf [SimpleScript]
reqScripts) =
    [Pair] -> Value
object [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"all", Key
"scripts" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a b. (a -> b) -> [a] -> [b]
map forall a. ToJSON a => a -> Value
toJSON [SimpleScript]
reqScripts ]
  toJSON (RequireMOf Int
reqNum [SimpleScript]
reqScripts) =
    [Pair] -> Value
object [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"atLeast"
           , Key
"required" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
reqNum
           , Key
"scripts" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a b. (a -> b) -> [a] -> [b]
map 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 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                      Value -> Parser SimpleScript
parseScriptBefore Value
v forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                      Value -> Parser SimpleScript
parseScriptAfter Value
v forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                      Value -> Parser SimpleScript
parseScriptAny Value
v forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                      Value -> Parser SimpleScript
parseScriptAll Value
v 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 =
    forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject [Char]
"any" forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
      Text
t <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
      case Text
t :: Text of
        Text
"any" -> do Vector Value
vs <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"scripts"
                    [SimpleScript] -> SimpleScript
RequireAnyOf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Value -> Parser [SimpleScript]
gatherSimpleScriptTerms Vector Value
vs
        Text
_ -> 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 =
    forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject [Char]
"all" forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
      Text
t <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
      case Text
t :: Text of
        Text
"all" -> do Vector Value
vs <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"scripts"
                    [SimpleScript] -> SimpleScript
RequireAllOf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Value -> Parser [SimpleScript]
gatherSimpleScriptTerms Vector Value
vs
        Text
_ -> 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 =
    forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject [Char]
"atLeast" forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
      Text
v <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
      case Text
v :: Text of
        Text
"atLeast" -> do
          Value
r  <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"required"
          Vector Value
vs <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"scripts"
          case Value
r of
            Number Scientific
sci ->
              case 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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length [SimpleScript]
scripts
                     forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
                       (Int
reqInt forall a. Ord a => a -> a -> Bool
> Int
numScripts)
                       (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Required number of script signatures exceeds the number of scripts."
                             forall a. Semigroup a => a -> a -> a
<> [Char]
" Required number: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Int
reqInt
                             forall a. Semigroup a => a -> a -> a
<> [Char]
" Number of scripts: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Int
numScripts)
                     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> [SimpleScript] -> SimpleScript
RequireMOf Int
reqInt [SimpleScript]
scripts
                Maybe Int
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Error in \"required\" key: "
                                forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Scientific
sci forall a. Semigroup a => a -> a -> a
<> [Char]
" is not a valid Int"
            Value
_ -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"\"required\" value should be an integer"
        Text
_        -> 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 = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Parser SimpleScript
parseSimpleScript forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> [a]
Vector.toList

parseScriptSig :: Value -> Aeson.Parser SimpleScript
parseScriptSig :: Value -> Parser SimpleScript
parseScriptSig =
    forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject [Char]
"sig" forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
      Text
v <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
      case Text
v :: Text of
        Text
"sig" -> do Text
k <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"keyHash"
                    Hash PaymentKey -> SimpleScript
RequireSignature forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser (Hash PaymentKey)
parsePaymentKeyHash Text
k
        Text
_     -> 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 =
    forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject [Char]
"before" forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
      Text
v <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
      case Text
v :: Text of
        Text
"before" ->  SlotNo -> SimpleScript
RequireTimeBefore forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"slot"
        Text
_ -> 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 =
    forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject [Char]
"after" forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
      Text
v <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
      case Text
v :: Text of
        Text
"after" -> SlotNo -> SimpleScript
RequireTimeAfter forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"slot"
        Text
_       -> 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 =
  forall (m :: * -> *) e a.
MonadFail m =>
(e -> [Char]) -> Either e a -> m a
failEitherWith
    (\RawBytesHexError
e -> [Char]
"Error deserialising payment key hash: " forall a. [a] -> [a] -> [a]
++ forall e. Error e => e -> [Char]
displayError RawBytesHexError
e)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either RawBytesHexError a
deserialiseFromRawBytesHex (forall a. AsType a -> AsType (Hash a)
AsHash AsType PaymentKey
AsPaymentKey)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8


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

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

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

     ReferenceScriptNone :: ReferenceScript era

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

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

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

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

data ReferenceTxInsScriptsInlineDatumsSupportedInEra era where
    ReferenceTxInsScriptsInlineDatumsInBabbageEra :: ReferenceTxInsScriptsInlineDatumsSupportedInEra BabbageEra
    ReferenceTxInsScriptsInlineDatumsInConwayEra :: ReferenceTxInsScriptsInlineDatumsSupportedInEra ConwayEra

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

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

refScriptToShelleyScript
  :: CardanoEra era
  -> ReferenceScript era
  -> StrictMaybe (Ledger.Script (ShelleyLedgerEra era))
refScriptToShelleyScript :: forall era.
CardanoEra era
-> ReferenceScript era
-> StrictMaybe (Script (ShelleyLedgerEra era))
refScriptToShelleyScript CardanoEra era
era (ReferenceScript ReferenceTxInsScriptsInlineDatumsSupportedInEra era
_ ScriptInAnyLang
s) =
  case forall era.
CardanoEra era -> ScriptInAnyLang -> Maybe (ScriptInEra era)
toScriptInEra CardanoEra era
era ScriptInAnyLang
s of
    Just ScriptInEra era
sInEra -> forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ forall era. ScriptInEra era -> Script (ShelleyLedgerEra era)
toShelleyScript ScriptInEra era
sInEra
    Maybe (ScriptInEra era)
Nothing -> forall a. StrictMaybe a
SNothing
refScriptToShelleyScript CardanoEra era
_ ReferenceScript era
ReferenceScriptNone = 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 =
   forall era. ScriptInEra era -> ReferenceScript era
scriptInEraToRefScript forall a b. (a -> b) -> a -> b
$ 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) =
  case forall era.
CardanoEra era
-> Maybe (ReferenceTxInsScriptsInlineDatumsSupportedInEra era)
refInsScriptsAndInlineDatsSupportedInEra CardanoEra era
era of
    Maybe (ReferenceTxInsScriptsInlineDatumsSupportedInEra era)
Nothing -> forall era. ReferenceScript era
ReferenceScriptNone
    Just ReferenceTxInsScriptsInlineDatumsSupportedInEra era
supp ->
      -- Any script can be a reference script
      forall era.
ReferenceTxInsScriptsInlineDatumsSupportedInEra era
-> ScriptInAnyLang -> ReferenceScript era
ReferenceScript ReferenceTxInsScriptsInlineDatumsSupportedInEra era
supp forall a b. (a -> b) -> a -> b
$ forall lang. Script lang -> ScriptInAnyLang
toScriptInAnyLang Script lang
s
 where
  era :: CardanoEra era
era = forall era. ShelleyBasedEra era -> CardanoEra era
shelleyBasedToCardanoEra forall a b. (a -> b) -> a -> b
$ forall era. ScriptInEra era -> ShelleyBasedEra era
eraOfScriptInEra ScriptInEra era
sIne

-- Helpers

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