{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

module Cardano.CLI.Compatible.Read
  ( AnyPlutusScript (..)
  , readFilePlutusScript
  , readFileSimpleScript
  )
where

import Cardano.Api as Api

import Cardano.CLI.Compatible.Exception
import Cardano.CLI.Read (readFileCli)
import Cardano.CLI.Type.Error.PlutusScriptDecodeError
import Cardano.CLI.Type.Error.ScriptDecodeError

import Prelude

import Data.Aeson qualified as Aeson
import Data.Bifunctor
import Data.ByteString qualified as BS
import Data.Text qualified as Text

readFileSimpleScript
  :: FilePath
  -> CIO e (Script SimpleScript')
readFileSimpleScript :: forall e. String -> CIO e (Script SimpleScript')
readFileSimpleScript String
file = do
  ByteString
scriptBytes <- String -> RIO e ByteString
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
String -> m ByteString
readFileCli String
file
  Either ScriptDecodeError (Script SimpleScript')
-> RIO e (Script SimpleScript')
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli (Either ScriptDecodeError (Script SimpleScript')
 -> RIO e (Script SimpleScript'))
-> Either ScriptDecodeError (Script SimpleScript')
-> RIO e (Script SimpleScript')
forall a b. (a -> b) -> a -> b
$
    ByteString -> Either ScriptDecodeError (Script SimpleScript')
deserialiseSimpleScript ByteString
scriptBytes

deserialiseSimpleScript
  :: BS.ByteString
  -> Either ScriptDecodeError (Script SimpleScript')
deserialiseSimpleScript :: ByteString -> Either ScriptDecodeError (Script SimpleScript')
deserialiseSimpleScript ByteString
bs =
  case ByteString -> Either JsonDecodeError TextEnvelope
forall a. FromJSON a => ByteString -> Either JsonDecodeError a
deserialiseFromJSON ByteString
bs of
    Left JsonDecodeError
_ ->
      -- In addition to the TextEnvelope format, we also try to
      -- deserialize the JSON representation of SimpleScripts.
      case ByteString -> Either String SimpleScript
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict' ByteString
bs of
        Left String
err -> ScriptDecodeError
-> Either ScriptDecodeError (Script SimpleScript')
forall a b. a -> Either a b
Left (JsonDecodeError -> ScriptDecodeError
ScriptDecodeSimpleScriptError (JsonDecodeError -> ScriptDecodeError)
-> JsonDecodeError -> ScriptDecodeError
forall a b. (a -> b) -> a -> b
$ String -> JsonDecodeError
JsonDecodeError String
err)
        Right SimpleScript
script -> Script SimpleScript'
-> Either ScriptDecodeError (Script SimpleScript')
forall a b. b -> Either a b
Right (Script SimpleScript'
 -> Either ScriptDecodeError (Script SimpleScript'))
-> Script SimpleScript'
-> Either ScriptDecodeError (Script SimpleScript')
forall a b. (a -> b) -> a -> b
$ SimpleScript -> Script SimpleScript'
SimpleScript SimpleScript
script
    Right TextEnvelope
te ->
      case [FromSomeType HasTextEnvelope (Script SimpleScript')]
-> TextEnvelope -> Either TextEnvelopeError (Script SimpleScript')
forall b.
[FromSomeType HasTextEnvelope b]
-> TextEnvelope -> Either TextEnvelopeError b
deserialiseFromTextEnvelopeAnyOf [FromSomeType HasTextEnvelope (Script SimpleScript')
teType'] TextEnvelope
te of
        Left TextEnvelopeError
err -> ScriptDecodeError
-> Either ScriptDecodeError (Script SimpleScript')
forall a b. a -> Either a b
Left (TextEnvelopeError -> ScriptDecodeError
ScriptDecodeTextEnvelopeError TextEnvelopeError
err)
        Right Script SimpleScript'
script -> Script SimpleScript'
-> Either ScriptDecodeError (Script SimpleScript')
forall a b. b -> Either a b
Right Script SimpleScript'
script
 where
  teType' :: FromSomeType HasTextEnvelope (Script SimpleScript')
  teType' :: FromSomeType HasTextEnvelope (Script SimpleScript')
teType' = AsType (Script SimpleScript')
-> (Script SimpleScript' -> Script SimpleScript')
-> FromSomeType HasTextEnvelope (Script SimpleScript')
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType SimpleScript' -> AsType (Script SimpleScript')
forall lang. AsType lang -> AsType (Script lang)
AsScript AsType SimpleScript'
AsSimpleScript) Script SimpleScript' -> Script SimpleScript'
forall a. a -> a
id

data AnyPlutusScript where
  AnyPlutusScript
    :: IsPlutusScriptLanguage lang => PlutusScriptVersion lang -> PlutusScript lang -> AnyPlutusScript

readFilePlutusScript
  :: FilePath
  -> CIO e AnyPlutusScript
readFilePlutusScript :: forall e. String -> CIO e AnyPlutusScript
readFilePlutusScript String
plutusScriptFp = do
  ByteString
bs <-
    String -> RIO e ByteString
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
String -> m ByteString
readFileCli String
plutusScriptFp
  Either PlutusScriptDecodeError AnyPlutusScript
-> RIO e AnyPlutusScript
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli (Either PlutusScriptDecodeError AnyPlutusScript
 -> RIO e AnyPlutusScript)
-> Either PlutusScriptDecodeError AnyPlutusScript
-> RIO e AnyPlutusScript
forall a b. (a -> b) -> a -> b
$ ByteString -> Either PlutusScriptDecodeError AnyPlutusScript
deserialisePlutusScript ByteString
bs

deserialisePlutusScript
  :: BS.ByteString
  -> Either PlutusScriptDecodeError AnyPlutusScript
deserialisePlutusScript :: ByteString -> Either PlutusScriptDecodeError AnyPlutusScript
deserialisePlutusScript ByteString
bs = do
  TextEnvelope
te <- (JsonDecodeError -> PlutusScriptDecodeError)
-> Either JsonDecodeError TextEnvelope
-> Either PlutusScriptDecodeError TextEnvelope
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 -> PlutusScriptDecodeError
PlutusScriptJsonDecodeError (Either JsonDecodeError TextEnvelope
 -> Either PlutusScriptDecodeError TextEnvelope)
-> Either JsonDecodeError TextEnvelope
-> Either PlutusScriptDecodeError TextEnvelope
forall a b. (a -> b) -> a -> b
$ ByteString -> Either JsonDecodeError TextEnvelope
forall a. FromJSON a => ByteString -> Either JsonDecodeError a
deserialiseFromJSON ByteString
bs
  case TextEnvelope -> TextEnvelopeType
teType TextEnvelope
te of
    TextEnvelopeType String
s -> case String
s of
      String
"PlutusScriptV1" -> PlutusScriptVersion PlutusScriptV1
-> TextEnvelope -> Either PlutusScriptDecodeError AnyPlutusScript
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang
-> TextEnvelope -> Either PlutusScriptDecodeError AnyPlutusScript
deserialiseAnyPlutusScriptVersion PlutusScriptVersion PlutusScriptV1
PlutusScriptV1 TextEnvelope
te
      String
"PlutusScriptV2" -> PlutusScriptVersion PlutusScriptV2
-> TextEnvelope -> Either PlutusScriptDecodeError AnyPlutusScript
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang
-> TextEnvelope -> Either PlutusScriptDecodeError AnyPlutusScript
deserialiseAnyPlutusScriptVersion PlutusScriptVersion PlutusScriptV2
PlutusScriptV2 TextEnvelope
te
      String
"PlutusScriptV3" -> PlutusScriptVersion PlutusScriptV3
-> TextEnvelope -> Either PlutusScriptDecodeError AnyPlutusScript
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang
-> TextEnvelope -> Either PlutusScriptDecodeError AnyPlutusScript
deserialiseAnyPlutusScriptVersion PlutusScriptVersion PlutusScriptV3
PlutusScriptV3 TextEnvelope
te
      String
unknownScriptVersion ->
        PlutusScriptDecodeError
-> Either PlutusScriptDecodeError AnyPlutusScript
forall a b. a -> Either a b
Left (PlutusScriptDecodeError
 -> Either PlutusScriptDecodeError AnyPlutusScript)
-> (Text -> PlutusScriptDecodeError)
-> Text
-> Either PlutusScriptDecodeError AnyPlutusScript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PlutusScriptDecodeError
PlutusScriptDecodeErrorUnknownVersion (Text -> Either PlutusScriptDecodeError AnyPlutusScript)
-> Text -> Either PlutusScriptDecodeError AnyPlutusScript
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
unknownScriptVersion
 where
  deserialiseAnyPlutusScriptVersion
    :: IsPlutusScriptLanguage lang
    => PlutusScriptVersion lang
    -> TextEnvelope
    -> Either PlutusScriptDecodeError AnyPlutusScript
  deserialiseAnyPlutusScriptVersion :: forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang
-> TextEnvelope -> Either PlutusScriptDecodeError AnyPlutusScript
deserialiseAnyPlutusScriptVersion PlutusScriptVersion lang
lang TextEnvelope
tEnv =
    (TextEnvelopeError -> PlutusScriptDecodeError)
-> Either TextEnvelopeError AnyPlutusScript
-> Either PlutusScriptDecodeError AnyPlutusScript
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 TextEnvelopeError -> PlutusScriptDecodeError
PlutusScriptDecodeTextEnvelopeError (Either TextEnvelopeError AnyPlutusScript
 -> Either PlutusScriptDecodeError AnyPlutusScript)
-> Either TextEnvelopeError AnyPlutusScript
-> Either PlutusScriptDecodeError AnyPlutusScript
forall a b. (a -> b) -> a -> b
$
      [FromSomeType HasTextEnvelope AnyPlutusScript]
-> TextEnvelope -> Either TextEnvelopeError AnyPlutusScript
forall b.
[FromSomeType HasTextEnvelope b]
-> TextEnvelope -> Either TextEnvelopeError b
deserialiseFromTextEnvelopeAnyOf [AnyPlutusScriptVersion
-> FromSomeType HasTextEnvelope AnyPlutusScript
teTypes (PlutusScriptVersion lang -> AnyPlutusScriptVersion
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang -> AnyPlutusScriptVersion
AnyPlutusScriptVersion PlutusScriptVersion lang
lang)] TextEnvelope
tEnv

  teTypes :: AnyPlutusScriptVersion -> FromSomeType HasTextEnvelope AnyPlutusScript
  teTypes :: AnyPlutusScriptVersion
-> FromSomeType HasTextEnvelope AnyPlutusScript
teTypes =
    \case
      AnyPlutusScriptVersion PlutusScriptVersion lang
PlutusScriptV1 ->
        AsType (PlutusScript PlutusScriptV1)
-> (PlutusScript PlutusScriptV1 -> AnyPlutusScript)
-> FromSomeType HasTextEnvelope AnyPlutusScript
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType PlutusScriptV1 -> AsType (PlutusScript PlutusScriptV1)
forall lang. AsType lang -> AsType (PlutusScript lang)
AsPlutusScript AsType PlutusScriptV1
AsPlutusScriptV1) (PlutusScriptVersion PlutusScriptV1
-> PlutusScript PlutusScriptV1 -> AnyPlutusScript
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang -> PlutusScript lang -> AnyPlutusScript
AnyPlutusScript PlutusScriptVersion PlutusScriptV1
PlutusScriptV1)
      AnyPlutusScriptVersion PlutusScriptVersion lang
PlutusScriptV2 ->
        AsType (PlutusScript PlutusScriptV2)
-> (PlutusScript PlutusScriptV2 -> AnyPlutusScript)
-> FromSomeType HasTextEnvelope AnyPlutusScript
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType PlutusScriptV2 -> AsType (PlutusScript PlutusScriptV2)
forall lang. AsType lang -> AsType (PlutusScript lang)
AsPlutusScript AsType PlutusScriptV2
AsPlutusScriptV2) (PlutusScriptVersion PlutusScriptV2
-> PlutusScript PlutusScriptV2 -> AnyPlutusScript
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang -> PlutusScript lang -> AnyPlutusScript
AnyPlutusScript PlutusScriptVersion PlutusScriptV2
PlutusScriptV2)
      AnyPlutusScriptVersion PlutusScriptVersion lang
PlutusScriptV3 ->
        AsType (PlutusScript PlutusScriptV3)
-> (PlutusScript PlutusScriptV3 -> AnyPlutusScript)
-> FromSomeType HasTextEnvelope AnyPlutusScript
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType PlutusScriptV3 -> AsType (PlutusScript PlutusScriptV3)
forall lang. AsType lang -> AsType (PlutusScript lang)
AsPlutusScript AsType PlutusScriptV3
AsPlutusScriptV3) (PlutusScriptVersion PlutusScriptV3
-> PlutusScript PlutusScriptV3 -> AnyPlutusScript
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang -> PlutusScript lang -> AnyPlutusScript
AnyPlutusScript PlutusScriptVersion PlutusScriptV3
PlutusScriptV3)
      AnyPlutusScriptVersion PlutusScriptVersion lang
PlutusScriptV4 ->
        AsType (PlutusScript PlutusScriptV4)
-> (PlutusScript PlutusScriptV4 -> AnyPlutusScript)
-> FromSomeType HasTextEnvelope AnyPlutusScript
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType PlutusScriptV4 -> AsType (PlutusScript PlutusScriptV4)
forall lang. AsType lang -> AsType (PlutusScript lang)
AsPlutusScript AsType PlutusScriptV4
AsPlutusScriptV4) (PlutusScriptVersion PlutusScriptV4
-> PlutusScript PlutusScriptV4 -> AnyPlutusScript
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang -> PlutusScript lang -> AnyPlutusScript
AnyPlutusScript PlutusScriptVersion PlutusScriptV4
PlutusScriptV4)