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

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

    -- * Simple Script Related
  , readFileSimpleScript
  )
where

import Cardano.Api as Api
import Cardano.Api.Experimental (obtainCommonConstraints)
import Cardano.Api.Experimental qualified as Exp

import Cardano.CLI.Compatible.Exception
import Cardano.CLI.Read (readFileCli)
import Cardano.CLI.Type.Common
import Cardano.CLI.Type.Error.ScriptDataError

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

-- TODO: Update to handle hex script bytes directly as well!
readFileSimpleScript
  :: forall era e
   . FilePath
  -> Exp.Era era
  -> CIO e (Exp.SimpleScript (Exp.LedgerEra era))
readFileSimpleScript :: forall era e.
FilePath -> Era era -> CIO e (SimpleScript (LedgerEra era))
readFileSimpleScript FilePath
file Era era
era = do
  bs <- FilePath -> RIO e ByteString
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FilePath -> m ByteString
readFileCli FilePath
file
  case deserialiseFromJSON bs of
    Left JsonDecodeError
_ -> do
      -- In addition to the TextEnvelope format, we also try to
      -- deserialize the JSON representation of SimpleScripts.
      script :: SimpleScript <- Either FilePath SimpleScript -> RIO e SimpleScript
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli (Either FilePath SimpleScript -> RIO e SimpleScript)
-> Either FilePath SimpleScript -> RIO e SimpleScript
forall a b. (a -> b) -> a -> b
$ ByteString -> Either FilePath SimpleScript
forall a. FromJSON a => ByteString -> Either FilePath a
Aeson.eitherDecodeStrict' ByteString
bs
      -- RequireGuard has no Conway representation; convert directly for the target era.
      Exp.obtainCommonConstraints era $
        pure . Exp.SimpleScript $ case era of
          Era era
Exp.DijkstraEra -> SimpleScript -> NativeScript (ShelleyLedgerEra DijkstraEra)
toDijkstraNativeScript SimpleScript
script
          Era era
Exp.ConwayEra -> SimpleScript -> NativeScript ConwayEra
forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
SimpleScript -> NativeScript era
toAllegraTimelock SimpleScript
script
    Right TextEnvelope
te -> do
      let scriptBs :: ByteString
scriptBs = TextEnvelope -> ByteString
teRawCBOR TextEnvelope
te
      Era era
-> (EraCommonConstraints era =>
    RIO e (SimpleScript (LedgerEra era)))
-> RIO e (SimpleScript (LedgerEra era))
forall era a. Era era -> (EraCommonConstraints era => a) -> a
obtainCommonConstraints Era era
era ((EraCommonConstraints era => RIO e (SimpleScript (LedgerEra era)))
 -> RIO e (SimpleScript (LedgerEra era)))
-> (EraCommonConstraints era =>
    RIO e (SimpleScript (LedgerEra era)))
-> RIO e (SimpleScript (LedgerEra era))
forall a b. (a -> b) -> a -> b
$
        Either DecoderError (SimpleScript (LedgerEra era))
-> RIO e (SimpleScript (LedgerEra era))
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli (Either DecoderError (SimpleScript (LedgerEra era))
 -> RIO e (SimpleScript (LedgerEra era)))
-> Either DecoderError (SimpleScript (LedgerEra era))
-> RIO e (SimpleScript (LedgerEra era))
forall a b. (a -> b) -> a -> b
$
          ByteString -> Either DecoderError (SimpleScript (LedgerEra era))
forall era.
EraScript era =>
ByteString -> Either DecoderError (SimpleScript era)
Exp.deserialiseSimpleScript ByteString
scriptBs

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 FilePath
fp) = do
  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
. FilePath -> IOException -> FileError ()
forall e. FilePath -> IOException -> FileError e
FileIOError FilePath
fp) (IO ByteString -> ExceptT ScriptDataError m ByteString)
-> IO ByteString -> ExceptT ScriptDataError m ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
LBS.readFile FilePath
fp
  sDataValue <- hoistEither . first (ScriptDataErrorJsonParse fp) $ Aeson.eitherDecode sDataBs
  hoistEither
    . first ScriptDataErrorJsonBytes
    $ scriptDataJsonToHashable ScriptDataJsonDetailedSchema sDataValue
readScriptDataOrFile (ScriptDataCborFile FilePath
fp) = do
  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
. FilePath -> IOException -> FileError ()
forall e. FilePath -> IOException -> FileError e
FileIOError FilePath
fp) (FilePath -> IO ByteString
BS.readFile FilePath
fp)
  hSd <-
    firstExceptT (ScriptDataErrorMetadataDecode fp) $
      hoistEither $
        deserialiseFromCBOR AsHashableScriptData origBs
  firstExceptT (ScriptDataErrorValidation fp) $
    hoistEither $
      validateScriptData $
        getScriptData hSd
  return hSd