{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}

module Cardano.CLI.EraBased.Script.Read.Common
  ( -- * Plutus Script Related
    readScriptDataOrFile

    -- * Simple Script Related
  , readFileSimpleScript
  )
where

import Cardano.Api as Api

import Cardano.CLI.Compatible.Exception
import Cardano.CLI.Read (readFileCli)
import Cardano.CLI.Type.Common
import Cardano.CLI.Type.Error.ScriptDataError
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.ByteString.Lazy.Char8 qualified as LBS

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

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

readScriptDataOrFile
  :: MonadIO m
  => ScriptDataOrFile
  -> ExceptT ScriptDataError m HashableScriptData
readScriptDataOrFile :: forall (m :: * -> *).
MonadIO m =>
ScriptDataOrFile -> ExceptT ScriptDataError m HashableScriptData
readScriptDataOrFile (ScriptDataValue HashableScriptData
d) = HashableScriptData -> ExceptT ScriptDataError m HashableScriptData
forall a. a -> ExceptT ScriptDataError m a
forall (m :: * -> *) a. Monad m => a -> m a
return HashableScriptData
d
readScriptDataOrFile (ScriptDataJsonFile String
fp) = do
  ByteString
sDataBs <- (IOException -> ScriptDataError)
-> IO ByteString -> ExceptT ScriptDataError m ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ScriptDataError
ScriptDataErrorFile (FileError () -> ScriptDataError)
-> (IOException -> FileError ()) -> IOException -> ScriptDataError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
fp) (IO ByteString -> ExceptT ScriptDataError m ByteString)
-> IO ByteString -> ExceptT ScriptDataError m ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
LBS.readFile String
fp
  Value
sDataValue <- Either ScriptDataError Value -> ExceptT ScriptDataError m Value
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either ScriptDataError Value -> ExceptT ScriptDataError m Value)
-> (Either String Value -> Either ScriptDataError Value)
-> Either String Value
-> ExceptT ScriptDataError m Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ScriptDataError)
-> Either String Value -> Either ScriptDataError Value
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 (String -> String -> ScriptDataError
ScriptDataErrorJsonParse String
fp) (Either String Value -> ExceptT ScriptDataError m Value)
-> Either String Value -> ExceptT ScriptDataError m Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode ByteString
sDataBs
  Either ScriptDataError HashableScriptData
-> ExceptT ScriptDataError m HashableScriptData
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
    (Either ScriptDataError HashableScriptData
 -> ExceptT ScriptDataError m HashableScriptData)
-> (Either ScriptDataJsonBytesError HashableScriptData
    -> Either ScriptDataError HashableScriptData)
-> Either ScriptDataJsonBytesError HashableScriptData
-> ExceptT ScriptDataError m HashableScriptData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScriptDataJsonBytesError -> ScriptDataError)
-> Either ScriptDataJsonBytesError HashableScriptData
-> Either ScriptDataError HashableScriptData
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 ScriptDataJsonBytesError -> ScriptDataError
ScriptDataErrorJsonBytes
    (Either ScriptDataJsonBytesError HashableScriptData
 -> ExceptT ScriptDataError m HashableScriptData)
-> Either ScriptDataJsonBytesError HashableScriptData
-> ExceptT ScriptDataError m HashableScriptData
forall a b. (a -> b) -> a -> b
$ ScriptDataJsonSchema
-> Value -> Either ScriptDataJsonBytesError HashableScriptData
scriptDataJsonToHashable ScriptDataJsonSchema
ScriptDataJsonDetailedSchema Value
sDataValue
readScriptDataOrFile (ScriptDataCborFile String
fp) = do
  ByteString
origBs <- (IOException -> ScriptDataError)
-> IO ByteString -> ExceptT ScriptDataError m ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ScriptDataError
ScriptDataErrorFile (FileError () -> ScriptDataError)
-> (IOException -> FileError ()) -> IOException -> ScriptDataError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
fp) (String -> IO ByteString
BS.readFile String
fp)
  HashableScriptData
hSd <-
    (DecoderError -> ScriptDataError)
-> ExceptT DecoderError m HashableScriptData
-> ExceptT ScriptDataError m HashableScriptData
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> DecoderError -> ScriptDataError
ScriptDataErrorMetadataDecode String
fp) (ExceptT DecoderError m HashableScriptData
 -> ExceptT ScriptDataError m HashableScriptData)
-> ExceptT DecoderError m HashableScriptData
-> ExceptT ScriptDataError m HashableScriptData
forall a b. (a -> b) -> a -> b
$
      Either DecoderError HashableScriptData
-> ExceptT DecoderError m HashableScriptData
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either DecoderError HashableScriptData
 -> ExceptT DecoderError m HashableScriptData)
-> Either DecoderError HashableScriptData
-> ExceptT DecoderError m HashableScriptData
forall a b. (a -> b) -> a -> b
$
        AsType HashableScriptData
-> ByteString -> Either DecoderError HashableScriptData
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
deserialiseFromCBOR AsType HashableScriptData
AsHashableScriptData ByteString
origBs
  (ScriptDataRangeError -> ScriptDataError)
-> ExceptT ScriptDataRangeError m ()
-> ExceptT ScriptDataError m ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> ScriptDataRangeError -> ScriptDataError
ScriptDataErrorValidation String
fp) (ExceptT ScriptDataRangeError m () -> ExceptT ScriptDataError m ())
-> ExceptT ScriptDataRangeError m ()
-> ExceptT ScriptDataError m ()
forall a b. (a -> b) -> a -> b
$
    Either ScriptDataRangeError () -> ExceptT ScriptDataRangeError m ()
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either ScriptDataRangeError ()
 -> ExceptT ScriptDataRangeError m ())
-> Either ScriptDataRangeError ()
-> ExceptT ScriptDataRangeError m ()
forall a b. (a -> b) -> a -> b
$
      ScriptData -> Either ScriptDataRangeError ()
validateScriptData (ScriptData -> Either ScriptDataRangeError ())
-> ScriptData -> Either ScriptDataRangeError ()
forall a b. (a -> b) -> a -> b
$
        HashableScriptData -> ScriptData
getScriptData HashableScriptData
hSd
  HashableScriptData -> ExceptT ScriptDataError m HashableScriptData
forall a. a -> ExceptT ScriptDataError m a
forall (m :: * -> *) a. Monad m => a -> m a
return HashableScriptData
hSd