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

module Bcc.Api.Script (
    -- * Languages
    SimpleScriptV1,
    SimpleScriptV2,
    ZerepochScriptV1,
    ScriptLanguage(..),
    SimpleScriptVersion(..),
    ZerepochScriptVersion(..),
    AnyScriptLanguage(..),
    AnyZerepochScriptVersion(..),
    IsScriptLanguage(..),
    IsSimpleScriptLanguage(..),

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

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

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

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

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

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

    -- * The Zerepoch script language
    ZerepochScript(..),
    exampleZerepochScriptAlwaysSucceeds,
    exampleZerepochScriptAlwaysFails,

    -- * Script data
    ScriptData(..),

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

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

    -- * Internal conversion functions
    toSophieScript,
    fromSophieBasedScript,
    toSophieMultiSig,
    fromSophieMultiSig,
    toEvieTimelock,
    fromEvieTimelock,
    toAurumExUnits,
    fromAurumExUnits,
    toSophieScriptHash,
    fromSophieScriptHash,
    toZerepochData,
    fromZerepochData,
    toAurumData,
    fromAurumData,
    toAurumLanguage,
    fromAurumLanguage,

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

import           Prelude

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

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

import           Control.Applicative
import           Control.Monad

import qualified Bcc.Binary as CBOR

import qualified Bcc.Crypto.Hash.Class as Crypto

import           Bcc.Slotting.Slot (SlotNo)

import qualified Bcc.Ledger.Core as Ledger
import qualified Bcc.Ledger.Era  as Ledger

import qualified Bcc.Ledger.SophieMA.Timelocks as Timelock
import           Shardagnostic.Consensus.Sophie.Eras (StandardCrypto)
import qualified Bcc.Ledger.Keys as Sophie
import qualified Sophie.Spec.Ledger.Scripts as Sophie

import qualified Bcc.Ledger.Aurum.Language as Aurum
import qualified Bcc.Ledger.Aurum.Scripts as Aurum

import qualified Zerepoch.V1.Ledger.Examples as Zerepoch

import           Bcc.Api.Eras
import           Bcc.Api.HasTypeProxy
import           Bcc.Api.Hash
import           Bcc.Api.KeysSophie
import           Bcc.Api.ScriptData
import           Bcc.Api.SerialiseCBOR
import           Bcc.Api.SerialiseJSON
import           Bcc.Api.SerialiseRaw
import           Bcc.Api.SerialiseTextEnvelope
import           Bcc.Api.SerialiseUsing

{- HLINT ignore "Use section" -}


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

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

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

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

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

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

instance HasTypeProxy ZerepochScriptV1 where
    data AsType ZerepochScriptV1 = AsZerepochScriptV1
    proxyToAsType :: Proxy ZerepochScriptV1 -> AsType ZerepochScriptV1
proxyToAsType Proxy ZerepochScriptV1
_ = AsType ZerepochScriptV1
AsZerepochScriptV1


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

     SimpleScriptLanguage :: SimpleScriptVersion lang -> ScriptLanguage lang

     ZerepochScriptLanguage :: ZerepochScriptVersion lang -> ScriptLanguage lang

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

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

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

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


data SimpleScriptVersion lang where

     SimpleScriptV1 :: SimpleScriptVersion SimpleScriptV1
     SimpleScriptV2 :: SimpleScriptVersion SimpleScriptV2

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

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


data ZerepochScriptVersion lang where
    ZerepochScriptV1 :: ZerepochScriptVersion ZerepochScriptV1

deriving instance (Eq   (ZerepochScriptVersion lang))
deriving instance (Show (ZerepochScriptVersion lang))

instance TestEquality ZerepochScriptVersion where
    testEquality :: ZerepochScriptVersion a
-> ZerepochScriptVersion b -> Maybe (a :~: b)
testEquality ZerepochScriptVersion a
ZerepochScriptV1 ZerepochScriptVersion b
ZerepochScriptV1 = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl


data AnyScriptLanguage where
     AnyScriptLanguage :: ScriptLanguage lang -> AnyScriptLanguage

deriving instance (Show AnyScriptLanguage)

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

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

instance Enum AnyScriptLanguage where
    toEnum :: Int -> AnyScriptLanguage
toEnum Int
0 = ScriptLanguage SimpleScriptV1 -> AnyScriptLanguage
forall lang. ScriptLanguage lang -> AnyScriptLanguage
AnyScriptLanguage (SimpleScriptVersion SimpleScriptV1 -> ScriptLanguage SimpleScriptV1
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
SimpleScriptLanguage SimpleScriptVersion SimpleScriptV1
SimpleScriptV1)
    toEnum Int
1 = ScriptLanguage SimpleScriptV2 -> AnyScriptLanguage
forall lang. ScriptLanguage lang -> AnyScriptLanguage
AnyScriptLanguage (SimpleScriptVersion SimpleScriptV2 -> ScriptLanguage SimpleScriptV2
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
SimpleScriptLanguage SimpleScriptVersion SimpleScriptV2
SimpleScriptV2)
    toEnum Int
2 = ScriptLanguage ZerepochScriptV1 -> AnyScriptLanguage
forall lang. ScriptLanguage lang -> AnyScriptLanguage
AnyScriptLanguage (ZerepochScriptVersion ZerepochScriptV1
-> ScriptLanguage ZerepochScriptV1
forall lang. ZerepochScriptVersion lang -> ScriptLanguage lang
ZerepochScriptLanguage ZerepochScriptVersion ZerepochScriptV1
ZerepochScriptV1)
    toEnum Int
_ = String -> AnyScriptLanguage
forall a. HasCallStack => String -> a
error String
"AnyScriptLanguage.toEnum: bad argument"

    fromEnum :: AnyScriptLanguage -> Int
fromEnum (AnyScriptLanguage (SimpleScriptLanguage SimpleScriptVersion lang
SimpleScriptV1)) = Int
0
    fromEnum (AnyScriptLanguage (SimpleScriptLanguage SimpleScriptVersion lang
SimpleScriptV2)) = Int
1
    fromEnum (AnyScriptLanguage (ZerepochScriptLanguage ZerepochScriptVersion lang
ZerepochScriptV1)) = Int
2

instance Bounded AnyScriptLanguage where
    minBound :: AnyScriptLanguage
minBound = ScriptLanguage SimpleScriptV1 -> AnyScriptLanguage
forall lang. ScriptLanguage lang -> AnyScriptLanguage
AnyScriptLanguage (SimpleScriptVersion SimpleScriptV1 -> ScriptLanguage SimpleScriptV1
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
SimpleScriptLanguage SimpleScriptVersion SimpleScriptV1
SimpleScriptV1)
    maxBound :: AnyScriptLanguage
maxBound = ScriptLanguage ZerepochScriptV1 -> AnyScriptLanguage
forall lang. ScriptLanguage lang -> AnyScriptLanguage
AnyScriptLanguage (ZerepochScriptVersion ZerepochScriptV1
-> ScriptLanguage ZerepochScriptV1
forall lang. ZerepochScriptVersion lang -> ScriptLanguage lang
ZerepochScriptLanguage ZerepochScriptVersion ZerepochScriptV1
ZerepochScriptV1)


data AnyZerepochScriptVersion where
     AnyZerepochScriptVersion :: ZerepochScriptVersion lang
                            -> AnyZerepochScriptVersion

deriving instance (Show AnyZerepochScriptVersion)

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

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

instance Enum AnyZerepochScriptVersion where
    toEnum :: Int -> AnyZerepochScriptVersion
toEnum Int
0 = ZerepochScriptVersion ZerepochScriptV1 -> AnyZerepochScriptVersion
forall lang. ZerepochScriptVersion lang -> AnyZerepochScriptVersion
AnyZerepochScriptVersion ZerepochScriptVersion ZerepochScriptV1
ZerepochScriptV1
    toEnum Int
_ = String -> AnyZerepochScriptVersion
forall a. HasCallStack => String -> a
error String
"AnyZerepochScriptVersion.toEnum: bad argument"

    fromEnum :: AnyZerepochScriptVersion -> Int
fromEnum (AnyZerepochScriptVersion ZerepochScriptVersion lang
ZerepochScriptV1) = Int
0

instance Bounded AnyZerepochScriptVersion where
    minBound :: AnyZerepochScriptVersion
minBound = ZerepochScriptVersion ZerepochScriptV1 -> AnyZerepochScriptVersion
forall lang. ZerepochScriptVersion lang -> AnyZerepochScriptVersion
AnyZerepochScriptVersion ZerepochScriptVersion ZerepochScriptV1
ZerepochScriptV1
    maxBound :: AnyZerepochScriptVersion
maxBound = ZerepochScriptVersion ZerepochScriptV1 -> AnyZerepochScriptVersion
forall lang. ZerepochScriptVersion lang -> AnyZerepochScriptVersion
AnyZerepochScriptVersion ZerepochScriptVersion ZerepochScriptV1
ZerepochScriptV1

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

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

instance ToJSON AnyZerepochScriptVersion where
    toJSON :: AnyZerepochScriptVersion -> Value
toJSON (AnyZerepochScriptVersion ZerepochScriptVersion lang
ZerepochScriptV1) =
      Text -> Value
Aeson.String Text
"ZerepochScriptV1"

parseZerepochScriptVersion :: Text -> Aeson.Parser AnyZerepochScriptVersion
parseZerepochScriptVersion :: Text -> Parser AnyZerepochScriptVersion
parseZerepochScriptVersion Text
t =
  case Text
t of
    Text
"ZerepochScriptV1" -> AnyZerepochScriptVersion -> Parser AnyZerepochScriptVersion
forall (m :: * -> *) a. Monad m => a -> m a
return (ZerepochScriptVersion ZerepochScriptV1 -> AnyZerepochScriptVersion
forall lang. ZerepochScriptVersion lang -> AnyZerepochScriptVersion
AnyZerepochScriptVersion ZerepochScriptVersion ZerepochScriptV1
ZerepochScriptV1)
    Text
_                -> String -> Parser AnyZerepochScriptVersion
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected ZerepochScriptV1"

instance FromJSON AnyZerepochScriptVersion where
    parseJSON :: Value -> Parser AnyZerepochScriptVersion
parseJSON = String
-> (Text -> Parser AnyZerepochScriptVersion)
-> Value
-> Parser AnyZerepochScriptVersion
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"ZerepochScriptVersion" Text -> Parser AnyZerepochScriptVersion
parseZerepochScriptVersion

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

instance Aeson.ToJSONKey AnyZerepochScriptVersion where
    toJSONKey :: ToJSONKeyFunction AnyZerepochScriptVersion
toJSONKey = (AnyZerepochScriptVersion -> Text)
-> (AnyZerepochScriptVersion -> Encoding' Text)
-> ToJSONKeyFunction AnyZerepochScriptVersion
forall a.
(a -> Text) -> (a -> Encoding' Text) -> ToJSONKeyFunction a
Aeson.ToJSONKeyText AnyZerepochScriptVersion -> Text
toText AnyZerepochScriptVersion -> Encoding' Text
forall a. AnyZerepochScriptVersion -> Encoding' a
toAesonEncoding
      where
        toText :: AnyZerepochScriptVersion -> Text
        toText :: AnyZerepochScriptVersion -> Text
toText (AnyZerepochScriptVersion ZerepochScriptVersion lang
ZerepochScriptV1) = Text
"ZerepochScriptV1"
        toAesonEncoding :: AnyZerepochScriptVersion -> Encoding' a
toAesonEncoding = Text -> Encoding' a
forall a. Text -> Encoding' a
Aeson.text (Text -> Encoding' a)
-> (AnyZerepochScriptVersion -> Text)
-> AnyZerepochScriptVersion
-> Encoding' a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyZerepochScriptVersion -> Text
toText

toAurumLanguage :: AnyZerepochScriptVersion -> Aurum.Language
toAurumLanguage :: AnyZerepochScriptVersion -> Language
toAurumLanguage (AnyZerepochScriptVersion ZerepochScriptVersion lang
ZerepochScriptV1) = Language
Aurum.ZerepochV1

fromAurumLanguage :: Aurum.Language -> AnyZerepochScriptVersion
fromAurumLanguage :: Language -> AnyZerepochScriptVersion
fromAurumLanguage Language
Aurum.ZerepochV1 = ZerepochScriptVersion ZerepochScriptV1 -> AnyZerepochScriptVersion
forall lang. ZerepochScriptVersion lang -> AnyZerepochScriptVersion
AnyZerepochScriptVersion ZerepochScriptVersion ZerepochScriptV1
ZerepochScriptV1


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

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

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

instance IsScriptLanguage ZerepochScriptV1 where
    scriptLanguage :: ScriptLanguage ZerepochScriptV1
scriptLanguage = ZerepochScriptVersion ZerepochScriptV1
-> ScriptLanguage ZerepochScriptV1
forall lang. ZerepochScriptVersion lang -> ScriptLanguage lang
ZerepochScriptLanguage ZerepochScriptVersion ZerepochScriptV1
ZerepochScriptV1


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

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

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


class IsScriptLanguage lang => IsZerepochScriptLanguage lang where
    zerepochScriptVersion :: ZerepochScriptVersion lang

instance IsZerepochScriptLanguage ZerepochScriptV1 where
    zerepochScriptVersion :: ZerepochScriptVersion ZerepochScriptV1
zerepochScriptVersion = ZerepochScriptVersion ZerepochScriptV1
ZerepochScriptV1


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

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

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

     ZerepochScript :: !(ZerepochScriptVersion lang)
                  -> !(ZerepochScript lang)
                  -> Script lang

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

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

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

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

    serialiseToCBOR (ZerepochScript ZerepochScriptVersion lang
ZerepochScriptV1 ZerepochScript lang
s) =
      ZerepochScript lang -> ByteString
forall a. ToCBOR a => a -> ByteString
CBOR.serialize' ZerepochScript lang
s

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

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

        ZerepochScriptLanguage ZerepochScriptVersion lang
ZerepochScriptV1 ->
              ZerepochScriptVersion ZerepochScriptV1
-> ZerepochScript ZerepochScriptV1 -> Script ZerepochScriptV1
forall lang.
ZerepochScriptVersion lang -> ZerepochScript lang -> Script lang
ZerepochScript ZerepochScriptVersion ZerepochScriptV1
ZerepochScriptV1
          (ZerepochScript ZerepochScriptV1 -> Script ZerepochScriptV1)
-> Either DecoderError (ZerepochScript ZerepochScriptV1)
-> Either DecoderError (Script ZerepochScriptV1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either DecoderError (ZerepochScript ZerepochScriptV1)
forall a. FromCBOR a => ByteString -> Either DecoderError a
CBOR.decodeFull' ByteString
bs


instance IsScriptLanguage lang => HasTextEnvelope (Script lang) where
    textEnvelopeType :: AsType (Script lang) -> TextEnvelopeType
textEnvelopeType AsType (Script lang)
_ =
      case ScriptLanguage lang
forall lang. IsScriptLanguage lang => ScriptLanguage lang
scriptLanguage :: ScriptLanguage lang of
        SimpleScriptLanguage SimpleScriptVersion lang
SimpleScriptV1 -> TextEnvelopeType
"SimpleScriptV1"
        SimpleScriptLanguage SimpleScriptVersion lang
SimpleScriptV2 -> TextEnvelopeType
"SimpleScriptV2"
        ZerepochScriptLanguage ZerepochScriptVersion lang
ZerepochScriptV1 -> TextEnvelopeType
"ZerepochScriptV1"


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

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

deriving instance Show ScriptInAnyLang

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


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

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


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

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

deriving instance Show (ScriptInEra era)

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


data ScriptLanguageInEra lang era where

     SimpleScriptV1InSophie :: ScriptLanguageInEra SimpleScriptV1 SophieEra
     SimpleScriptV1InEvie :: ScriptLanguageInEra SimpleScriptV1 EvieEra
     SimpleScriptV1InJen    :: ScriptLanguageInEra SimpleScriptV1 JenEra
     SimpleScriptV1InAurum  :: ScriptLanguageInEra SimpleScriptV1 AurumEra

     SimpleScriptV2InEvie :: ScriptLanguageInEra SimpleScriptV2 EvieEra
     SimpleScriptV2InJen    :: ScriptLanguageInEra SimpleScriptV2 JenEra
     SimpleScriptV2InAurum  :: ScriptLanguageInEra SimpleScriptV2 AurumEra

     ZerepochScriptV1InAurum  :: ScriptLanguageInEra ZerepochScriptV1 AurumEra

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

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


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

      (BccEra era
EvieEra, SimpleScriptLanguage SimpleScriptVersion lang
SimpleScriptV1) ->
        ScriptLanguageInEra SimpleScriptV1 EvieEra
-> Maybe (ScriptLanguageInEra SimpleScriptV1 EvieEra)
forall a. a -> Maybe a
Just ScriptLanguageInEra SimpleScriptV1 EvieEra
SimpleScriptV1InEvie

      (BccEra era
JenEra, SimpleScriptLanguage SimpleScriptVersion lang
SimpleScriptV1) ->
        ScriptLanguageInEra SimpleScriptV1 JenEra
-> Maybe (ScriptLanguageInEra SimpleScriptV1 JenEra)
forall a. a -> Maybe a
Just ScriptLanguageInEra SimpleScriptV1 JenEra
SimpleScriptV1InJen

      (BccEra era
EvieEra, SimpleScriptLanguage SimpleScriptVersion lang
SimpleScriptV2) ->
        ScriptLanguageInEra SimpleScriptV2 EvieEra
-> Maybe (ScriptLanguageInEra SimpleScriptV2 EvieEra)
forall a. a -> Maybe a
Just ScriptLanguageInEra SimpleScriptV2 EvieEra
SimpleScriptV2InEvie

      (BccEra era
JenEra, SimpleScriptLanguage SimpleScriptVersion lang
SimpleScriptV2) ->
        ScriptLanguageInEra SimpleScriptV2 JenEra
-> Maybe (ScriptLanguageInEra SimpleScriptV2 JenEra)
forall a. a -> Maybe a
Just ScriptLanguageInEra SimpleScriptV2 JenEra
SimpleScriptV2InJen

      (BccEra era
AurumEra, SimpleScriptLanguage SimpleScriptVersion lang
SimpleScriptV1) ->
        ScriptLanguageInEra SimpleScriptV1 AurumEra
-> Maybe (ScriptLanguageInEra SimpleScriptV1 AurumEra)
forall a. a -> Maybe a
Just ScriptLanguageInEra SimpleScriptV1 AurumEra
SimpleScriptV1InAurum

      (BccEra era
AurumEra, SimpleScriptLanguage SimpleScriptVersion lang
SimpleScriptV2) ->
        ScriptLanguageInEra SimpleScriptV2 AurumEra
-> Maybe (ScriptLanguageInEra SimpleScriptV2 AurumEra)
forall a. a -> Maybe a
Just ScriptLanguageInEra SimpleScriptV2 AurumEra
SimpleScriptV2InAurum

      (BccEra era
AurumEra, ZerepochScriptLanguage ZerepochScriptVersion lang
ZerepochScriptV1) ->
        ScriptLanguageInEra ZerepochScriptV1 AurumEra
-> Maybe (ScriptLanguageInEra ZerepochScriptV1 AurumEra)
forall a. a -> Maybe a
Just ScriptLanguageInEra ZerepochScriptV1 AurumEra
ZerepochScriptV1InAurum

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

languageOfScriptLanguageInEra :: ScriptLanguageInEra lang era
                              -> ScriptLanguage lang
languageOfScriptLanguageInEra :: ScriptLanguageInEra lang era -> ScriptLanguage lang
languageOfScriptLanguageInEra ScriptLanguageInEra lang era
langInEra =
    case ScriptLanguageInEra lang era
langInEra of
      ScriptLanguageInEra lang era
SimpleScriptV1InSophie -> SimpleScriptVersion SimpleScriptV1 -> ScriptLanguage SimpleScriptV1
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
SimpleScriptLanguage SimpleScriptVersion SimpleScriptV1
SimpleScriptV1
      ScriptLanguageInEra lang era
SimpleScriptV1InEvie -> SimpleScriptVersion SimpleScriptV1 -> ScriptLanguage SimpleScriptV1
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
SimpleScriptLanguage SimpleScriptVersion SimpleScriptV1
SimpleScriptV1
      ScriptLanguageInEra lang era
SimpleScriptV1InJen    -> SimpleScriptVersion SimpleScriptV1 -> ScriptLanguage SimpleScriptV1
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
SimpleScriptLanguage SimpleScriptVersion SimpleScriptV1
SimpleScriptV1
      ScriptLanguageInEra lang era
SimpleScriptV1InAurum  -> SimpleScriptVersion SimpleScriptV1 -> ScriptLanguage SimpleScriptV1
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
SimpleScriptLanguage SimpleScriptVersion SimpleScriptV1
SimpleScriptV1

      ScriptLanguageInEra lang era
SimpleScriptV2InEvie -> SimpleScriptVersion SimpleScriptV2 -> ScriptLanguage SimpleScriptV2
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
SimpleScriptLanguage SimpleScriptVersion SimpleScriptV2
SimpleScriptV2
      ScriptLanguageInEra lang era
SimpleScriptV2InJen    -> SimpleScriptVersion SimpleScriptV2 -> ScriptLanguage SimpleScriptV2
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
SimpleScriptLanguage SimpleScriptVersion SimpleScriptV2
SimpleScriptV2
      ScriptLanguageInEra lang era
SimpleScriptV2InAurum  -> SimpleScriptVersion SimpleScriptV2 -> ScriptLanguage SimpleScriptV2
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
SimpleScriptLanguage SimpleScriptVersion SimpleScriptV2
SimpleScriptV2

      ScriptLanguageInEra lang era
ZerepochScriptV1InAurum  -> ZerepochScriptVersion ZerepochScriptV1
-> ScriptLanguage ZerepochScriptV1
forall lang. ZerepochScriptVersion lang -> ScriptLanguage lang
ZerepochScriptLanguage ZerepochScriptVersion ZerepochScriptV1
ZerepochScriptV1

eraOfScriptLanguageInEra :: ScriptLanguageInEra lang era
                         -> SophieBasedEra era
eraOfScriptLanguageInEra :: ScriptLanguageInEra lang era -> SophieBasedEra era
eraOfScriptLanguageInEra ScriptLanguageInEra lang era
langInEra =
    case ScriptLanguageInEra lang era
langInEra of
      ScriptLanguageInEra lang era
SimpleScriptV1InSophie -> SophieBasedEra era
SophieBasedEra SophieEra
SophieBasedEraSophie

      ScriptLanguageInEra lang era
SimpleScriptV1InEvie -> SophieBasedEra era
SophieBasedEra EvieEra
SophieBasedEraEvie
      ScriptLanguageInEra lang era
SimpleScriptV2InEvie -> SophieBasedEra era
SophieBasedEra EvieEra
SophieBasedEraEvie

      ScriptLanguageInEra lang era
SimpleScriptV1InJen    -> SophieBasedEra era
SophieBasedEra JenEra
SophieBasedEraJen
      ScriptLanguageInEra lang era
SimpleScriptV2InJen    -> SophieBasedEra era
SophieBasedEra JenEra
SophieBasedEraJen

      ScriptLanguageInEra lang era
SimpleScriptV1InAurum  -> SophieBasedEra era
SophieBasedEra AurumEra
SophieBasedEraAurum
      ScriptLanguageInEra lang era
SimpleScriptV2InAurum  -> SophieBasedEra era
SophieBasedEra AurumEra
SophieBasedEraAurum

      ScriptLanguageInEra lang era
ZerepochScriptV1InAurum  -> SophieBasedEra era
SophieBasedEra AurumEra
SophieBasedEraAurum


-- | 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 :: BccEra era -> ScriptInAnyLang -> Maybe (ScriptInEra era)
toScriptInEra :: BccEra era -> ScriptInAnyLang -> Maybe (ScriptInEra era)
toScriptInEra BccEra era
era (ScriptInAnyLang ScriptLanguage lang
lang Script lang
s) = do
    ScriptLanguageInEra lang era
lang' <- BccEra era
-> ScriptLanguage lang -> Maybe (ScriptLanguageInEra lang era)
forall era lang.
BccEra era
-> ScriptLanguage lang -> Maybe (ScriptLanguageInEra lang era)
scriptLanguageSupportedInEra BccEra era
era ScriptLanguage lang
lang
    ScriptInEra era -> Maybe (ScriptInEra era)
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra lang era
lang' Script lang
s)

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


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

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

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

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


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


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

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

     ZerepochScriptWitness :: ScriptLanguageInEra  lang era
                         -> ZerepochScriptVersion  lang
                         -> ZerepochScript         lang
                         -> ScriptDatum witctx
                         -> ScriptRedeemer
                         -> ExecutionUnits
                         -> ScriptWitness witctx era

deriving instance Show (ScriptWitness witctx era)

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

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

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

type ScriptRedeemer = ScriptData

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

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


scriptWitnessScript :: ScriptWitness witctx era -> ScriptInEra era
scriptWitnessScript :: ScriptWitness witctx era -> ScriptInEra era
scriptWitnessScript (SimpleScriptWitness ScriptLanguageInEra lang era
langInEra SimpleScriptVersion lang
version SimpleScript lang
script) =
    ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra lang era
langInEra (SimpleScriptVersion lang -> SimpleScript lang -> Script lang
forall lang.
SimpleScriptVersion lang -> SimpleScript lang -> Script lang
SimpleScript SimpleScriptVersion lang
version SimpleScript lang
script)

scriptWitnessScript (ZerepochScriptWitness ScriptLanguageInEra lang era
langInEra ZerepochScriptVersion lang
version ZerepochScript lang
script ScriptDatum witctx
_ ScriptRedeemer
_ ExecutionUnits
_) =
    ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra lang era
langInEra (ZerepochScriptVersion lang -> ZerepochScript lang -> Script lang
forall lang.
ZerepochScriptVersion lang -> ZerepochScript lang -> Script lang
ZerepochScript ZerepochScriptVersion lang
version ZerepochScript lang
script)


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

data Witness witctx era where

     KeyWitness    :: KeyWitnessInCtx witctx
                   -> Witness         witctx era

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

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

data KeyWitnessInCtx witctx where

     KeyWitnessForSpending  :: KeyWitnessInCtx WitCtxTxIn
     KeyWitnessForStakeAddr :: KeyWitnessInCtx WitCtxStake

data ScriptWitnessInCtx witctx where

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

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

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


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

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

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

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

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

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

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

toAurumExUnits :: ExecutionUnits -> Aurum.ExUnits
toAurumExUnits :: ExecutionUnits -> ExUnits
toAurumExUnits ExecutionUnits{Word64
executionSteps :: Word64
executionSteps :: ExecutionUnits -> Word64
executionSteps, Word64
executionMemory :: Word64
executionMemory :: ExecutionUnits -> Word64
executionMemory} =
  ExUnits :: Word64 -> Word64 -> ExUnits
Aurum.ExUnits {
    exUnitsSteps :: Word64
Aurum.exUnitsSteps = Word64
executionSteps,
    exUnitsMem :: Word64
Aurum.exUnitsMem   = Word64
executionMemory
  }

fromAurumExUnits :: Aurum.ExUnits -> ExecutionUnits
fromAurumExUnits :: ExUnits -> ExecutionUnits
fromAurumExUnits Aurum.ExUnits{Word64
exUnitsSteps :: Word64
exUnitsSteps :: ExUnits -> Word64
Aurum.exUnitsSteps, Word64
exUnitsMem :: Word64
exUnitsMem :: ExUnits -> Word64
Aurum.exUnitsMem} =
  ExecutionUnits :: Word64 -> Word64 -> ExecutionUnits
ExecutionUnits {
    executionSteps :: Word64
executionSteps  = Word64
exUnitsSteps,
    executionMemory :: Word64
executionMemory = Word64
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 (Sophie.ScriptHash StandardCrypto)
  deriving stock (ScriptHash -> ScriptHash -> Bool
(ScriptHash -> ScriptHash -> Bool)
-> (ScriptHash -> ScriptHash -> Bool) -> Eq ScriptHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScriptHash -> ScriptHash -> Bool
$c/= :: ScriptHash -> ScriptHash -> Bool
== :: ScriptHash -> ScriptHash -> Bool
$c== :: ScriptHash -> ScriptHash -> Bool
Eq, Eq ScriptHash
Eq ScriptHash
-> (ScriptHash -> ScriptHash -> Ordering)
-> (ScriptHash -> ScriptHash -> Bool)
-> (ScriptHash -> ScriptHash -> Bool)
-> (ScriptHash -> ScriptHash -> Bool)
-> (ScriptHash -> ScriptHash -> Bool)
-> (ScriptHash -> ScriptHash -> ScriptHash)
-> (ScriptHash -> ScriptHash -> ScriptHash)
-> Ord ScriptHash
ScriptHash -> ScriptHash -> Bool
ScriptHash -> ScriptHash -> Ordering
ScriptHash -> ScriptHash -> ScriptHash
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ScriptHash -> ScriptHash -> ScriptHash
$cmin :: ScriptHash -> ScriptHash -> ScriptHash
max :: ScriptHash -> ScriptHash -> ScriptHash
$cmax :: ScriptHash -> ScriptHash -> ScriptHash
>= :: ScriptHash -> ScriptHash -> Bool
$c>= :: ScriptHash -> ScriptHash -> Bool
> :: ScriptHash -> ScriptHash -> Bool
$c> :: ScriptHash -> ScriptHash -> Bool
<= :: ScriptHash -> ScriptHash -> Bool
$c<= :: ScriptHash -> ScriptHash -> Bool
< :: ScriptHash -> ScriptHash -> Bool
$c< :: ScriptHash -> ScriptHash -> Bool
compare :: ScriptHash -> ScriptHash -> Ordering
$ccompare :: ScriptHash -> ScriptHash -> Ordering
$cp1Ord :: Eq ScriptHash
Ord)
  deriving (Int -> ScriptHash -> ShowS
[ScriptHash] -> ShowS
ScriptHash -> String
(Int -> ScriptHash -> ShowS)
-> (ScriptHash -> String)
-> ([ScriptHash] -> ShowS)
-> Show ScriptHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptHash] -> ShowS
$cshowList :: [ScriptHash] -> ShowS
show :: ScriptHash -> String
$cshow :: ScriptHash -> String
showsPrec :: Int -> ScriptHash -> ShowS
$cshowsPrec :: Int -> ScriptHash -> ShowS
Show, String -> ScriptHash
(String -> ScriptHash) -> IsString ScriptHash
forall a. (String -> a) -> IsString a
fromString :: String -> ScriptHash
$cfromString :: String -> ScriptHash
IsString)   via UsingRawBytesHex ScriptHash
  deriving ([ScriptHash] -> Value
[ScriptHash] -> Encoding
ScriptHash -> Value
ScriptHash -> Encoding
(ScriptHash -> Value)
-> (ScriptHash -> Encoding)
-> ([ScriptHash] -> Value)
-> ([ScriptHash] -> Encoding)
-> ToJSON ScriptHash
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ScriptHash] -> Encoding
$ctoEncodingList :: [ScriptHash] -> Encoding
toJSONList :: [ScriptHash] -> Value
$ctoJSONList :: [ScriptHash] -> Value
toEncoding :: ScriptHash -> Encoding
$ctoEncoding :: ScriptHash -> Encoding
toJSON :: ScriptHash -> Value
$ctoJSON :: ScriptHash -> Value
ToJSON, Value -> Parser [ScriptHash]
Value -> Parser ScriptHash
(Value -> Parser ScriptHash)
-> (Value -> Parser [ScriptHash]) -> FromJSON ScriptHash
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ScriptHash]
$cparseJSONList :: Value -> Parser [ScriptHash]
parseJSON :: Value -> Parser ScriptHash
$cparseJSON :: Value -> Parser ScriptHash
FromJSON) via UsingRawBytesHex ScriptHash

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

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

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


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

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

hashScript (ZerepochScript ZerepochScriptVersion lang
ZerepochScriptV1 (ZerepochScriptSerialised ShortByteString
script)) =
    -- For Zerepoch V1, we convert to the Aurum-era version specifically and
    -- hash that. Later ledger eras have to be compatible anyway.
    ScriptHash StandardCrypto -> ScriptHash
ScriptHash
  (ScriptHash StandardCrypto -> ScriptHash)
-> (Script (AurumEra StandardCrypto) -> ScriptHash StandardCrypto)
-> Script (AurumEra StandardCrypto)
-> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidateScript (SophieLedgerEra AurumEra) =>
Script (SophieLedgerEra AurumEra)
-> ScriptHash (Crypto (SophieLedgerEra AurumEra))
forall era.
ValidateScript era =>
Script era -> ScriptHash (Crypto era)
Ledger.hashScript @(SophieLedgerEra AurumEra)
  (Script (AurumEra StandardCrypto) -> ScriptHash)
-> Script (AurumEra StandardCrypto) -> ScriptHash
forall a b. (a -> b) -> a -> b
$ ShortByteString -> Script (AurumEra StandardCrypto)
forall era. ShortByteString -> Script era
Aurum.ZerepochScript ShortByteString
script

toSophieScriptHash :: ScriptHash -> Sophie.ScriptHash StandardCrypto
toSophieScriptHash :: ScriptHash -> ScriptHash StandardCrypto
toSophieScriptHash (ScriptHash ScriptHash StandardCrypto
h) =  ScriptHash StandardCrypto
h

fromSophieScriptHash :: Sophie.ScriptHash StandardCrypto -> ScriptHash
fromSophieScriptHash :: ScriptHash StandardCrypto -> ScriptHash
fromSophieScriptHash = ScriptHash StandardCrypto -> ScriptHash
ScriptHash


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

data SimpleScript lang where

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

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

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

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

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

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


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

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

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


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

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

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

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


-- ----------------------------------------------------------------------------
-- The Zerepoch script language
--

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

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

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

    deserialiseFromRawBytes :: AsType (ZerepochScript lang)
-> ByteString -> Maybe (ZerepochScript lang)
deserialiseFromRawBytes (AsZerepochScript _) ByteString
bs =
      -- TODO aurum: validate the script syntax and fail decoding if invalid
      ZerepochScript lang -> Maybe (ZerepochScript lang)
forall a. a -> Maybe a
Just (ShortByteString -> ZerepochScript lang
forall lang. ShortByteString -> ZerepochScript lang
ZerepochScriptSerialised (ByteString -> ShortByteString
SBS.toShort ByteString
bs))

instance (IsZerepochScriptLanguage lang, Typeable lang) =>
         HasTextEnvelope (ZerepochScript lang) where
    textEnvelopeType :: AsType (ZerepochScript lang) -> TextEnvelopeType
textEnvelopeType AsType (ZerepochScript lang)
_ =
      case ZerepochScriptVersion lang
forall lang.
IsZerepochScriptLanguage lang =>
ZerepochScriptVersion lang
zerepochScriptVersion :: ZerepochScriptVersion lang of
        ZerepochScriptVersion lang
ZerepochScriptV1 -> TextEnvelopeType
"ZerepochScriptV1"


-- | An example Zerepoch 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.
--
exampleZerepochScriptAlwaysSucceeds :: WitCtx witctx
                                  -> ZerepochScript ZerepochScriptV1
exampleZerepochScriptAlwaysSucceeds :: WitCtx witctx -> ZerepochScript ZerepochScriptV1
exampleZerepochScriptAlwaysSucceeds =
    ShortByteString -> ZerepochScript ZerepochScriptV1
forall lang. ShortByteString -> ZerepochScript lang
ZerepochScriptSerialised
  (ShortByteString -> ZerepochScript ZerepochScriptV1)
-> (WitCtx witctx -> ShortByteString)
-> WitCtx witctx
-> ZerepochScript ZerepochScriptV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> ShortByteString
Zerepoch.alwaysSucceedingNAryFunction
  (Natural -> ShortByteString)
-> (WitCtx witctx -> Natural) -> WitCtx witctx -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WitCtx witctx -> Natural
forall witctx. WitCtx witctx -> Natural
scriptArityForWitCtx

-- | An example Zerepoch 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.
--
exampleZerepochScriptAlwaysFails :: WitCtx witctx
                               -> ZerepochScript ZerepochScriptV1
exampleZerepochScriptAlwaysFails :: WitCtx witctx -> ZerepochScript ZerepochScriptV1
exampleZerepochScriptAlwaysFails =
    ShortByteString -> ZerepochScript ZerepochScriptV1
forall lang. ShortByteString -> ZerepochScript lang
ZerepochScriptSerialised
  (ShortByteString -> ZerepochScript ZerepochScriptV1)
-> (WitCtx witctx -> ShortByteString)
-> WitCtx witctx
-> ZerepochScript ZerepochScriptV1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> ShortByteString
Zerepoch.alwaysFailingNAryFunction
  (Natural -> ShortByteString)
-> (WitCtx witctx -> Natural) -> WitCtx witctx -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WitCtx witctx -> Natural
forall witctx. WitCtx witctx -> Natural
scriptArityForWitCtx

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


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

toSophieScript :: ScriptInEra era -> Ledger.Script (SophieLedgerEra era)
toSophieScript :: ScriptInEra era -> Script (SophieLedgerEra era)
toSophieScript (ScriptInEra ScriptLanguageInEra lang era
langInEra (SimpleScript SimpleScriptVersion lang
SimpleScriptV1 SimpleScript lang
script)) =
    case ScriptLanguageInEra lang era
langInEra of
      ScriptLanguageInEra lang era
SimpleScriptV1InSophie -> SimpleScript SimpleScriptV1 -> MultiSig StandardCrypto
toSophieMultiSig SimpleScript lang
SimpleScript SimpleScriptV1
script
      ScriptLanguageInEra lang era
SimpleScriptV1InEvie -> SimpleScript lang -> Timelock StandardCrypto
forall lang. SimpleScript lang -> Timelock StandardCrypto
toEvieTimelock SimpleScript lang
script
      ScriptLanguageInEra lang era
SimpleScriptV1InJen    -> SimpleScript lang -> Timelock StandardCrypto
forall lang. SimpleScript lang -> Timelock StandardCrypto
toEvieTimelock SimpleScript lang
script
      ScriptLanguageInEra lang era
SimpleScriptV1InAurum  -> Timelock (Crypto (AurumEra StandardCrypto))
-> Script (AurumEra StandardCrypto)
forall era. Timelock (Crypto era) -> Script era
Aurum.TimelockScript (SimpleScript lang -> Timelock StandardCrypto
forall lang. SimpleScript lang -> Timelock StandardCrypto
toEvieTimelock SimpleScript lang
script)

toSophieScript (ScriptInEra ScriptLanguageInEra lang era
langInEra (SimpleScript SimpleScriptVersion lang
SimpleScriptV2 SimpleScript lang
script)) =
    case ScriptLanguageInEra lang era
langInEra of
      ScriptLanguageInEra lang era
SimpleScriptV2InEvie -> SimpleScript lang -> Timelock StandardCrypto
forall lang. SimpleScript lang -> Timelock StandardCrypto
toEvieTimelock SimpleScript lang
script
      ScriptLanguageInEra lang era
SimpleScriptV2InJen    -> SimpleScript lang -> Timelock StandardCrypto
forall lang. SimpleScript lang -> Timelock StandardCrypto
toEvieTimelock SimpleScript lang
script
      ScriptLanguageInEra lang era
SimpleScriptV2InAurum  -> Timelock (Crypto (AurumEra StandardCrypto))
-> Script (AurumEra StandardCrypto)
forall era. Timelock (Crypto era) -> Script era
Aurum.TimelockScript (SimpleScript lang -> Timelock StandardCrypto
forall lang. SimpleScript lang -> Timelock StandardCrypto
toEvieTimelock SimpleScript lang
script)

toSophieScript (ScriptInEra ScriptLanguageInEra lang era
langInEra (ZerepochScript ZerepochScriptVersion lang
ZerepochScriptV1
                                         (ZerepochScriptSerialised ShortByteString
script))) =
    case ScriptLanguageInEra lang era
langInEra of
      ScriptLanguageInEra lang era
ZerepochScriptV1InAurum  -> ShortByteString -> Script (AurumEra StandardCrypto)
forall era. ShortByteString -> Script era
Aurum.ZerepochScript ShortByteString
script

fromSophieBasedScript  :: SophieBasedEra era
                        -> Ledger.Script (SophieLedgerEra era)
                        -> ScriptInEra era
fromSophieBasedScript :: SophieBasedEra era
-> Script (SophieLedgerEra era) -> ScriptInEra era
fromSophieBasedScript SophieBasedEra era
era Script (SophieLedgerEra era)
script =
  case SophieBasedEra era
era of
    SophieBasedEra era
SophieBasedEraSophie ->
      ScriptLanguageInEra SimpleScriptV1 SophieEra
-> Script SimpleScriptV1 -> ScriptInEra SophieEra
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScriptV1 SophieEra
SimpleScriptV1InSophie (Script SimpleScriptV1 -> ScriptInEra SophieEra)
-> Script SimpleScriptV1 -> ScriptInEra SophieEra
forall a b. (a -> b) -> a -> b
$
      SimpleScriptVersion SimpleScriptV1
-> SimpleScript SimpleScriptV1 -> Script SimpleScriptV1
forall lang.
SimpleScriptVersion lang -> SimpleScript lang -> Script lang
SimpleScript SimpleScriptVersion SimpleScriptV1
SimpleScriptV1 (SimpleScript SimpleScriptV1 -> Script SimpleScriptV1)
-> SimpleScript SimpleScriptV1 -> Script SimpleScriptV1
forall a b. (a -> b) -> a -> b
$
      MultiSig StandardCrypto -> SimpleScript SimpleScriptV1
forall lang. MultiSig StandardCrypto -> SimpleScript lang
fromSophieMultiSig Script (SophieLedgerEra era)
MultiSig StandardCrypto
script
    SophieBasedEra era
SophieBasedEraEvie ->
      ScriptLanguageInEra SimpleScriptV2 EvieEra
-> Script SimpleScriptV2 -> ScriptInEra EvieEra
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScriptV2 EvieEra
SimpleScriptV2InEvie (Script SimpleScriptV2 -> ScriptInEra EvieEra)
-> Script SimpleScriptV2 -> ScriptInEra EvieEra
forall a b. (a -> b) -> a -> b
$
      SimpleScriptVersion SimpleScriptV2
-> SimpleScript SimpleScriptV2 -> Script SimpleScriptV2
forall lang.
SimpleScriptVersion lang -> SimpleScript lang -> Script lang
SimpleScript SimpleScriptVersion SimpleScriptV2
SimpleScriptV2 (SimpleScript SimpleScriptV2 -> Script SimpleScriptV2)
-> SimpleScript SimpleScriptV2 -> Script SimpleScriptV2
forall a b. (a -> b) -> a -> b
$
      TimeLocksSupported SimpleScriptV2
-> Timelock StandardCrypto -> SimpleScript SimpleScriptV2
forall lang.
TimeLocksSupported lang
-> Timelock StandardCrypto -> SimpleScript lang
fromEvieTimelock TimeLocksSupported SimpleScriptV2
TimeLocksInSimpleScriptV2 Timelock StandardCrypto
Script (SophieLedgerEra era)
script
    SophieBasedEra era
SophieBasedEraJen ->
      ScriptLanguageInEra SimpleScriptV2 JenEra
-> Script SimpleScriptV2 -> ScriptInEra JenEra
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScriptV2 JenEra
SimpleScriptV2InJen (Script SimpleScriptV2 -> ScriptInEra JenEra)
-> Script SimpleScriptV2 -> ScriptInEra JenEra
forall a b. (a -> b) -> a -> b
$
      SimpleScriptVersion SimpleScriptV2
-> SimpleScript SimpleScriptV2 -> Script SimpleScriptV2
forall lang.
SimpleScriptVersion lang -> SimpleScript lang -> Script lang
SimpleScript SimpleScriptVersion SimpleScriptV2
SimpleScriptV2 (SimpleScript SimpleScriptV2 -> Script SimpleScriptV2)
-> SimpleScript SimpleScriptV2 -> Script SimpleScriptV2
forall a b. (a -> b) -> a -> b
$
      TimeLocksSupported SimpleScriptV2
-> Timelock StandardCrypto -> SimpleScript SimpleScriptV2
forall lang.
TimeLocksSupported lang
-> Timelock StandardCrypto -> SimpleScript lang
fromEvieTimelock TimeLocksSupported SimpleScriptV2
TimeLocksInSimpleScriptV2 Timelock StandardCrypto
Script (SophieLedgerEra era)
script
    SophieBasedEra era
SophieBasedEraAurum ->
      case Script (SophieLedgerEra era)
script of
        Aurum.TimelockScript s ->
          ScriptLanguageInEra SimpleScriptV2 AurumEra
-> Script SimpleScriptV2 -> ScriptInEra AurumEra
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScriptV2 AurumEra
SimpleScriptV2InAurum (Script SimpleScriptV2 -> ScriptInEra AurumEra)
-> Script SimpleScriptV2 -> ScriptInEra AurumEra
forall a b. (a -> b) -> a -> b
$
          SimpleScriptVersion SimpleScriptV2
-> SimpleScript SimpleScriptV2 -> Script SimpleScriptV2
forall lang.
SimpleScriptVersion lang -> SimpleScript lang -> Script lang
SimpleScript SimpleScriptVersion SimpleScriptV2
SimpleScriptV2 (SimpleScript SimpleScriptV2 -> Script SimpleScriptV2)
-> SimpleScript SimpleScriptV2 -> Script SimpleScriptV2
forall a b. (a -> b) -> a -> b
$
          TimeLocksSupported SimpleScriptV2
-> Timelock StandardCrypto -> SimpleScript SimpleScriptV2
forall lang.
TimeLocksSupported lang
-> Timelock StandardCrypto -> SimpleScript lang
fromEvieTimelock TimeLocksSupported SimpleScriptV2
TimeLocksInSimpleScriptV2 Timelock StandardCrypto
Timelock (Crypto (AurumEra StandardCrypto))
s
        Aurum.ZerepochScript s ->
          ScriptLanguageInEra ZerepochScriptV1 AurumEra
-> Script ZerepochScriptV1 -> ScriptInEra AurumEra
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra ZerepochScriptV1 AurumEra
ZerepochScriptV1InAurum (Script ZerepochScriptV1 -> ScriptInEra AurumEra)
-> Script ZerepochScriptV1 -> ScriptInEra AurumEra
forall a b. (a -> b) -> a -> b
$
          ZerepochScriptVersion ZerepochScriptV1
-> ZerepochScript ZerepochScriptV1 -> Script ZerepochScriptV1
forall lang.
ZerepochScriptVersion lang -> ZerepochScript lang -> Script lang
ZerepochScript ZerepochScriptVersion ZerepochScriptV1
ZerepochScriptV1 (ZerepochScript ZerepochScriptV1 -> Script ZerepochScriptV1)
-> ZerepochScript ZerepochScriptV1 -> Script ZerepochScriptV1
forall a b. (a -> b) -> a -> b
$
          ShortByteString -> ZerepochScript ZerepochScriptV1
forall lang. ShortByteString -> ZerepochScript lang
ZerepochScriptSerialised ShortByteString
s


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

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

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

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


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

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

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


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


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

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

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

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

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

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

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

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

parsePaymentKeyHash :: Text -> Aeson.Parser (Hash PaymentKey)
parsePaymentKeyHash :: Text -> Parser (Hash PaymentKey)
parsePaymentKeyHash Text
txt =
    case AsType (Hash PaymentKey) -> ByteString -> Maybe (Hash PaymentKey)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Maybe a
deserialiseFromRawBytesHex (AsType PaymentKey -> AsType (Hash PaymentKey)
forall a. AsType a -> AsType (Hash a)
AsHash AsType PaymentKey
AsPaymentKey) (Text -> ByteString
Text.encodeUtf8 Text
txt) of
      Just Hash PaymentKey
payKeyHash -> Hash PaymentKey -> Parser (Hash PaymentKey)
forall (m :: * -> *) a. Monad m => a -> m a
return Hash PaymentKey
payKeyHash
      Maybe (Hash PaymentKey)
Nothing -> String -> Parser (Hash PaymentKey)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (Hash PaymentKey))
-> String -> Parser (Hash PaymentKey)
forall a b. (a -> b) -> a -> b
$ String
"Error deserialising payment key hash: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
txt