{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Cardano.Api.Experimental.AnyScript
  ( AnyScript (..)
  , AsType (..)
  , AnyScriptDecodeError (..)
  , deserialiseAnyPlutusScriptOfLanguage
  , deserialiseAnySimpleScript
  , hashAnyScript
  , readAnyScriptBytes
  , readFileAnyScript
  )
where

import Cardano.Api.Error (Error (..), FileError (..), fileIOExceptT)
import Cardano.Api.Experimental.Era
import Cardano.Api.Experimental.Plutus.Internal.Script hiding (AnyPlutusScript)
import Cardano.Api.Experimental.Plutus.Internal.Script qualified as PlutusScript
import Cardano.Api.Experimental.Simple.Script
import Cardano.Api.HasTypeProxy
import Cardano.Api.IO (File (..), FileDirection (In), readFileBlocking)
import Cardano.Api.Ledger.Internal.Reexport qualified as L
import Cardano.Api.Plutus.Internal.Script (toAllegraTimelock)
import Cardano.Api.Plutus.Internal.Script qualified as OldScript
  ( AsType (AsScript, AsSimpleScript)
  , SimpleScript
  )
import Cardano.Api.Pretty (pretty, vsep, (<+>))
import Cardano.Api.Serialise.Cbor
import Cardano.Api.Serialise.Json (JsonDecodeError (..), deserialiseFromJSON)
import Cardano.Api.Serialise.TextEnvelope (TextEnvelope (..), TextEnvelopeType (..))
import Cardano.Api.Serialise.TextEnvelope.Internal (textEnvelopeType)

import Cardano.Ledger.Binary qualified as CBOR
import Cardano.Ledger.Core qualified as L
import Cardano.Ledger.Plutus.Language qualified as Plutus

import Control.Monad.Trans.Except (runExceptT)
import Control.Monad.Trans.Except.Extra (firstExceptT, hoistEither)
import Data.Bifunctor (bimap, first)
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.Either.Combinators (maybeToRight, rightToMaybe)
import Data.Foldable (asum)
import Data.Text qualified as Text
import Data.Type.Equality ((:~:) (..))
import Data.Typeable (Typeable, eqT)

data AnyScript era where
  AnySimpleScript :: SimpleScript era -> AnyScript era
  AnyPlutusScript
    :: (Plutus.PlutusLanguage lang, Typeable lang) => PlutusScriptInEra lang era -> AnyScript era

instance L.Era era => HasTypeProxy (AnyScript era) where
  data AsType (AnyScript era) = AsAnyScript
  proxyToAsType :: Proxy (AnyScript era) -> AsType (AnyScript era)
proxyToAsType Proxy (AnyScript era)
_ = AsType (AnyScript era)
forall era. AsType (AnyScript era)
AsAnyScript

instance Show (AnyScript era) where
  show :: AnyScript era -> String
show (AnySimpleScript SimpleScript era
ss) = String
"AnySimpleScript " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SimpleScript era -> String
forall a. Show a => a -> String
show SimpleScript era
ss
  show (AnyPlutusScript PlutusScriptInEra lang era
ps) = String
"AnyPlutusScript " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PlutusScriptInEra lang era -> String
forall a. Show a => a -> String
show PlutusScriptInEra lang era
ps

instance Eq (AnyScript era) where
  AnySimpleScript SimpleScript era
s1 == :: AnyScript era -> AnyScript era -> Bool
== AnySimpleScript SimpleScript era
s2 = SimpleScript era
s1 SimpleScript era -> SimpleScript era -> Bool
forall a. Eq a => a -> a -> Bool
== SimpleScript era
s2
  AnyPlutusScript (PlutusScriptInEra lang era
ps1 :: PlutusScriptInEra lang1 era) == AnyPlutusScript (PlutusScriptInEra lang era
ps2 :: PlutusScriptInEra lang2 era) =
    case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
forall (a :: Language) (b :: Language).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @lang1 @lang2 of
      Just lang :~: lang
Refl -> PlutusScriptInEra lang era
ps1 PlutusScriptInEra lang era -> PlutusScriptInEra lang era -> Bool
forall a. Eq a => a -> a -> Bool
== PlutusScriptInEra lang era
PlutusScriptInEra lang era
ps2
      Maybe (lang :~: lang)
Nothing -> Bool
False
  AnyScript era
_ == AnyScript era
_ = Bool
False

instance
  L.AlonzoEraScript era
  => SerialiseAsCBOR (AnyScript era)
  where
  serialiseToCBOR :: AnyScript era -> ByteString
serialiseToCBOR (AnySimpleScript (SimpleScript NativeScript era
ns)) =
    Version -> Script era -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
L.serialize' (forall era. Era era => Version
L.eraProtVerHigh @era) (NativeScript era -> Script era
forall era. EraScript era => NativeScript era -> Script era
L.fromNativeScript NativeScript era
ns :: L.Script era)
  serialiseToCBOR (AnyPlutusScript PlutusScriptInEra lang era
ps) =
    Version -> Script era -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
L.serialize' (forall era. Era era => Version
L.eraProtVerHigh @era) (PlutusScriptInEra lang era -> Script era
forall (lang :: Language) era.
AlonzoEraScript era =>
PlutusScriptInEra lang era -> Script era
plutusScriptInEraToScript PlutusScriptInEra lang era
ps)

  deserialiseFromCBOR :: AsType (AnyScript era)
-> ByteString -> Either DecoderError (AnyScript era)
deserialiseFromCBOR AsType (AnyScript era)
_ ByteString
bs = do
    script <- Either DecoderError (Script era)
decodeScript
    maybeToRight noParseError $
      asum
        [ tryNativeScript script
        , tryPlutusScript script
        ]
   where
    decodeScript :: Either CBOR.DecoderError (L.Script era)
    decodeScript :: Either DecoderError (Script era)
decodeScript = do
      r <- Annotator (Script era)
-> FullByteString -> Either DecoderError (Script era)
forall a. Annotator a -> FullByteString -> Either DecoderError a
CBOR.runAnnotator (Annotator (Script era)
 -> FullByteString -> Either DecoderError (Script era))
-> Either DecoderError (Annotator (Script era))
-> Either
     DecoderError (FullByteString -> Either DecoderError (Script era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version
-> ByteString -> Either DecoderError (Annotator (Script era))
forall a.
DecCBOR a =>
Version -> ByteString -> Either DecoderError a
CBOR.decodeFull' (forall era. Era era => Version
L.eraProtVerHigh @era) ByteString
bs
      r $ CBOR.Full $ BS.fromStrict bs

    tryNativeScript :: L.Script era -> Maybe (AnyScript era)
    tryNativeScript :: Script era -> Maybe (AnyScript era)
tryNativeScript = (NativeScript era -> AnyScript era)
-> Maybe (NativeScript era) -> Maybe (AnyScript era)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SimpleScript era -> AnyScript era
forall era. SimpleScript era -> AnyScript era
AnySimpleScript (SimpleScript era -> AnyScript era)
-> (NativeScript era -> SimpleScript era)
-> NativeScript era
-> AnyScript era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NativeScript era -> SimpleScript era
forall era. EraScript era => NativeScript era -> SimpleScript era
SimpleScript) (Maybe (NativeScript era) -> Maybe (AnyScript era))
-> (Script era -> Maybe (NativeScript era))
-> Script era
-> Maybe (AnyScript era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script era -> Maybe (NativeScript era)
forall era. EraScript era => Script era -> Maybe (NativeScript era)
L.getNativeScript

    tryPlutusScript :: L.Script era -> Maybe (AnyScript era)
    tryPlutusScript :: Script era -> Maybe (AnyScript era)
tryPlutusScript Script era
script = do
      ps <- Script era -> Maybe (PlutusScript era)
forall era.
AlonzoEraScript era =>
Script era -> Maybe (PlutusScript era)
L.toPlutusScript Script era
script
      L.withPlutusScript ps $ \(Plutus l
plutus :: Plutus.Plutus l) ->
        PlutusScriptInEra l era -> AnyScript era
forall (lang :: Language) era.
(PlutusLanguage lang, Typeable lang) =>
PlutusScriptInEra lang era -> AnyScript era
AnyPlutusScript (PlutusScriptInEra l era -> AnyScript era)
-> (PlutusRunnable l -> PlutusScriptInEra l era)
-> PlutusRunnable l
-> AnyScript era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlutusRunnable l -> PlutusScriptInEra l era
forall (lang :: Language) era.
PlutusLanguage lang =>
PlutusRunnable lang -> PlutusScriptInEra lang era
PlutusScriptInEra
          (PlutusRunnable l -> AnyScript era)
-> Maybe (PlutusRunnable l) -> Maybe (AnyScript era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either ScriptDecodeError (PlutusRunnable l)
-> Maybe (PlutusRunnable l)
forall a b. Either a b -> Maybe b
rightToMaybe (Version -> Plutus l -> Either ScriptDecodeError (PlutusRunnable l)
forall (l :: Language).
PlutusLanguage l =>
Version -> Plutus l -> Either ScriptDecodeError (PlutusRunnable l)
Plutus.decodePlutusRunnable (forall era. Era era => Version
L.eraProtVerHigh @era) Plutus l
plutus)

    noParseError :: CBOR.DecoderError
    noParseError :: DecoderError
noParseError =
      Text -> Text -> DecoderError
CBOR.DecoderErrorCustom
        Text
"AnyScript"
        Text
"Decoded Script era is neither a NativeScript nor a PlutusScript"

hashAnyScript :: forall era. IsEra era => AnyScript (LedgerEra era) -> L.ScriptHash
hashAnyScript :: forall era. IsEra era => AnyScript (LedgerEra era) -> ScriptHash
hashAnyScript (AnySimpleScript SimpleScript (LedgerEra era)
ss) =
  SimpleScript (LedgerEra era) -> ScriptHash
forall era. IsEra era => SimpleScript (LedgerEra era) -> ScriptHash
hashSimpleScript SimpleScript (LedgerEra era)
ss
hashAnyScript (AnyPlutusScript PlutusScriptInEra lang (LedgerEra era)
ps) =
  PlutusScriptInEra lang (LedgerEra era) -> ScriptHash
forall era (lang :: Language).
IsEra era =>
PlutusScriptInEra lang (LedgerEra era) -> ScriptHash
hashPlutusScriptInEra PlutusScriptInEra lang (LedgerEra era)
ps

deserialiseAnySimpleScript
  :: forall era. IsEra era => BS.ByteString -> Either CBOR.DecoderError (AnyScript (LedgerEra era))
deserialiseAnySimpleScript :: forall era.
IsEra era =>
ByteString -> Either DecoderError (AnyScript (LedgerEra era))
deserialiseAnySimpleScript ByteString
bs =
  SimpleScript (LedgerEra era) -> AnyScript (LedgerEra era)
forall era. SimpleScript era -> AnyScript era
AnySimpleScript (SimpleScript (LedgerEra era) -> AnyScript (LedgerEra era))
-> Either DecoderError (SimpleScript (LedgerEra era))
-> Either DecoderError (AnyScript (LedgerEra era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Era era
-> (EraCommonConstraints era =>
    Either DecoderError (SimpleScript (LedgerEra era)))
-> Either DecoderError (SimpleScript (LedgerEra era))
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) (ByteString -> Either DecoderError (SimpleScript (LedgerEra era))
forall era.
EraScript era =>
ByteString -> Either DecoderError (SimpleScript era)
deserialiseSimpleScript ByteString
bs)

deserialiseAnyPlutusScriptOfLanguage
  :: forall era lang
   . (IsEra era, Plutus.PlutusLanguage lang, HasTypeProxy (Plutus.SLanguage lang))
  => BS.ByteString -> L.SLanguage lang -> Either CBOR.DecoderError (AnyScript (LedgerEra era))
deserialiseAnyPlutusScriptOfLanguage :: forall era (lang :: Language).
(IsEra era, PlutusLanguage lang, HasTypeProxy (SLanguage lang)) =>
ByteString
-> SLanguage lang
-> Either DecoderError (AnyScript (LedgerEra era))
deserialiseAnyPlutusScriptOfLanguage ByteString
bs SLanguage lang
lang = do
  s :: (PlutusScriptInEra lang (LedgerEra era)) <-
    Era era
-> (EraCommonConstraints era =>
    Either DecoderError (PlutusScriptInEra lang (LedgerEra era)))
-> Either DecoderError (PlutusScriptInEra lang (LedgerEra era))
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints (forall era. IsEra era => Era era
useEra @era) (SLanguage lang
-> ByteString
-> Either DecoderError (PlutusScriptInEra lang (LedgerEra era))
forall era (lang :: Language).
(PlutusLanguage lang, HasTypeProxy (SLanguage lang), Era era) =>
SLanguage lang
-> ByteString -> Either DecoderError (PlutusScriptInEra lang era)
deserialisePlutusScriptInEra SLanguage lang
lang ByteString
bs)
  return $ AnyPlutusScript s

data AnyScriptDecodeError
  = -- | A text envelope was decoded, but its Plutus CBOR payload could not be.
    AnyScriptPlutusCborError AnyPlutusScriptLanguage CBOR.DecoderError
  | -- | A text envelope was decoded, but its simple-script CBOR payload could not be.
    AnyScriptSimpleCborError CBOR.DecoderError
  | -- | The input could not be decoded as a text envelope, nor as a simple
    -- script. Both failures are retained so the caller can see why each format
    -- was rejected.
    AnyScriptJsonError
      JsonDecodeError
      -- ^ Why the input could not be decoded as a text envelope.
      JsonDecodeError
      -- ^ Why the input could not be decoded as a simple script.
  | -- | The text envelope's type is not a recognised script type.
    AnyScriptUnknownTextEnvelopeType TextEnvelopeType
  deriving Int -> AnyScriptDecodeError -> ShowS
[AnyScriptDecodeError] -> ShowS
AnyScriptDecodeError -> String
(Int -> AnyScriptDecodeError -> ShowS)
-> (AnyScriptDecodeError -> String)
-> ([AnyScriptDecodeError] -> ShowS)
-> Show AnyScriptDecodeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AnyScriptDecodeError -> ShowS
showsPrec :: Int -> AnyScriptDecodeError -> ShowS
$cshow :: AnyScriptDecodeError -> String
show :: AnyScriptDecodeError -> String
$cshowList :: [AnyScriptDecodeError] -> ShowS
showList :: [AnyScriptDecodeError] -> ShowS
Show

instance Error AnyScriptDecodeError where
  prettyError :: forall ann. AnyScriptDecodeError -> Doc ann
prettyError (AnyScriptPlutusCborError AnyPlutusScriptLanguage
lang DecoderError
e) =
    Doc ann
"Failed to decode Plutus script ("
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (AnyPlutusScriptLanguage -> Text
plutusLanguageToText AnyPlutusScriptLanguage
lang)
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
") CBOR:"
        Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> DecoderError -> Doc ann
forall ann. DecoderError -> Doc ann
forall e ann. Error e => e -> Doc ann
prettyError DecoderError
e
  prettyError (AnyScriptSimpleCborError DecoderError
e) =
    Doc ann
"Failed to decode simple script CBOR:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> DecoderError -> Doc ann
forall ann. DecoderError -> Doc ann
forall e ann. Error e => e -> Doc ann
prettyError DecoderError
e
  prettyError (AnyScriptJsonError JsonDecodeError
teErr JsonDecodeError
simpleErr) =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
      [ Doc ann
"Input could not be decoded as a text envelope, nor as a simple script."
      , Doc ann
"As a text envelope:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> JsonDecodeError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. JsonDecodeError -> Doc ann
prettyError JsonDecodeError
teErr
      , Doc ann
"As a simple script:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> JsonDecodeError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. JsonDecodeError -> Doc ann
prettyError JsonDecodeError
simpleErr
      ]
  prettyError (AnyScriptUnknownTextEnvelopeType (TextEnvelopeType String
t)) =
    Doc ann
"Unrecognised script text envelope type:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
t

-- | The text envelope type used by simple scripts, read from the canonical
-- 'HasTextEnvelope' instance so it stays in step with the type that producers
-- emit rather than duplicating the string.
simpleScriptTextEnvelopeType :: TextEnvelopeType
simpleScriptTextEnvelopeType :: TextEnvelopeType
simpleScriptTextEnvelopeType =
  AsType (Script SimpleScript') -> TextEnvelopeType
forall a. HasTextEnvelope a => AsType a -> TextEnvelopeType
textEnvelopeType (AsType SimpleScript' -> AsType (Script SimpleScript')
forall lang. AsType lang -> AsType (Script lang)
OldScript.AsScript AsType SimpleScript'
OldScript.AsSimpleScript)

-- | Decode an 'AnyScript' from its serialised form: a text envelope wrapping
-- the CBOR encoding of either a simple or a Plutus script, or (as a fallback)
-- the JSON-only encoding of a simple script.
readAnyScriptBytes
  :: forall era
   . Era era
  -> ByteString
  -> Either AnyScriptDecodeError (AnyScript (LedgerEra era))
readAnyScriptBytes :: forall era.
Era era
-> ByteString
-> Either AnyScriptDecodeError (AnyScript (LedgerEra era))
readAnyScriptBytes Era era
era ByteString
bs =
  case ByteString -> Either JsonDecodeError TextEnvelope
forall a. FromJSON a => ByteString -> Either JsonDecodeError a
deserialiseFromJSON ByteString
bs :: Either JsonDecodeError TextEnvelope of
    Right TextEnvelope
te -> Era era
-> TextEnvelope
-> Either AnyScriptDecodeError (AnyScript (LedgerEra era))
forall era.
Era era
-> TextEnvelope
-> Either AnyScriptDecodeError (AnyScript (LedgerEra era))
readTextEnvelopeScript Era era
era TextEnvelope
te
    Left JsonDecodeError
teErr -> (JsonDecodeError -> AnyScriptDecodeError)
-> Either JsonDecodeError (AnyScript (LedgerEra era))
-> Either AnyScriptDecodeError (AnyScript (LedgerEra era))
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (JsonDecodeError -> JsonDecodeError -> AnyScriptDecodeError
AnyScriptJsonError JsonDecodeError
teErr) (Era era
-> ByteString -> Either JsonDecodeError (AnyScript (LedgerEra era))
forall era.
Era era
-> ByteString -> Either JsonDecodeError (AnyScript (LedgerEra era))
readSimpleScriptFromJson Era era
era ByteString
bs)

-- | Decode an 'AnyScript' from a text envelope, selecting the Plutus or simple
-- script CBOR decoder from the envelope type, and rejecting envelope types that
-- are not scripts.
readTextEnvelopeScript
  :: forall era
   . Era era
  -> TextEnvelope
  -> Either AnyScriptDecodeError (AnyScript (LedgerEra era))
readTextEnvelopeScript :: forall era.
Era era
-> TextEnvelope
-> Either AnyScriptDecodeError (AnyScript (LedgerEra era))
readTextEnvelopeScript Era era
era TextEnvelope
te =
  let scriptBs :: ByteString
scriptBs = TextEnvelope -> ByteString
teRawCBOR TextEnvelope
te
      TextEnvelopeType String
anyScriptType = TextEnvelope -> TextEnvelopeType
teType TextEnvelope
te
   in case Text -> Maybe AnyPlutusScriptLanguage
textToPlutusLanguage (String -> Text
Text.pack String
anyScriptType) of
        Just AnyPlutusScriptLanguage
lang ->
          case Era era
-> (EraCommonConstraints era =>
    Either DecoderError (AnyPlutusScript (LedgerEra era)))
-> Either DecoderError (AnyPlutusScript (LedgerEra era))
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era =>
  Either DecoderError (AnyPlutusScript (LedgerEra era)))
 -> Either DecoderError (AnyPlutusScript (LedgerEra era)))
-> (EraCommonConstraints era =>
    Either DecoderError (AnyPlutusScript (LedgerEra era)))
-> Either DecoderError (AnyPlutusScript (LedgerEra era))
forall a b. (a -> b) -> a -> b
$
                 forall era.
Era era =>
ByteString
-> AnyPlutusScriptLanguage
-> Either DecoderError (AnyPlutusScript era)
decodeAnyPlutusScript @(LedgerEra era) ByteString
scriptBs AnyPlutusScriptLanguage
lang
                 :: Either CBOR.DecoderError (PlutusScript.AnyPlutusScript (LedgerEra era)) of
            Left DecoderError
e -> AnyScriptDecodeError
-> Either AnyScriptDecodeError (AnyScript (LedgerEra era))
forall a b. a -> Either a b
Left (AnyPlutusScriptLanguage -> DecoderError -> AnyScriptDecodeError
AnyScriptPlutusCborError AnyPlutusScriptLanguage
lang DecoderError
e)
            Right (PlutusScript.AnyPlutusScript PlutusScriptInEra lang (LedgerEra era)
ps) -> AnyScript (LedgerEra era)
-> Either AnyScriptDecodeError (AnyScript (LedgerEra era))
forall a b. b -> Either a b
Right (PlutusScriptInEra lang (LedgerEra era) -> AnyScript (LedgerEra era)
forall (lang :: Language) era.
(PlutusLanguage lang, Typeable lang) =>
PlutusScriptInEra lang era -> AnyScript era
AnyPlutusScript PlutusScriptInEra lang (LedgerEra era)
ps)
        Maybe AnyPlutusScriptLanguage
Nothing
          | TextEnvelope -> TextEnvelopeType
teType TextEnvelope
te TextEnvelopeType -> TextEnvelopeType -> Bool
forall a. Eq a => a -> a -> Bool
== TextEnvelopeType
simpleScriptTextEnvelopeType ->
              (DecoderError -> AnyScriptDecodeError)
-> (SimpleScript (LedgerEra era) -> AnyScript (LedgerEra era))
-> Either DecoderError (SimpleScript (LedgerEra era))
-> Either AnyScriptDecodeError (AnyScript (LedgerEra era))
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap DecoderError -> AnyScriptDecodeError
AnyScriptSimpleCborError SimpleScript (LedgerEra era) -> AnyScript (LedgerEra era)
forall era. SimpleScript era -> AnyScript era
AnySimpleScript (Either DecoderError (SimpleScript (LedgerEra era))
 -> Either AnyScriptDecodeError (AnyScript (LedgerEra era)))
-> Either DecoderError (SimpleScript (LedgerEra era))
-> Either AnyScriptDecodeError (AnyScript (LedgerEra era))
forall a b. (a -> b) -> a -> b
$
                Era era
-> (EraCommonConstraints era =>
    Either DecoderError (SimpleScript (LedgerEra era)))
-> Either DecoderError (SimpleScript (LedgerEra era))
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era (ByteString -> Either DecoderError (SimpleScript (LedgerEra era))
forall era.
EraScript era =>
ByteString -> Either DecoderError (SimpleScript era)
deserialiseSimpleScript ByteString
scriptBs)
          | Bool
otherwise ->
              AnyScriptDecodeError
-> Either AnyScriptDecodeError (AnyScript (LedgerEra era))
forall a b. a -> Either a b
Left (TextEnvelopeType -> AnyScriptDecodeError
AnyScriptUnknownTextEnvelopeType (TextEnvelope -> TextEnvelopeType
teType TextEnvelope
te))

-- | Decode an 'AnyScript' from the JSON-only simple script encoding.
readSimpleScriptFromJson
  :: forall era
   . Era era
  -> ByteString
  -> Either JsonDecodeError (AnyScript (LedgerEra era))
readSimpleScriptFromJson :: forall era.
Era era
-> ByteString -> Either JsonDecodeError (AnyScript (LedgerEra era))
readSimpleScriptFromJson Era era
era ByteString
bs = do
  script <- ByteString -> Either JsonDecodeError SimpleScript
forall a. FromJSON a => ByteString -> Either JsonDecodeError a
deserialiseFromJSON ByteString
bs :: Either JsonDecodeError OldScript.SimpleScript
  case era of
    Era era
DijkstraEra -> String -> Either JsonDecodeError (AnyScript (LedgerEra era))
forall a. HasCallStack => String -> a
error String
"TODO Dijkstra: Simple script not supported"
    Era era
ConwayEra ->
      Era ConwayEra
-> (EraConwayConstraints =>
    Either JsonDecodeError (AnyScript (LedgerEra era)))
-> Either JsonDecodeError (AnyScript (LedgerEra era))
forall a. Era ConwayEra -> (EraConwayConstraints => a) -> a
obtainConwayConstraints Era era
Era ConwayEra
era ((EraConwayConstraints =>
  Either JsonDecodeError (AnyScript (LedgerEra era)))
 -> Either JsonDecodeError (AnyScript (LedgerEra era)))
-> (EraConwayConstraints =>
    Either JsonDecodeError (AnyScript (LedgerEra era)))
-> Either JsonDecodeError (AnyScript (LedgerEra era))
forall a b. (a -> b) -> a -> b
$
        AnyScript (LedgerEra era)
-> Either JsonDecodeError (AnyScript (LedgerEra era))
forall a b. b -> Either a b
Right (AnyScript (LedgerEra era)
 -> Either JsonDecodeError (AnyScript (LedgerEra era)))
-> (Timelock ConwayEra -> AnyScript (LedgerEra era))
-> Timelock ConwayEra
-> Either JsonDecodeError (AnyScript (LedgerEra era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleScript ConwayEra -> AnyScript ConwayEra
SimpleScript ConwayEra -> AnyScript (LedgerEra era)
forall era. SimpleScript era -> AnyScript era
AnySimpleScript (SimpleScript ConwayEra -> AnyScript (LedgerEra era))
-> (Timelock ConwayEra -> SimpleScript ConwayEra)
-> Timelock ConwayEra
-> AnyScript (LedgerEra era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timelock ConwayEra -> SimpleScript ConwayEra
NativeScript ConwayEra -> SimpleScript ConwayEra
forall era. EraScript era => NativeScript era -> SimpleScript era
SimpleScript (Timelock ConwayEra
 -> Either JsonDecodeError (AnyScript (LedgerEra era)))
-> Timelock ConwayEra
-> Either JsonDecodeError (AnyScript (LedgerEra era))
forall a b. (a -> b) -> a -> b
$
          SimpleScript -> NativeScript ConwayEra
forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
SimpleScript -> NativeScript era
toAllegraTimelock SimpleScript
script

readFileAnyScript
  :: Era era
  -> File content In
  -> IO (Either (FileError AnyScriptDecodeError) (AnyScript (LedgerEra era)))
readFileAnyScript :: forall era content.
Era era
-> File content 'In
-> IO
     (Either
        (FileError AnyScriptDecodeError) (AnyScript (LedgerEra era)))
readFileAnyScript Era era
era File content 'In
path =
  ExceptT
  (FileError AnyScriptDecodeError) IO (AnyScript (LedgerEra era))
-> IO
     (Either
        (FileError AnyScriptDecodeError) (AnyScript (LedgerEra era)))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   (FileError AnyScriptDecodeError) IO (AnyScript (LedgerEra era))
 -> IO
      (Either
         (FileError AnyScriptDecodeError) (AnyScript (LedgerEra era))))
-> ExceptT
     (FileError AnyScriptDecodeError) IO (AnyScript (LedgerEra era))
-> IO
     (Either
        (FileError AnyScriptDecodeError) (AnyScript (LedgerEra era)))
forall a b. (a -> b) -> a -> b
$ do
    content <- String
-> (String -> IO ByteString)
-> ExceptT (FileError AnyScriptDecodeError) IO ByteString
forall (m :: * -> *) s e.
MonadIO m =>
String -> (String -> IO s) -> ExceptT (FileError e) m s
fileIOExceptT (File content 'In -> String
forall content (direction :: FileDirection).
File content direction -> String
unFile File content 'In
path) String -> IO ByteString
readFileBlocking
    firstExceptT (FileError (unFile path)) $
      hoistEither $
        readAnyScriptBytes era content