{-# 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 Cardano.Ledger.Core qualified as L

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
      let s :: L.NativeScript (Exp.LedgerEra era) = obtainCommonConstraints era $ toAllegraTimelock script
      return $ obtainCommonConstraints (era :: Exp.Era era) $ Exp.SimpleScript s
    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