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

{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

module Cardano.CLI.Shelley.Run.Read
  ( -- * Metadata
    MetadataError(..)
  , renderMetadataError
  , readFileTxMetadata
  , readTxMetadata

    -- * Script
  , ScriptWitnessError(..)
  , renderScriptWitnessError
  , readScriptDataOrFile
  , readScriptWitness
  , readScriptWitnessFiles
  , readScriptWitnessFilesThruple
  , ScriptDecodeError (..)
  , deserialiseScriptInAnyLang
  , readFileScriptInAnyLang

  -- * Script data (datums and redeemers)
  , ScriptDataError(..)
  , readScriptDatumOrFile
  , readScriptRedeemerOrFile
  , renderScriptDataError

  -- * Tx
  , CddlError
  , CddlTx(..)
  , IncompleteTx(..)
  , readFileTx
  , readFileTxBody
  , readCddlTx -- For testing purposes

  -- * Tx witnesses
  , ReadWitnessSigningDataError(..)
  , renderReadWitnessSigningDataError
  , SomeWitness(..)
  , ByronOrShelleyWitness(..)
  , ShelleyBootstrapWitnessSigningKeyData(..)
  , CddlWitnessError(..)
  , readFileTxKeyWitness
  , readWitnessSigningData

  -- * Required signer
  , RequiredSignerError(..)
  , categoriseSomeWitness
  , readRequiredSigner

  -- * FileOrPipe
  , FileOrPipe
  , fileOrPipe
  , fileOrPipePath
  , fileOrPipeCache
  , readFileOrPipe
  ) where

import           Prelude

import           Cardano.Api
import           Cardano.Api.Shelley

import           Control.Exception (bracket)
import           Control.Monad (unless)
import           Control.Monad.Trans.Except (ExceptT (..), runExceptT)
import           Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither, left,
                   newExceptT)
import qualified Data.Aeson as Aeson
import           Data.Bifunctor (first)
import qualified Data.ByteString.Builder as Builder
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as LBS
import           Data.IORef (IORef, newIORef, readIORef, writeIORef)
import qualified Data.List as List
import qualified Data.Text as Text
import           Data.Word
import           GHC.IO.Handle (hClose, hIsSeekable)
import           GHC.IO.Handle.FD (openFileBlocking)
import           System.IO (IOMode (ReadMode))

--TODO: do this nicely via the API too:
import qualified Cardano.Binary as CBOR
import           Data.Text (Text)

import           Cardano.CLI.Shelley.Parsers
import           Cardano.CLI.Types

-- Metadata

data MetadataError
  = MetadataErrorFile (FileError ())
  | MetadataErrorJsonParseError !FilePath !String
  | MetadataErrorConversionError !FilePath !TxMetadataJsonError
  | MetadataErrorValidationError !FilePath ![(Word64, TxMetadataRangeError)]
  | MetadataErrorDecodeError !FilePath !CBOR.DecoderError
  | MetadataErrorNotAvailableInEra AnyCardanoEra

renderMetadataError :: MetadataError -> Text
renderMetadataError :: MetadataError -> Text
renderMetadataError (MetadataErrorFile FileError ()
fileErr) =
  String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall e. Error e => e -> String
displayError FileError ()
fileErr
renderMetadataError (MetadataErrorJsonParseError String
fp String
jsonErr) =
  String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ String
"Invalid JSON format in file: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
fp forall a. Semigroup a => a -> a -> a
<>
              String
"\nJSON parse error: " forall a. Semigroup a => a -> a -> a
<> String
jsonErr
renderMetadataError (MetadataErrorConversionError String
fp TxMetadataJsonError
metadataErr) =
  String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ String
"Error reading metadata at: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
fp forall a. Semigroup a => a -> a -> a
<>
              String
"\n" forall a. Semigroup a => a -> a -> a
<> forall e. Error e => e -> String
displayError TxMetadataJsonError
metadataErr
renderMetadataError (MetadataErrorValidationError String
fp [(Word64, TxMetadataRangeError)]
errs) =
  String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ String
"Error validating transaction metadata at: " forall a. Semigroup a => a -> a -> a
<> String
fp forall a. Semigroup a => a -> a -> a
<> String
"\n" forall a. Semigroup a => a -> a -> a
<>
      forall a. [a] -> [[a]] -> [a]
List.intercalate String
"\n"
        [ String
"key " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Word64
k forall a. Semigroup a => a -> a -> a
<> String
":" forall a. Semigroup a => a -> a -> a
<> forall e. Error e => e -> String
displayError TxMetadataRangeError
valErr
        | (Word64
k, TxMetadataRangeError
valErr) <- [(Word64, TxMetadataRangeError)]
errs ]
renderMetadataError (MetadataErrorDecodeError String
fp DecoderError
metadataErr) =
  String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ String
"Error decoding CBOR metadata at: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
fp forall a. Semigroup a => a -> a -> a
<>
              String
" Error: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show DecoderError
metadataErr
renderMetadataError (MetadataErrorNotAvailableInEra AnyCardanoEra
e) =
  Text
"Transaction metadata not supported in " forall a. Semigroup a => a -> a -> a
<> AnyCardanoEra -> Text
renderEra AnyCardanoEra
e

readTxMetadata :: CardanoEra era
               -> TxMetadataJsonSchema
               -> [MetadataFile]
               -> IO (Either MetadataError (TxMetadataInEra era))
readTxMetadata :: forall era.
CardanoEra era
-> TxMetadataJsonSchema
-> [MetadataFile]
-> IO (Either MetadataError (TxMetadataInEra era))
readTxMetadata CardanoEra era
_ TxMetadataJsonSchema
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall era. TxMetadataInEra era
TxMetadataNone
readTxMetadata CardanoEra era
era' TxMetadataJsonSchema
schema [MetadataFile]
files =
  case forall era. CardanoEra era -> Maybe (TxMetadataSupportedInEra era)
txMetadataSupportedInEra CardanoEra era
era' of
    Maybe (TxMetadataSupportedInEra era)
Nothing ->
      forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyCardanoEra -> MetadataError
MetadataErrorNotAvailableInEra
        forall a b. (a -> b) -> a -> b
$ forall era a. CardanoEra era -> (IsCardanoEra era => a) -> a
getIsCardanoEraConstraint CardanoEra era
era' forall a b. (a -> b) -> a -> b
$ forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra era
era'
    Just TxMetadataSupportedInEra era
supported -> do
      let exceptAllTxMetadata :: ExceptT MetadataError IO [TxMetadata]
exceptAllTxMetadata = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (TxMetadataJsonSchema
-> MetadataFile -> ExceptT MetadataError IO TxMetadata
readFileTxMetadata TxMetadataJsonSchema
schema) [MetadataFile]
files
      Either MetadataError [TxMetadata]
eAllTxMetaData <- forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT MetadataError IO [TxMetadata]
exceptAllTxMetadata
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
        [TxMetadata]
metaData <- Either MetadataError [TxMetadata]
eAllTxMetaData
        forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall era.
TxMetadataSupportedInEra era -> TxMetadata -> TxMetadataInEra era
TxMetadataInEra TxMetadataSupportedInEra era
supported forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [TxMetadata]
metaData

readFileTxMetadata
  :: TxMetadataJsonSchema
  -> MetadataFile
  -> ExceptT MetadataError IO TxMetadata
readFileTxMetadata :: TxMetadataJsonSchema
-> MetadataFile -> ExceptT MetadataError IO TxMetadata
readFileTxMetadata TxMetadataJsonSchema
mapping (MetadataFileJSON String
fp) = do
  ByteString
bs <- forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> MetadataError
MetadataErrorFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. String -> IOException -> FileError e
FileIOError String
fp)
          forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
LBS.readFile String
fp
  Value
v <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> String -> MetadataError
MetadataErrorJsonParseError String
fp)
          forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode' ByteString
bs
  TxMetadata
txMetadata' <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> TxMetadataJsonError -> MetadataError
MetadataErrorConversionError String
fp)
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall a b. (a -> b) -> a -> b
$ TxMetadataJsonSchema
-> Value -> Either TxMetadataJsonError TxMetadata
metadataFromJson TxMetadataJsonSchema
mapping Value
v
  forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> [(Word64, TxMetadataRangeError)] -> MetadataError
MetadataErrorValidationError String
fp)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall a b. (a -> b) -> a -> b
$ do
      TxMetadata -> Either [(Word64, TxMetadataRangeError)] ()
validateTxMetadata TxMetadata
txMetadata'
      forall (m :: * -> *) a. Monad m => a -> m a
return TxMetadata
txMetadata'
readFileTxMetadata TxMetadataJsonSchema
_ (MetadataFileCBOR String
fp) = do
  ByteString
bs <- forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> MetadataError
MetadataErrorFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. String -> IOException -> FileError e
FileIOError String
fp)
          forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
BS.readFile String
fp
  TxMetadata
txMetadata' <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> DecoderError -> MetadataError
MetadataErrorDecodeError String
fp)
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall a b. (a -> b) -> a -> b
$ forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
deserialiseFromCBOR AsType TxMetadata
AsTxMetadata ByteString
bs
  forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> [(Word64, TxMetadataRangeError)] -> MetadataError
MetadataErrorValidationError String
fp)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall a b. (a -> b) -> a -> b
$ do
      TxMetadata -> Either [(Word64, TxMetadataRangeError)] ()
validateTxMetadata TxMetadata
txMetadata'
      forall (m :: * -> *) a. Monad m => a -> m a
return TxMetadata
txMetadata'

-- Script witnesses/ Scripts

data ScriptWitnessError
  = ScriptWitnessErrorFile (FileError ScriptDecodeError)
  | ScriptWitnessErrorScriptLanguageNotSupportedInEra AnyScriptLanguage AnyCardanoEra
  | ScriptWitnessErrorExpectedSimple !FilePath !AnyScriptLanguage
  | ScriptWitnessErrorExpectedPlutus !FilePath !AnyScriptLanguage
  | ScriptWitnessErrorReferenceScriptsNotSupportedInEra !AnyCardanoEra
  | ScriptWitnessErrorScriptData ScriptDataError

renderScriptWitnessError :: ScriptWitnessError -> Text
renderScriptWitnessError :: ScriptWitnessError -> Text
renderScriptWitnessError (ScriptWitnessErrorFile FileError ScriptDecodeError
err) =
  String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall e. Error e => e -> String
displayError FileError ScriptDecodeError
err
renderScriptWitnessError (ScriptWitnessErrorScriptLanguageNotSupportedInEra (AnyScriptLanguage ScriptLanguage lang
lang) AnyCardanoEra
anyEra) =
  Text
"The script language " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show ScriptLanguage lang
lang) forall a. Semigroup a => a -> a -> a
<> Text
" is not supported in the " forall a. Semigroup a => a -> a -> a
<>
  AnyCardanoEra -> Text
renderEra AnyCardanoEra
anyEra forall a. Semigroup a => a -> a -> a
<> Text
" era."
renderScriptWitnessError (ScriptWitnessErrorExpectedSimple String
file (AnyScriptLanguage ScriptLanguage lang
lang)) =
  String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ String
file forall a. Semigroup a => a -> a -> a
<> String
": expected a script in the simple script language, " forall a. Semigroup a => a -> a -> a
<>
  String
"but it is actually using " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ScriptLanguage lang
lang forall a. Semigroup a => a -> a -> a
<> String
". Alternatively, to use " forall a. Semigroup a => a -> a -> a
<>
  String
"a Plutus script, you must also specify the redeemer " forall a. Semigroup a => a -> a -> a
<>
  String
"(datum if appropriate) and script execution units."
renderScriptWitnessError (ScriptWitnessErrorExpectedPlutus String
file (AnyScriptLanguage ScriptLanguage lang
lang)) =
  String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ String
file forall a. Semigroup a => a -> a -> a
<> String
": expected a script in the Plutus script language, " forall a. Semigroup a => a -> a -> a
<>
  String
"but it is actually using " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ScriptLanguage lang
lang forall a. Semigroup a => a -> a -> a
<> String
"."
renderScriptWitnessError (ScriptWitnessErrorReferenceScriptsNotSupportedInEra AnyCardanoEra
anyEra) =
  Text
"Reference scripts not supported in era': " forall a. Semigroup a => a -> a -> a
<> AnyCardanoEra -> Text
renderEra AnyCardanoEra
anyEra
renderScriptWitnessError (ScriptWitnessErrorScriptData ScriptDataError
sDataError) =
  ScriptDataError -> Text
renderScriptDataError ScriptDataError
sDataError

readScriptWitnessFiles
  :: CardanoEra era
  -> [(a, Maybe (ScriptWitnessFiles ctx))]
  -> ExceptT ScriptWitnessError IO [(a, Maybe (ScriptWitness ctx era))]
readScriptWitnessFiles :: forall era a ctx.
CardanoEra era
-> [(a, Maybe (ScriptWitnessFiles ctx))]
-> ExceptT
     ScriptWitnessError IO [(a, Maybe (ScriptWitness ctx era))]
readScriptWitnessFiles CardanoEra era
era' = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (a, Maybe (ScriptWitnessFiles ctx))
-> ExceptT ScriptWitnessError IO (a, Maybe (ScriptWitness ctx era))
readSwitFile
 where
  readSwitFile :: (a, Maybe (ScriptWitnessFiles ctx))
-> ExceptT ScriptWitnessError IO (a, Maybe (ScriptWitness ctx era))
readSwitFile (a
tIn, Just ScriptWitnessFiles ctx
switFile) = do
      ScriptWitness ctx era
sWit <- forall era witctx.
CardanoEra era
-> ScriptWitnessFiles witctx
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
readScriptWitness CardanoEra era
era' ScriptWitnessFiles ctx
switFile
      forall (m :: * -> *) a. Monad m => a -> m a
return (a
tIn, forall a. a -> Maybe a
Just ScriptWitness ctx era
sWit)
  readSwitFile (a
tIn, Maybe (ScriptWitnessFiles ctx)
Nothing) = forall (m :: * -> *) a. Monad m => a -> m a
return (a
tIn, forall a. Maybe a
Nothing)

readScriptWitnessFilesThruple
  :: CardanoEra era
  -> [(a, b, Maybe (ScriptWitnessFiles ctx))]
  -> ExceptT ScriptWitnessError IO [(a, b, Maybe (ScriptWitness ctx era))]
readScriptWitnessFilesThruple :: forall era a b ctx.
CardanoEra era
-> [(a, b, Maybe (ScriptWitnessFiles ctx))]
-> ExceptT
     ScriptWitnessError IO [(a, b, Maybe (ScriptWitness ctx era))]
readScriptWitnessFilesThruple CardanoEra era
era' = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (a, b, Maybe (ScriptWitnessFiles ctx))
-> ExceptT
     ScriptWitnessError IO (a, b, Maybe (ScriptWitness ctx era))
readSwitFile
 where
  readSwitFile :: (a, b, Maybe (ScriptWitnessFiles ctx))
-> ExceptT
     ScriptWitnessError IO (a, b, Maybe (ScriptWitness ctx era))
readSwitFile (a
tIn, b
b, Just ScriptWitnessFiles ctx
switFile) = do
      ScriptWitness ctx era
sWit <- forall era witctx.
CardanoEra era
-> ScriptWitnessFiles witctx
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
readScriptWitness CardanoEra era
era' ScriptWitnessFiles ctx
switFile
      forall (m :: * -> *) a. Monad m => a -> m a
return (a
tIn, b
b, forall a. a -> Maybe a
Just ScriptWitness ctx era
sWit)
  readSwitFile (a
tIn, b
b, Maybe (ScriptWitnessFiles ctx)
Nothing) = forall (m :: * -> *) a. Monad m => a -> m a
return (a
tIn, b
b, forall a. Maybe a
Nothing)

readScriptWitness
  :: CardanoEra era
  -> ScriptWitnessFiles witctx
  -> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
readScriptWitness :: forall era witctx.
CardanoEra era
-> ScriptWitnessFiles witctx
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
readScriptWitness CardanoEra era
era' (SimpleScriptWitnessFile (ScriptFile String
scriptFile)) = do
    script :: ScriptInAnyLang
script@(ScriptInAnyLang ScriptLanguage lang
lang Script lang
_) <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError ScriptDecodeError -> ScriptWitnessError
ScriptWitnessErrorFile forall a b. (a -> b) -> a -> b
$
                                         String -> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
readFileScriptInAnyLang String
scriptFile
    ScriptInEra ScriptLanguageInEra lang era
langInEra Script lang
script'   <- forall era.
CardanoEra era
-> ScriptInAnyLang
-> ExceptT ScriptWitnessError IO (ScriptInEra era)
validateScriptSupportedInEra CardanoEra era
era' ScriptInAnyLang
script
    case Script lang
script' of
      SimpleScript SimpleScript
sscript ->
        forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era witctx.
ScriptLanguageInEra SimpleScript' era
-> SimpleScriptOrReferenceInput SimpleScript'
-> ScriptWitness witctx era
SimpleScriptWitness ScriptLanguageInEra lang era
langInEra forall a b. (a -> b) -> a -> b
$ forall lang. SimpleScript -> SimpleScriptOrReferenceInput lang
SScript SimpleScript
sscript

      -- If the supplied cli flags were for a simple script (i.e. the user did
      -- not supply the datum, redeemer or ex units), but the script file turns
      -- out to be a valid plutus script, then we must fail.
      PlutusScript{} ->
        forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall a b. (a -> b) -> a -> b
$ String -> AnyScriptLanguage -> ScriptWitnessError
ScriptWitnessErrorExpectedSimple
                 String
scriptFile
                 (forall lang. ScriptLanguage lang -> AnyScriptLanguage
AnyScriptLanguage ScriptLanguage lang
lang)

readScriptWitness CardanoEra era
era' (PlutusScriptWitnessFiles
                          (ScriptFile String
scriptFile)
                          ScriptDatumOrFile witctx
datumOrFile
                          ScriptRedeemerOrFile
redeemerOrFile
                          ExecutionUnits
execUnits) = do
    script :: ScriptInAnyLang
script@(ScriptInAnyLang ScriptLanguage lang
lang Script lang
_) <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError ScriptDecodeError -> ScriptWitnessError
ScriptWitnessErrorFile forall a b. (a -> b) -> a -> b
$
                                         String -> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
readFileScriptInAnyLang String
scriptFile
    ScriptInEra ScriptLanguageInEra lang era
langInEra Script lang
script'   <- forall era.
CardanoEra era
-> ScriptInAnyLang
-> ExceptT ScriptWitnessError IO (ScriptInEra era)
validateScriptSupportedInEra CardanoEra era
era' ScriptInAnyLang
script
    case Script lang
script' of
      PlutusScript PlutusScriptVersion lang
version PlutusScript lang
pscript -> do
        ScriptDatum witctx
datum <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ScriptDataError -> ScriptWitnessError
ScriptWitnessErrorScriptData
                   forall a b. (a -> b) -> a -> b
$ forall witctx.
ScriptDatumOrFile witctx
-> ExceptT ScriptDataError IO (ScriptDatum witctx)
readScriptDatumOrFile    ScriptDatumOrFile witctx
datumOrFile
        HashableScriptData
redeemer <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ScriptDataError -> ScriptWitnessError
ScriptWitnessErrorScriptData
                      forall a b. (a -> b) -> a -> b
$ ScriptRedeemerOrFile
-> ExceptT ScriptDataError IO HashableScriptData
readScriptRedeemerOrFile ScriptRedeemerOrFile
redeemerOrFile
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall lang era witctx.
ScriptLanguageInEra lang era
-> PlutusScriptVersion lang
-> PlutusScriptOrReferenceInput lang
-> ScriptDatum witctx
-> HashableScriptData
-> ExecutionUnits
-> ScriptWitness witctx era
PlutusScriptWitness
                   ScriptLanguageInEra lang era
langInEra PlutusScriptVersion lang
version (forall lang. PlutusScript lang -> PlutusScriptOrReferenceInput lang
PScript PlutusScript lang
pscript)
                   ScriptDatum witctx
datum
                   HashableScriptData
redeemer
                   ExecutionUnits
execUnits

      -- If the supplied cli flags were for a plutus script (i.e. the user did
      -- supply the datum, redeemer and ex units), but the script file turns
      -- out to be a valid simple script, then we must fail.
      SimpleScript{} ->
        forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall a b. (a -> b) -> a -> b
$ String -> AnyScriptLanguage -> ScriptWitnessError
ScriptWitnessErrorExpectedPlutus
                 String
scriptFile
                 (forall lang. ScriptLanguage lang -> AnyScriptLanguage
AnyScriptLanguage ScriptLanguage lang
lang)

readScriptWitness CardanoEra era
era' (PlutusReferenceScriptWitnessFiles TxIn
refTxIn
                          anyScrLang :: AnyScriptLanguage
anyScrLang@(AnyScriptLanguage ScriptLanguage lang
anyScriptLanguage)
                          ScriptDatumOrFile witctx
datumOrFile ScriptRedeemerOrFile
redeemerOrFile ExecutionUnits
execUnits Maybe PolicyId
mPid) = do
  case forall era.
CardanoEra era
-> Maybe (ReferenceTxInsScriptsInlineDatumsSupportedInEra era)
refInsScriptsAndInlineDatsSupportedInEra CardanoEra era
era' of
    Maybe (ReferenceTxInsScriptsInlineDatumsSupportedInEra era)
Nothing -> forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> ScriptWitnessError
ScriptWitnessErrorReferenceScriptsNotSupportedInEra
                    forall a b. (a -> b) -> a -> b
$ forall era a. CardanoEra era -> (IsCardanoEra era => a) -> a
getIsCardanoEraConstraint CardanoEra era
era' (forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra era
era')
    Just ReferenceTxInsScriptsInlineDatumsSupportedInEra era
_ -> do

      case forall era lang.
CardanoEra era
-> ScriptLanguage lang -> Maybe (ScriptLanguageInEra lang era)
scriptLanguageSupportedInEra CardanoEra era
era' ScriptLanguage lang
anyScriptLanguage of
        Just ScriptLanguageInEra lang era
sLangInEra ->
          case forall lang era.
ScriptLanguageInEra lang era -> ScriptLanguage lang
languageOfScriptLanguageInEra ScriptLanguageInEra lang era
sLangInEra of
            ScriptLanguage lang
SimpleScriptLanguage ->
              -- TODO: We likely need another datatype eg data ReferenceScriptWitness lang
              -- in order to make this branch unrepresentable.
              forall a. HasCallStack => String -> a
error String
"readScriptWitness: Should not be possible to specify a simple script"
            PlutusScriptLanguage PlutusScriptVersion lang
version -> do
              ScriptDatum witctx
datum <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ScriptDataError -> ScriptWitnessError
ScriptWitnessErrorScriptData
                         forall a b. (a -> b) -> a -> b
$ forall witctx.
ScriptDatumOrFile witctx
-> ExceptT ScriptDataError IO (ScriptDatum witctx)
readScriptDatumOrFile    ScriptDatumOrFile witctx
datumOrFile
              HashableScriptData
redeemer <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ScriptDataError -> ScriptWitnessError
ScriptWitnessErrorScriptData
                            forall a b. (a -> b) -> a -> b
$ ScriptRedeemerOrFile
-> ExceptT ScriptDataError IO HashableScriptData
readScriptRedeemerOrFile ScriptRedeemerOrFile
redeemerOrFile
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall lang era witctx.
ScriptLanguageInEra lang era
-> PlutusScriptVersion lang
-> PlutusScriptOrReferenceInput lang
-> ScriptDatum witctx
-> HashableScriptData
-> ExecutionUnits
-> ScriptWitness witctx era
PlutusScriptWitness
                         ScriptLanguageInEra lang era
sLangInEra
                         PlutusScriptVersion lang
version
                         (forall lang.
TxIn -> Maybe ScriptHash -> PlutusScriptOrReferenceInput lang
PReferenceScript TxIn
refTxIn (PolicyId -> ScriptHash
unPolicyId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PolicyId
mPid))
                         ScriptDatum witctx
datum HashableScriptData
redeemer ExecutionUnits
execUnits
        Maybe (ScriptLanguageInEra lang era)
Nothing ->
          forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall a b. (a -> b) -> a -> b
$ AnyScriptLanguage -> AnyCardanoEra -> ScriptWitnessError
ScriptWitnessErrorScriptLanguageNotSupportedInEra AnyScriptLanguage
anyScrLang (forall era. CardanoEra era -> AnyCardanoEra
anyCardanoEra CardanoEra era
era')
readScriptWitness CardanoEra era
era' (SimpleReferenceScriptWitnessFiles TxIn
refTxIn
                         anyScrLang :: AnyScriptLanguage
anyScrLang@(AnyScriptLanguage ScriptLanguage lang
anyScriptLanguage) Maybe PolicyId
mPid) = do
  case forall era.
CardanoEra era
-> Maybe (ReferenceTxInsScriptsInlineDatumsSupportedInEra era)
refInsScriptsAndInlineDatsSupportedInEra CardanoEra era
era' of
    Maybe (ReferenceTxInsScriptsInlineDatumsSupportedInEra era)
Nothing -> forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall a b. (a -> b) -> a -> b
$ AnyCardanoEra -> ScriptWitnessError
ScriptWitnessErrorReferenceScriptsNotSupportedInEra
                    forall a b. (a -> b) -> a -> b
$ forall era a. CardanoEra era -> (IsCardanoEra era => a) -> a
getIsCardanoEraConstraint CardanoEra era
era' (forall era. IsCardanoEra era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra CardanoEra era
era')
    Just ReferenceTxInsScriptsInlineDatumsSupportedInEra era
_ -> do
      case forall era lang.
CardanoEra era
-> ScriptLanguage lang -> Maybe (ScriptLanguageInEra lang era)
scriptLanguageSupportedInEra CardanoEra era
era' ScriptLanguage lang
anyScriptLanguage of
        Just ScriptLanguageInEra lang era
sLangInEra ->
          case forall lang era.
ScriptLanguageInEra lang era -> ScriptLanguage lang
languageOfScriptLanguageInEra ScriptLanguageInEra lang era
sLangInEra of
            ScriptLanguage lang
SimpleScriptLanguage ->
              forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era witctx.
ScriptLanguageInEra SimpleScript' era
-> SimpleScriptOrReferenceInput SimpleScript'
-> ScriptWitness witctx era
SimpleScriptWitness ScriptLanguageInEra lang era
sLangInEra
                     forall a b. (a -> b) -> a -> b
$ forall lang.
TxIn -> Maybe ScriptHash -> SimpleScriptOrReferenceInput lang
SReferenceScript TxIn
refTxIn (PolicyId -> ScriptHash
unPolicyId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PolicyId
mPid)
            PlutusScriptLanguage{} ->
              forall a. HasCallStack => String -> a
error String
"readScriptWitness: Should not be possible to specify a plutus script"
        Maybe (ScriptLanguageInEra lang era)
Nothing ->
          forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall a b. (a -> b) -> a -> b
$ AnyScriptLanguage -> AnyCardanoEra -> ScriptWitnessError
ScriptWitnessErrorScriptLanguageNotSupportedInEra AnyScriptLanguage
anyScrLang (forall era. CardanoEra era -> AnyCardanoEra
anyCardanoEra CardanoEra era
era')

validateScriptSupportedInEra :: CardanoEra era
                             -> ScriptInAnyLang
                             -> ExceptT ScriptWitnessError IO (ScriptInEra era)
validateScriptSupportedInEra :: forall era.
CardanoEra era
-> ScriptInAnyLang
-> ExceptT ScriptWitnessError IO (ScriptInEra era)
validateScriptSupportedInEra CardanoEra era
era' script :: ScriptInAnyLang
script@(ScriptInAnyLang ScriptLanguage lang
lang Script lang
_) =
    case forall era.
CardanoEra era -> ScriptInAnyLang -> Maybe (ScriptInEra era)
toScriptInEra CardanoEra era
era' ScriptInAnyLang
script of
      Maybe (ScriptInEra era)
Nothing -> forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left forall a b. (a -> b) -> a -> b
$ AnyScriptLanguage -> AnyCardanoEra -> ScriptWitnessError
ScriptWitnessErrorScriptLanguageNotSupportedInEra
                          (forall lang. ScriptLanguage lang -> AnyScriptLanguage
AnyScriptLanguage ScriptLanguage lang
lang) (forall era. CardanoEra era -> AnyCardanoEra
anyCardanoEra CardanoEra era
era')
      Just ScriptInEra era
script' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptInEra era
script'

data ScriptDataError =
    ScriptDataErrorFile (FileError ())
  | ScriptDataErrorJsonParse !FilePath !String
  | ScriptDataErrorConversion !FilePath !ScriptDataJsonError
  | ScriptDataErrorValidation !FilePath !ScriptDataRangeError
  | ScriptDataErrorMetadataDecode !FilePath !CBOR.DecoderError
  | ScriptDataErrorJsonBytes !ScriptDataJsonBytesError

renderScriptDataError :: ScriptDataError -> Text
renderScriptDataError :: ScriptDataError -> Text
renderScriptDataError (ScriptDataErrorFile FileError ()
err) =
  String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall e. Error e => e -> String
displayError FileError ()
err
renderScriptDataError (ScriptDataErrorJsonParse String
fp String
jsonErr) =
  String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ String
"Invalid JSON format in file: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
fp forall a. Semigroup a => a -> a -> a
<>
              String
"\nJSON parse error: " forall a. Semigroup a => a -> a -> a
<> String
jsonErr
renderScriptDataError (ScriptDataErrorConversion String
fp ScriptDataJsonError
sDataJsonErr) =
  String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ String
"Error reading metadata at: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
fp forall a. Semigroup a => a -> a -> a
<>
              String
"\n" forall a. Semigroup a => a -> a -> a
<> forall e. Error e => e -> String
displayError ScriptDataJsonError
sDataJsonErr
renderScriptDataError (ScriptDataErrorValidation String
fp ScriptDataRangeError
sDataRangeErr) =
  String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ String
"Error validating script data at: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
fp forall a. Semigroup a => a -> a -> a
<> String
":\n" forall a. Semigroup a => a -> a -> a
<>
              forall e. Error e => e -> String
displayError ScriptDataRangeError
sDataRangeErr
renderScriptDataError (ScriptDataErrorMetadataDecode String
fp DecoderError
decoderErr) =
  String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ String
"Error decoding CBOR metadata at: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
fp forall a. Semigroup a => a -> a -> a
<>
              String
" Error: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show DecoderError
decoderErr
renderScriptDataError (ScriptDataErrorJsonBytes ScriptDataJsonBytesError
e) =
  String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall e. Error e => e -> String
displayError ScriptDataJsonBytesError
e


readScriptDatumOrFile :: ScriptDatumOrFile witctx
                      -> ExceptT ScriptDataError IO (ScriptDatum witctx)
readScriptDatumOrFile :: forall witctx.
ScriptDatumOrFile witctx
-> ExceptT ScriptDataError IO (ScriptDatum witctx)
readScriptDatumOrFile (ScriptDatumOrFileForTxIn ScriptRedeemerOrFile
df) = HashableScriptData -> ScriptDatum WitCtxTxIn
ScriptDatumForTxIn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                                        ScriptRedeemerOrFile
-> ExceptT ScriptDataError IO HashableScriptData
readScriptDataOrFile ScriptRedeemerOrFile
df
readScriptDatumOrFile ScriptDatumOrFile witctx
InlineDatumPresentAtTxIn      = forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptDatum WitCtxTxIn
InlineScriptDatum
readScriptDatumOrFile ScriptDatumOrFile witctx
NoScriptDatumOrFileForMint    = forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptDatum WitCtxMint
NoScriptDatumForMint
readScriptDatumOrFile ScriptDatumOrFile witctx
NoScriptDatumOrFileForStake   = forall (f :: * -> *) a. Applicative f => a -> f a
pure ScriptDatum WitCtxStake
NoScriptDatumForStake

readScriptRedeemerOrFile :: ScriptRedeemerOrFile
                         -> ExceptT ScriptDataError IO ScriptRedeemer
readScriptRedeemerOrFile :: ScriptRedeemerOrFile
-> ExceptT ScriptDataError IO HashableScriptData
readScriptRedeemerOrFile = ScriptRedeemerOrFile
-> ExceptT ScriptDataError IO HashableScriptData
readScriptDataOrFile

readScriptDataOrFile :: ScriptDataOrFile
                     -> ExceptT ScriptDataError IO HashableScriptData
readScriptDataOrFile :: ScriptRedeemerOrFile
-> ExceptT ScriptDataError IO HashableScriptData
readScriptDataOrFile (ScriptDataValue HashableScriptData
d) = forall (m :: * -> *) a. Monad m => a -> m a
return HashableScriptData
d
readScriptDataOrFile (ScriptDataJsonFile String
fp) = do
  ByteString
sDataBs <- forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ScriptDataError
ScriptDataErrorFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. String -> IOException -> FileError e
FileIOError String
fp) forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
LBS.readFile String
fp
  Value
sDataValue <- forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> String -> ScriptDataError
ScriptDataErrorJsonParse String
fp) forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode ByteString
sDataBs
  forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ScriptDataJsonBytesError -> ScriptDataError
ScriptDataErrorJsonBytes
    forall a b. (a -> b) -> a -> b
$ ScriptDataJsonSchema
-> Value -> Either ScriptDataJsonBytesError HashableScriptData
scriptDataJsonToHashable ScriptDataJsonSchema
ScriptDataJsonDetailedSchema Value
sDataValue

readScriptDataOrFile (ScriptDataCborFile String
fp) = do
  ByteString
origBs <- forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ScriptDataError
ScriptDataErrorFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. String -> IOException -> FileError e
FileIOError String
fp) (String -> IO ByteString
BS.readFile String
fp)
  HashableScriptData
hSd <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> DecoderError -> ScriptDataError
ScriptDataErrorMetadataDecode String
fp)
          forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall a b. (a -> b) -> a -> b
$ forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
deserialiseFromCBOR AsType HashableScriptData
AsHashableScriptData ByteString
origBs
  forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> ScriptDataRangeError -> ScriptDataError
ScriptDataErrorValidation String
fp)
          forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall a b. (a -> b) -> a -> b
$ ScriptData -> Either ScriptDataRangeError ()
validateScriptData forall a b. (a -> b) -> a -> b
$ HashableScriptData -> ScriptData
getScriptData HashableScriptData
hSd
  forall (m :: * -> *) a. Monad m => a -> m a
return HashableScriptData
hSd


--
-- Handling decoding the variety of script languages and formats
--

data ScriptDecodeError =
       ScriptDecodeTextEnvelopeError TextEnvelopeError
     | ScriptDecodeSimpleScriptError JsonDecodeError
  deriving Int -> ScriptDecodeError -> ShowS
[ScriptDecodeError] -> ShowS
ScriptDecodeError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptDecodeError] -> ShowS
$cshowList :: [ScriptDecodeError] -> ShowS
show :: ScriptDecodeError -> String
$cshow :: ScriptDecodeError -> String
showsPrec :: Int -> ScriptDecodeError -> ShowS
$cshowsPrec :: Int -> ScriptDecodeError -> ShowS
Show

instance Error ScriptDecodeError where
  displayError :: ScriptDecodeError -> String
displayError (ScriptDecodeTextEnvelopeError TextEnvelopeError
err) =
    String
"Error decoding script: " forall a. [a] -> [a] -> [a]
++ forall e. Error e => e -> String
displayError TextEnvelopeError
err
  displayError (ScriptDecodeSimpleScriptError JsonDecodeError
err) =
    String
"Syntax error in script: " forall a. [a] -> [a] -> [a]
++ forall e. Error e => e -> String
displayError JsonDecodeError
err


-- | Read a script file. The file can either be in the text envelope format
-- wrapping the binary representation of any of the supported script languages,
-- or alternatively it can be a JSON format file for one of the simple script
-- language versions.
--
readFileScriptInAnyLang :: FilePath
                        -> ExceptT (FileError ScriptDecodeError) IO
                                   ScriptInAnyLang
readFileScriptInAnyLang :: String -> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
readFileScriptInAnyLang String
file = do
  ByteString
scriptBytes <- forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (forall e. String -> IOException -> FileError e
FileIOError String
file) forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
BS.readFile String
file
  forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (forall e. String -> e -> FileError e
FileError String
file) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall a b. (a -> b) -> a -> b
$
    ByteString -> Either ScriptDecodeError ScriptInAnyLang
deserialiseScriptInAnyLang ByteString
scriptBytes


deserialiseScriptInAnyLang :: BS.ByteString
                           -> Either ScriptDecodeError ScriptInAnyLang
deserialiseScriptInAnyLang :: ByteString -> Either ScriptDecodeError ScriptInAnyLang
deserialiseScriptInAnyLang ByteString
bs =
    -- Accept either the text envelope format wrapping the binary serialisation,
    -- or accept the simple script language in its JSON format.
    --
    case forall a.
FromJSON a =>
AsType a -> ByteString -> Either JsonDecodeError a
deserialiseFromJSON AsType TextEnvelope
AsTextEnvelope ByteString
bs of
      Left JsonDecodeError
_   ->
        -- In addition to the TextEnvelope format, we also try to
        -- deserialize the JSON representation of SimpleScripts.
        case forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict' ByteString
bs of
          Left  String
err    -> forall a b. a -> Either a b
Left (JsonDecodeError -> ScriptDecodeError
ScriptDecodeSimpleScriptError forall a b. (a -> b) -> a -> b
$ String -> JsonDecodeError
JsonDecodeError String
err)
          Right SimpleScript
script -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang ScriptLanguage SimpleScript'
SimpleScriptLanguage forall a b. (a -> b) -> a -> b
$ SimpleScript -> Script SimpleScript'
SimpleScript SimpleScript
script

      Right TextEnvelope
te ->
        case forall b.
[FromSomeType HasTextEnvelope b]
-> TextEnvelope -> Either TextEnvelopeError b
deserialiseFromTextEnvelopeAnyOf [FromSomeType HasTextEnvelope ScriptInAnyLang]
textEnvTypes TextEnvelope
te of
          Left  TextEnvelopeError
err    -> forall a b. a -> Either a b
Left (TextEnvelopeError -> ScriptDecodeError
ScriptDecodeTextEnvelopeError TextEnvelopeError
err)
          Right ScriptInAnyLang
script -> forall a b. b -> Either a b
Right ScriptInAnyLang
script

  where
    -- TODO: Think of a way to get type checker to warn when there is a missing
    -- script version.
    textEnvTypes :: [FromSomeType HasTextEnvelope ScriptInAnyLang]
    textEnvTypes :: [FromSomeType HasTextEnvelope ScriptInAnyLang]
textEnvTypes =
      [ forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall lang. AsType lang -> AsType (Script lang)
AsScript AsType SimpleScript'
AsSimpleScript)
                     (forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang ScriptLanguage SimpleScript'
SimpleScriptLanguage)

      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall lang. AsType lang -> AsType (Script lang)
AsScript AsType PlutusScriptV1
AsPlutusScriptV1)
                     (forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang (forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion PlutusScriptV1
PlutusScriptV1))

      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall lang. AsType lang -> AsType (Script lang)
AsScript AsType PlutusScriptV2
AsPlutusScriptV2)
                     (forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang (forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion PlutusScriptV2
PlutusScriptV2))
      ]

-- Tx & TxBody

newtype CddlTx = CddlTx {CddlTx -> InAnyCardanoEra Tx
unCddlTx :: InAnyCardanoEra Tx} deriving (Int -> CddlTx -> ShowS
[CddlTx] -> ShowS
CddlTx -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CddlTx] -> ShowS
$cshowList :: [CddlTx] -> ShowS
show :: CddlTx -> String
$cshow :: CddlTx -> String
showsPrec :: Int -> CddlTx -> ShowS
$cshowsPrec :: Int -> CddlTx -> ShowS
Show, CddlTx -> CddlTx -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CddlTx -> CddlTx -> Bool
$c/= :: CddlTx -> CddlTx -> Bool
== :: CddlTx -> CddlTx -> Bool
$c== :: CddlTx -> CddlTx -> Bool
Eq)

readFileTx :: FileOrPipe -> IO (Either CddlError (InAnyCardanoEra Tx))
readFileTx :: FileOrPipe -> IO (Either CddlError (InAnyCardanoEra Tx))
readFileTx FileOrPipe
file = do
  Either (FileError TextEnvelopeError) (InAnyCardanoEra Tx)
eAnyTx <- forall (thing :: * -> *).
(HasTextEnvelope (thing ByronEra),
 HasTextEnvelope (thing ShelleyEra),
 HasTextEnvelope (thing AllegraEra),
 HasTextEnvelope (thing MaryEra), HasTextEnvelope (thing AlonzoEra),
 HasTextEnvelope (thing BabbageEra)) =>
(forall era. AsType era -> AsType (thing era))
-> FileOrPipe
-> IO
     (Either (FileError TextEnvelopeError) (InAnyCardanoEra thing))
readFileInAnyCardanoEra forall era. AsType era -> AsType (Tx era)
AsTx FileOrPipe
file
  case Either (FileError TextEnvelopeError) (InAnyCardanoEra Tx)
eAnyTx of
    Left FileError TextEnvelopeError
e -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CddlTx -> InAnyCardanoEra Tx
unCddlTx forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileOrPipe
-> FileError TextEnvelopeError -> IO (Either CddlError CddlTx)
acceptTxCDDLSerialisation FileOrPipe
file FileError TextEnvelopeError
e
    Right InAnyCardanoEra Tx
tx -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right InAnyCardanoEra Tx
tx

-- IncompleteCddlFormattedTx is an CDDL formatted tx or partial tx
-- (respectively needs additional witnesses or totally unwitnessed)
-- while UnwitnessedCliFormattedTxBody is CLI formatted TxBody and
-- needs to be key witnessed.

data IncompleteTx
  = UnwitnessedCliFormattedTxBody (InAnyCardanoEra TxBody)
  | IncompleteCddlFormattedTx (InAnyCardanoEra Tx)

readFileTxBody :: FileOrPipe -> IO (Either CddlError IncompleteTx)
readFileTxBody :: FileOrPipe -> IO (Either CddlError IncompleteTx)
readFileTxBody FileOrPipe
file = do
  Either (FileError TextEnvelopeError) (InAnyCardanoEra TxBody)
eTxBody <- forall (thing :: * -> *).
(HasTextEnvelope (thing ByronEra),
 HasTextEnvelope (thing ShelleyEra),
 HasTextEnvelope (thing AllegraEra),
 HasTextEnvelope (thing MaryEra), HasTextEnvelope (thing AlonzoEra),
 HasTextEnvelope (thing BabbageEra)) =>
(forall era. AsType era -> AsType (thing era))
-> FileOrPipe
-> IO
     (Either (FileError TextEnvelopeError) (InAnyCardanoEra thing))
readFileInAnyCardanoEra forall era. AsType era -> AsType (TxBody era)
AsTxBody FileOrPipe
file
  case Either (FileError TextEnvelopeError) (InAnyCardanoEra TxBody)
eTxBody of
    Left FileError TextEnvelopeError
e -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (InAnyCardanoEra Tx -> IncompleteTx
IncompleteCddlFormattedTx forall b c a. (b -> c) -> (a -> b) -> a -> c
. CddlTx -> InAnyCardanoEra Tx
unCddlTx) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileOrPipe
-> FileError TextEnvelopeError -> IO (Either CddlError CddlTx)
acceptTxCDDLSerialisation FileOrPipe
file FileError TextEnvelopeError
e
    Right InAnyCardanoEra TxBody
txBody -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ InAnyCardanoEra TxBody -> IncompleteTx
UnwitnessedCliFormattedTxBody InAnyCardanoEra TxBody
txBody

data CddlError = CddlErrorTextEnv
                   !(FileError TextEnvelopeError)
                   !(FileError TextEnvelopeCddlError)
               | CddlIOError (FileError TextEnvelopeError)
               deriving Int -> CddlError -> ShowS
[CddlError] -> ShowS
CddlError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CddlError] -> ShowS
$cshowList :: [CddlError] -> ShowS
show :: CddlError -> String
$cshow :: CddlError -> String
showsPrec :: Int -> CddlError -> ShowS
$cshowsPrec :: Int -> CddlError -> ShowS
Show

instance Error CddlError where
  displayError :: CddlError -> String
displayError (CddlErrorTextEnv FileError TextEnvelopeError
textEnvErr FileError TextEnvelopeCddlError
cddlErr) =
    String
"Failed to decode neither the cli's serialisation format nor the ledger's \
    \CDDL serialisation format. TextEnvelope error: " forall a. Semigroup a => a -> a -> a
<> forall e. Error e => e -> String
displayError FileError TextEnvelopeError
textEnvErr forall a. Semigroup a => a -> a -> a
<> String
"\n" forall a. Semigroup a => a -> a -> a
<>
    String
"TextEnvelopeCddl error: " forall a. Semigroup a => a -> a -> a
<> forall e. Error e => e -> String
displayError FileError TextEnvelopeCddlError
cddlErr
  displayError (CddlIOError FileError TextEnvelopeError
e) = forall e. Error e => e -> String
displayError FileError TextEnvelopeError
e

acceptTxCDDLSerialisation
  :: FileOrPipe
  -> FileError TextEnvelopeError
  -> IO (Either CddlError CddlTx)
acceptTxCDDLSerialisation :: FileOrPipe
-> FileError TextEnvelopeError -> IO (Either CddlError CddlTx)
acceptTxCDDLSerialisation FileOrPipe
file FileError TextEnvelopeError
err =
  case FileError TextEnvelopeError
err of
   e :: FileError TextEnvelopeError
e@(FileError String
_ (TextEnvelopeDecodeError DecoderError
_)) ->
      forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (FileError TextEnvelopeError
-> FileError TextEnvelopeCddlError -> CddlError
CddlErrorTextEnv FileError TextEnvelopeError
e) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileOrPipe -> IO (Either (FileError TextEnvelopeCddlError) CddlTx)
readCddlTx FileOrPipe
file
   e :: FileError TextEnvelopeError
e@(FileError String
_ (TextEnvelopeAesonDecodeError String
_)) ->
      forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (FileError TextEnvelopeError
-> FileError TextEnvelopeCddlError -> CddlError
CddlErrorTextEnv FileError TextEnvelopeError
e) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileOrPipe -> IO (Either (FileError TextEnvelopeCddlError) CddlTx)
readCddlTx FileOrPipe
file
   e :: FileError TextEnvelopeError
e@(FileError String
_ (TextEnvelopeTypeError [TextEnvelopeType]
_ TextEnvelopeType
_)) ->
      forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (FileError TextEnvelopeError
-> FileError TextEnvelopeCddlError -> CddlError
CddlErrorTextEnv FileError TextEnvelopeError
e) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileOrPipe -> IO (Either (FileError TextEnvelopeCddlError) CddlTx)
readCddlTx FileOrPipe
file
   e :: FileError TextEnvelopeError
e@FileErrorTempFile{} -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ FileError TextEnvelopeError -> CddlError
CddlIOError FileError TextEnvelopeError
e
   e :: FileError TextEnvelopeError
e@FileIOError{} -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ FileError TextEnvelopeError -> CddlError
CddlIOError FileError TextEnvelopeError
e

readCddlTx :: FileOrPipe -> IO (Either (FileError TextEnvelopeCddlError) CddlTx)
readCddlTx :: FileOrPipe -> IO (Either (FileError TextEnvelopeCddlError) CddlTx)
readCddlTx = forall b.
[FromSomeTypeCDDL TextEnvelopeCddl b]
-> FileOrPipe -> IO (Either (FileError TextEnvelopeCddlError) b)
readFileOrPipeTextEnvelopeCddlAnyOf [FromSomeTypeCDDL TextEnvelopeCddl CddlTx]
teTypes
 where
    teTypes :: [FromSomeTypeCDDL TextEnvelopeCddl CddlTx]
teTypes = [ forall b.
Text
-> (InAnyCardanoEra Tx -> b) -> FromSomeTypeCDDL TextEnvelopeCddl b
FromCDDLTx Text
"Witnessed Tx ByronEra" InAnyCardanoEra Tx -> CddlTx
CddlTx
              , forall b.
Text
-> (InAnyCardanoEra Tx -> b) -> FromSomeTypeCDDL TextEnvelopeCddl b
FromCDDLTx Text
"Witnessed Tx ShelleyEra" InAnyCardanoEra Tx -> CddlTx
CddlTx
              , forall b.
Text
-> (InAnyCardanoEra Tx -> b) -> FromSomeTypeCDDL TextEnvelopeCddl b
FromCDDLTx Text
"Witnessed Tx AllegraEra" InAnyCardanoEra Tx -> CddlTx
CddlTx
              , forall b.
Text
-> (InAnyCardanoEra Tx -> b) -> FromSomeTypeCDDL TextEnvelopeCddl b
FromCDDLTx Text
"Witnessed Tx MaryEra" InAnyCardanoEra Tx -> CddlTx
CddlTx
              , forall b.
Text
-> (InAnyCardanoEra Tx -> b) -> FromSomeTypeCDDL TextEnvelopeCddl b
FromCDDLTx Text
"Witnessed Tx AlonzoEra" InAnyCardanoEra Tx -> CddlTx
CddlTx
              , forall b.
Text
-> (InAnyCardanoEra Tx -> b) -> FromSomeTypeCDDL TextEnvelopeCddl b
FromCDDLTx Text
"Witnessed Tx BabbageEra" InAnyCardanoEra Tx -> CddlTx
CddlTx
              , forall b.
Text
-> (InAnyCardanoEra Tx -> b) -> FromSomeTypeCDDL TextEnvelopeCddl b
FromCDDLTx Text
"Unwitnessed Tx ByronEra" InAnyCardanoEra Tx -> CddlTx
CddlTx
              , forall b.
Text
-> (InAnyCardanoEra Tx -> b) -> FromSomeTypeCDDL TextEnvelopeCddl b
FromCDDLTx Text
"Unwitnessed Tx ShelleyEra" InAnyCardanoEra Tx -> CddlTx
CddlTx
              , forall b.
Text
-> (InAnyCardanoEra Tx -> b) -> FromSomeTypeCDDL TextEnvelopeCddl b
FromCDDLTx Text
"Unwitnessed Tx AllegraEra" InAnyCardanoEra Tx -> CddlTx
CddlTx
              , forall b.
Text
-> (InAnyCardanoEra Tx -> b) -> FromSomeTypeCDDL TextEnvelopeCddl b
FromCDDLTx Text
"Unwitnessed Tx MaryEra" InAnyCardanoEra Tx -> CddlTx
CddlTx
              , forall b.
Text
-> (InAnyCardanoEra Tx -> b) -> FromSomeTypeCDDL TextEnvelopeCddl b
FromCDDLTx Text
"Unwitnessed Tx AlonzoEra" InAnyCardanoEra Tx -> CddlTx
CddlTx
              , forall b.
Text
-> (InAnyCardanoEra Tx -> b) -> FromSomeTypeCDDL TextEnvelopeCddl b
FromCDDLTx Text
"Unwitnessed Tx BabbageEra" InAnyCardanoEra Tx -> CddlTx
CddlTx
              ]

-- Tx witnesses

newtype CddlWitness = CddlWitness { CddlWitness -> InAnyCardanoEra KeyWitness
unCddlWitness :: InAnyCardanoEra KeyWitness}

readFileTxKeyWitness :: FilePath
                -> IO (Either CddlWitnessError (InAnyCardanoEra KeyWitness))
readFileTxKeyWitness :: String -> IO (Either CddlWitnessError (InAnyCardanoEra KeyWitness))
readFileTxKeyWitness String
fp = do
  FileOrPipe
file <- String -> IO FileOrPipe
fileOrPipe String
fp
  Either (FileError TextEnvelopeError) (InAnyCardanoEra KeyWitness)
eWitness <- forall (thing :: * -> *).
(HasTextEnvelope (thing ByronEra),
 HasTextEnvelope (thing ShelleyEra),
 HasTextEnvelope (thing AllegraEra),
 HasTextEnvelope (thing MaryEra), HasTextEnvelope (thing AlonzoEra),
 HasTextEnvelope (thing BabbageEra)) =>
(forall era. AsType era -> AsType (thing era))
-> FileOrPipe
-> IO
     (Either (FileError TextEnvelopeError) (InAnyCardanoEra thing))
readFileInAnyCardanoEra forall era. AsType era -> AsType (KeyWitness era)
AsKeyWitness FileOrPipe
file
  case Either (FileError TextEnvelopeError) (InAnyCardanoEra KeyWitness)
eWitness of
    Left FileError TextEnvelopeError
e -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CddlWitness -> InAnyCardanoEra KeyWitness
unCddlWitness forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FileError TextEnvelopeError
-> IO (Either CddlWitnessError CddlWitness)
acceptKeyWitnessCDDLSerialisation FileError TextEnvelopeError
e
    Right InAnyCardanoEra KeyWitness
keyWit -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right InAnyCardanoEra KeyWitness
keyWit

data CddlWitnessError
  = CddlWitnessErrorTextEnv
      (FileError TextEnvelopeError)
      (FileError TextEnvelopeCddlError)
  | CddlWitnessIOError (FileError TextEnvelopeError)
  deriving Int -> CddlWitnessError -> ShowS
[CddlWitnessError] -> ShowS
CddlWitnessError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CddlWitnessError] -> ShowS
$cshowList :: [CddlWitnessError] -> ShowS
show :: CddlWitnessError -> String
$cshow :: CddlWitnessError -> String
showsPrec :: Int -> CddlWitnessError -> ShowS
$cshowsPrec :: Int -> CddlWitnessError -> ShowS
Show

instance Error CddlWitnessError where
  displayError :: CddlWitnessError -> String
displayError (CddlWitnessErrorTextEnv FileError TextEnvelopeError
teErr FileError TextEnvelopeCddlError
cddlErr) =
    String
"Failed to decode neither the cli's serialisation format nor the ledger's \
    \CDDL serialisation format. TextEnvelope error: " forall a. Semigroup a => a -> a -> a
<> forall e. Error e => e -> String
displayError FileError TextEnvelopeError
teErr forall a. Semigroup a => a -> a -> a
<> String
"\n" forall a. Semigroup a => a -> a -> a
<>
    String
"TextEnvelopeCddl error: " forall a. Semigroup a => a -> a -> a
<> forall e. Error e => e -> String
displayError FileError TextEnvelopeCddlError
cddlErr
  displayError (CddlWitnessIOError FileError TextEnvelopeError
fileE) = forall e. Error e => e -> String
displayError FileError TextEnvelopeError
fileE


-- TODO: This is a stop gap to avoid modifying the TextEnvelope
-- related functions. We intend to remove this after fully deprecating
-- the cli's serialisation format
acceptKeyWitnessCDDLSerialisation
  :: FileError TextEnvelopeError
  -> IO (Either CddlWitnessError CddlWitness)
acceptKeyWitnessCDDLSerialisation :: FileError TextEnvelopeError
-> IO (Either CddlWitnessError CddlWitness)
acceptKeyWitnessCDDLSerialisation FileError TextEnvelopeError
err =
  case FileError TextEnvelopeError
err of
    e :: FileError TextEnvelopeError
e@(FileError String
fp (TextEnvelopeDecodeError DecoderError
_)) ->
      forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (FileError TextEnvelopeError
-> FileError TextEnvelopeCddlError -> CddlWitnessError
CddlWitnessErrorTextEnv FileError TextEnvelopeError
e) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Either (FileError TextEnvelopeCddlError) CddlWitness)
readCddlWitness String
fp
    e :: FileError TextEnvelopeError
e@(FileError String
fp (TextEnvelopeAesonDecodeError String
_)) ->
      forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (FileError TextEnvelopeError
-> FileError TextEnvelopeCddlError -> CddlWitnessError
CddlWitnessErrorTextEnv FileError TextEnvelopeError
e) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Either (FileError TextEnvelopeCddlError) CddlWitness)
readCddlWitness String
fp
    e :: FileError TextEnvelopeError
e@(FileError String
fp (TextEnvelopeTypeError [TextEnvelopeType]
_ TextEnvelopeType
_)) ->
      forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (FileError TextEnvelopeError
-> FileError TextEnvelopeCddlError -> CddlWitnessError
CddlWitnessErrorTextEnv FileError TextEnvelopeError
e) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Either (FileError TextEnvelopeCddlError) CddlWitness)
readCddlWitness String
fp
    e :: FileError TextEnvelopeError
e@FileErrorTempFile{} -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ FileError TextEnvelopeError -> CddlWitnessError
CddlWitnessIOError FileError TextEnvelopeError
e
    e :: FileError TextEnvelopeError
e@FileIOError{} -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ FileError TextEnvelopeError -> CddlWitnessError
CddlWitnessIOError FileError TextEnvelopeError
e

readCddlWitness
  :: FilePath
  -> IO (Either (FileError TextEnvelopeCddlError) CddlWitness)
readCddlWitness :: String -> IO (Either (FileError TextEnvelopeCddlError) CddlWitness)
readCddlWitness String
fp = do
  forall b.
[FromSomeTypeCDDL TextEnvelopeCddl b]
-> String -> IO (Either (FileError TextEnvelopeCddlError) b)
readFileTextEnvelopeCddlAnyOf [FromSomeTypeCDDL TextEnvelopeCddl CddlWitness]
teTypes String
fp
 where
  teTypes :: [FromSomeTypeCDDL TextEnvelopeCddl CddlWitness]
teTypes = [ forall b.
Text
-> (InAnyCardanoEra KeyWitness -> b)
-> FromSomeTypeCDDL TextEnvelopeCddl b
FromCDDLWitness Text
"TxWitness ShelleyEra" InAnyCardanoEra KeyWitness -> CddlWitness
CddlWitness
            , forall b.
Text
-> (InAnyCardanoEra KeyWitness -> b)
-> FromSomeTypeCDDL TextEnvelopeCddl b
FromCDDLWitness Text
"TxWitness AllegraEra" InAnyCardanoEra KeyWitness -> CddlWitness
CddlWitness
            , forall b.
Text
-> (InAnyCardanoEra KeyWitness -> b)
-> FromSomeTypeCDDL TextEnvelopeCddl b
FromCDDLWitness Text
"TxWitness MaryEra" InAnyCardanoEra KeyWitness -> CddlWitness
CddlWitness
            , forall b.
Text
-> (InAnyCardanoEra KeyWitness -> b)
-> FromSomeTypeCDDL TextEnvelopeCddl b
FromCDDLWitness Text
"TxWitness AlonzoEra" InAnyCardanoEra KeyWitness -> CddlWitness
CddlWitness
            , forall b.
Text
-> (InAnyCardanoEra KeyWitness -> b)
-> FromSomeTypeCDDL TextEnvelopeCddl b
FromCDDLWitness Text
"TxWitness BabbageEra" InAnyCardanoEra KeyWitness -> CddlWitness
CddlWitness
            ]

-- Witness handling

data SomeWitness
  = AByronSigningKey           (SigningKey ByronKey) (Maybe (Address ByronAddr))
  | APaymentSigningKey         (SigningKey PaymentKey)
  | APaymentExtendedSigningKey (SigningKey PaymentExtendedKey)
  | AStakeSigningKey           (SigningKey StakeKey)
  | AStakeExtendedSigningKey   (SigningKey StakeExtendedKey)
  | AStakePoolSigningKey       (SigningKey StakePoolKey)
  | AGenesisSigningKey         (SigningKey GenesisKey)
  | AGenesisExtendedSigningKey (SigningKey GenesisExtendedKey)
  | AGenesisDelegateSigningKey (SigningKey GenesisDelegateKey)
  | AGenesisDelegateExtendedSigningKey
                               (SigningKey GenesisDelegateExtendedKey)
  | AGenesisUTxOSigningKey     (SigningKey GenesisUTxOKey)


-- | Data required for constructing a Shelley bootstrap witness.
data ShelleyBootstrapWitnessSigningKeyData
  = ShelleyBootstrapWitnessSigningKeyData
      !(SigningKey ByronKey)
      -- ^ Byron signing key.
      !(Maybe (Address ByronAddr))
      -- ^ An optionally specified Byron address.
      --
      -- If specified, both the network ID and derivation path are extracted
      -- from the address and used in the construction of the Byron witness.

-- | Some kind of Byron or Shelley witness.
data ByronOrShelleyWitness
  = AByronWitness !ShelleyBootstrapWitnessSigningKeyData
  | AShelleyKeyWitness !ShelleyWitnessSigningKey

categoriseSomeWitness :: SomeWitness -> ByronOrShelleyWitness
categoriseSomeWitness :: SomeWitness -> ByronOrShelleyWitness
categoriseSomeWitness SomeWitness
swsk =
  case SomeWitness
swsk of
    AByronSigningKey           SigningKey ByronKey
sk Maybe (Address ByronAddr)
addr -> ShelleyBootstrapWitnessSigningKeyData -> ByronOrShelleyWitness
AByronWitness (SigningKey ByronKey
-> Maybe (Address ByronAddr)
-> ShelleyBootstrapWitnessSigningKeyData
ShelleyBootstrapWitnessSigningKeyData SigningKey ByronKey
sk Maybe (Address ByronAddr)
addr)
    APaymentSigningKey         SigningKey PaymentKey
sk      -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey PaymentKey -> ShelleyWitnessSigningKey
WitnessPaymentKey         SigningKey PaymentKey
sk)
    APaymentExtendedSigningKey SigningKey PaymentExtendedKey
sk      -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey PaymentExtendedKey -> ShelleyWitnessSigningKey
WitnessPaymentExtendedKey SigningKey PaymentExtendedKey
sk)
    AStakeSigningKey           SigningKey StakeKey
sk      -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey StakeKey -> ShelleyWitnessSigningKey
WitnessStakeKey           SigningKey StakeKey
sk)
    AStakeExtendedSigningKey   SigningKey StakeExtendedKey
sk      -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey StakeExtendedKey -> ShelleyWitnessSigningKey
WitnessStakeExtendedKey   SigningKey StakeExtendedKey
sk)
    AStakePoolSigningKey       SigningKey StakePoolKey
sk      -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey StakePoolKey -> ShelleyWitnessSigningKey
WitnessStakePoolKey       SigningKey StakePoolKey
sk)
    AGenesisSigningKey         SigningKey GenesisKey
sk      -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey GenesisKey -> ShelleyWitnessSigningKey
WitnessGenesisKey SigningKey GenesisKey
sk)
    AGenesisExtendedSigningKey SigningKey GenesisExtendedKey
sk      -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey GenesisExtendedKey -> ShelleyWitnessSigningKey
WitnessGenesisExtendedKey SigningKey GenesisExtendedKey
sk)
    AGenesisDelegateSigningKey SigningKey GenesisDelegateKey
sk      -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey GenesisDelegateKey -> ShelleyWitnessSigningKey
WitnessGenesisDelegateKey SigningKey GenesisDelegateKey
sk)
    AGenesisDelegateExtendedSigningKey SigningKey GenesisDelegateExtendedKey
sk
                                       -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey GenesisDelegateExtendedKey -> ShelleyWitnessSigningKey
WitnessGenesisDelegateExtendedKey SigningKey GenesisDelegateExtendedKey
sk)
    AGenesisUTxOSigningKey     SigningKey GenesisUTxOKey
sk      -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey GenesisUTxOKey -> ShelleyWitnessSigningKey
WitnessGenesisUTxOKey     SigningKey GenesisUTxOKey
sk)

data ReadWitnessSigningDataError
  = ReadWitnessSigningDataSigningKeyDecodeError !(FileError InputDecodeError)
  | ReadWitnessSigningDataScriptError !(FileError JsonDecodeError)
  | ReadWitnessSigningDataSigningKeyAndAddressMismatch
  -- ^ A Byron address was specified alongside a non-Byron signing key.
  deriving Int -> ReadWitnessSigningDataError -> ShowS
[ReadWitnessSigningDataError] -> ShowS
ReadWitnessSigningDataError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReadWitnessSigningDataError] -> ShowS
$cshowList :: [ReadWitnessSigningDataError] -> ShowS
show :: ReadWitnessSigningDataError -> String
$cshow :: ReadWitnessSigningDataError -> String
showsPrec :: Int -> ReadWitnessSigningDataError -> ShowS
$cshowsPrec :: Int -> ReadWitnessSigningDataError -> ShowS
Show

-- | Render an error message for a 'ReadWitnessSigningDataError'.
renderReadWitnessSigningDataError :: ReadWitnessSigningDataError -> Text
renderReadWitnessSigningDataError :: ReadWitnessSigningDataError -> Text
renderReadWitnessSigningDataError ReadWitnessSigningDataError
err =
  case ReadWitnessSigningDataError
err of
    ReadWitnessSigningDataSigningKeyDecodeError FileError InputDecodeError
fileErr ->
      Text
"Error reading signing key: " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall e. Error e => e -> String
displayError FileError InputDecodeError
fileErr)
    ReadWitnessSigningDataScriptError FileError JsonDecodeError
fileErr ->
      Text
"Error reading script: " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall e. Error e => e -> String
displayError FileError JsonDecodeError
fileErr)
    ReadWitnessSigningDataError
ReadWitnessSigningDataSigningKeyAndAddressMismatch ->
      Text
"Only a Byron signing key may be accompanied by a Byron address."

readWitnessSigningData
  :: WitnessSigningData
  -> IO (Either ReadWitnessSigningDataError SomeWitness)
readWitnessSigningData :: WitnessSigningData
-> IO (Either ReadWitnessSigningDataError SomeWitness)
readWitnessSigningData (KeyWitnessSigningData (SigningKeyFile String
skFile) Maybe (Address ByronAddr)
mbByronAddr) = do
    Either ReadWitnessSigningDataError SomeWitness
eRes <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first FileError InputDecodeError -> ReadWitnessSigningDataError
ReadWitnessSigningDataSigningKeyDecodeError
             forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b.
[FromSomeType SerialiseAsBech32 b]
-> [FromSomeType HasTextEnvelope b]
-> String
-> IO (Either (FileError InputDecodeError) b)
readKeyFileAnyOf [FromSomeType SerialiseAsBech32 SomeWitness]
bech32FileTypes [FromSomeType HasTextEnvelope SomeWitness]
textEnvFileTypes String
skFile
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
      SomeWitness
res <- Either ReadWitnessSigningDataError SomeWitness
eRes
      case (SomeWitness
res, Maybe (Address ByronAddr)
mbByronAddr) of
        (AByronSigningKey SigningKey ByronKey
_ Maybe (Address ByronAddr)
_, Just Address ByronAddr
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure SomeWitness
res
        (AByronSigningKey SigningKey ByronKey
_ Maybe (Address ByronAddr)
_, Maybe (Address ByronAddr)
Nothing) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure SomeWitness
res
        (SomeWitness
_, Maybe (Address ByronAddr)
Nothing) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure SomeWitness
res
        (SomeWitness
_, Just Address ByronAddr
_) ->
          -- A Byron address should only be specified along with a Byron signing key.
          forall a b. a -> Either a b
Left ReadWitnessSigningDataError
ReadWitnessSigningDataSigningKeyAndAddressMismatch
  where
    textEnvFileTypes :: [FromSomeType HasTextEnvelope SomeWitness]
textEnvFileTypes =
      [ forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType ByronKey
AsByronKey)
                          (SigningKey ByronKey -> Maybe (Address ByronAddr) -> SomeWitness
`AByronSigningKey` Maybe (Address ByronAddr)
mbByronAddr)
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType PaymentKey
AsPaymentKey)
                          SigningKey PaymentKey -> SomeWitness
APaymentSigningKey
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType PaymentExtendedKey
AsPaymentExtendedKey)
                          SigningKey PaymentExtendedKey -> SomeWitness
APaymentExtendedSigningKey
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakeKey
AsStakeKey)
                          SigningKey StakeKey -> SomeWitness
AStakeSigningKey
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakeExtendedKey
AsStakeExtendedKey)
                          SigningKey StakeExtendedKey -> SomeWitness
AStakeExtendedSigningKey
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakePoolKey
AsStakePoolKey)
                          SigningKey StakePoolKey -> SomeWitness
AStakePoolSigningKey
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisKey
AsGenesisKey)
                          SigningKey GenesisKey -> SomeWitness
AGenesisSigningKey
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisExtendedKey
AsGenesisExtendedKey)
                          SigningKey GenesisExtendedKey -> SomeWitness
AGenesisExtendedSigningKey
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisDelegateKey
AsGenesisDelegateKey)
                          SigningKey GenesisDelegateKey -> SomeWitness
AGenesisDelegateSigningKey
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisDelegateExtendedKey
AsGenesisDelegateExtendedKey)
                          SigningKey GenesisDelegateExtendedKey -> SomeWitness
AGenesisDelegateExtendedSigningKey
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisUTxOKey
AsGenesisUTxOKey)
                          SigningKey GenesisUTxOKey -> SomeWitness
AGenesisUTxOSigningKey
      ]

    bech32FileTypes :: [FromSomeType SerialiseAsBech32 SomeWitness]
bech32FileTypes =
      [ forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType PaymentKey
AsPaymentKey)
                          SigningKey PaymentKey -> SomeWitness
APaymentSigningKey
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType PaymentExtendedKey
AsPaymentExtendedKey)
                          SigningKey PaymentExtendedKey -> SomeWitness
APaymentExtendedSigningKey
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakeKey
AsStakeKey)
                          SigningKey StakeKey -> SomeWitness
AStakeSigningKey
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakeExtendedKey
AsStakeExtendedKey)
                          SigningKey StakeExtendedKey -> SomeWitness
AStakeExtendedSigningKey
      , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakePoolKey
AsStakePoolKey)
                          SigningKey StakePoolKey -> SomeWitness
AStakePoolSigningKey
      ]

-- Required signers

data RequiredSignerError
  = RequiredSignerErrorFile (FileError InputDecodeError)
  | RequiredSignerErrorByronKey SigningKeyFile
  deriving Int -> RequiredSignerError -> ShowS
[RequiredSignerError] -> ShowS
RequiredSignerError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequiredSignerError] -> ShowS
$cshowList :: [RequiredSignerError] -> ShowS
show :: RequiredSignerError -> String
$cshow :: RequiredSignerError -> String
showsPrec :: Int -> RequiredSignerError -> ShowS
$cshowsPrec :: Int -> RequiredSignerError -> ShowS
Show

instance Error RequiredSignerError where
  displayError :: RequiredSignerError -> String
displayError (RequiredSignerErrorFile FileError InputDecodeError
e) = forall e. Error e => e -> String
displayError FileError InputDecodeError
e
  displayError (RequiredSignerErrorByronKey (SigningKeyFile String
byronSkeyfile)) =
    String
"Byron witnesses cannot be used for required signers: " forall a. Semigroup a => a -> a -> a
<> String
byronSkeyfile

readRequiredSigner :: RequiredSigner -> IO (Either RequiredSignerError (Hash PaymentKey))
readRequiredSigner :: RequiredSigner -> IO (Either RequiredSignerError (Hash PaymentKey))
readRequiredSigner (RequiredSignerHash Hash PaymentKey
h) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Hash PaymentKey
h
readRequiredSigner (RequiredSignerSkeyFile skFile :: SigningKeyFile
skFile@(SigningKeyFile String
skFp)) = do
  Either RequiredSignerError SomeWitness
eKeyWit <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first FileError InputDecodeError -> RequiredSignerError
RequiredSignerErrorFile forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b.
[FromSomeType SerialiseAsBech32 b]
-> [FromSomeType HasTextEnvelope b]
-> String
-> IO (Either (FileError InputDecodeError) b)
readKeyFileAnyOf forall {a}. [a]
bech32FileTypes [FromSomeType HasTextEnvelope SomeWitness]
textEnvFileTypes String
skFp
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
    SomeWitness
keyWit <- Either RequiredSignerError SomeWitness
eKeyWit
    case SomeWitness -> ByronOrShelleyWitness
categoriseSomeWitness SomeWitness
keyWit of
      AByronWitness ShelleyBootstrapWitnessSigningKeyData
_ ->
        forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ SigningKeyFile -> RequiredSignerError
RequiredSignerErrorByronKey SigningKeyFile
skFile
      AShelleyKeyWitness ShelleyWitnessSigningKey
skey ->
        forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleySigningKey -> Hash PaymentKey
getHash forall a b. (a -> b) -> a -> b
$ ShelleyWitnessSigningKey -> ShelleySigningKey
toShelleySigningKey ShelleyWitnessSigningKey
skey
 where
   textEnvFileTypes :: [FromSomeType HasTextEnvelope SomeWitness]
textEnvFileTypes =
     [ forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType PaymentKey
AsPaymentKey) SigningKey PaymentKey -> SomeWitness
APaymentSigningKey
     , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType PaymentExtendedKey
AsPaymentExtendedKey)
                          SigningKey PaymentExtendedKey -> SomeWitness
APaymentExtendedSigningKey
     ]
   bech32FileTypes :: [a]
bech32FileTypes = []

   getHash :: ShelleySigningKey -> Hash PaymentKey
   getHash :: ShelleySigningKey -> Hash PaymentKey
getHash (ShelleyExtendedSigningKey XPrv
sk) =
     let extSKey :: SigningKey PaymentExtendedKey
extSKey = XPrv -> SigningKey PaymentExtendedKey
PaymentExtendedSigningKey XPrv
sk
         payVKey :: VerificationKey PaymentKey
payVKey = forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey forall a b. (a -> b) -> a -> b
$ forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey PaymentExtendedKey
extSKey
     in forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey PaymentKey
payVKey
   getHash (ShelleyNormalSigningKey SignKeyDSIGN StandardCrypto
sk) =
     forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN StandardCrypto -> SigningKey PaymentKey
PaymentSigningKey SignKeyDSIGN StandardCrypto
sk

-- Misc

readFileInAnyCardanoEra
  :: ( HasTextEnvelope (thing ByronEra)
     , HasTextEnvelope (thing ShelleyEra)
     , HasTextEnvelope (thing AllegraEra)
     , HasTextEnvelope (thing MaryEra)
     , HasTextEnvelope (thing AlonzoEra)
     , HasTextEnvelope (thing BabbageEra)
     )
  => (forall era. AsType era -> AsType (thing era))
  -> FileOrPipe
  -> IO (Either (FileError TextEnvelopeError) (InAnyCardanoEra thing))
readFileInAnyCardanoEra :: forall (thing :: * -> *).
(HasTextEnvelope (thing ByronEra),
 HasTextEnvelope (thing ShelleyEra),
 HasTextEnvelope (thing AllegraEra),
 HasTextEnvelope (thing MaryEra), HasTextEnvelope (thing AlonzoEra),
 HasTextEnvelope (thing BabbageEra)) =>
(forall era. AsType era -> AsType (thing era))
-> FileOrPipe
-> IO
     (Either (FileError TextEnvelopeError) (InAnyCardanoEra thing))
readFileInAnyCardanoEra forall era. AsType era -> AsType (thing era)
asThing =
 forall b.
[FromSomeType HasTextEnvelope b]
-> FileOrPipe -> IO (Either (FileError TextEnvelopeError) b)
readFileOrPipeTextEnvelopeAnyOf
   [ forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall era. AsType era -> AsType (thing era)
asThing AsType ByronEra
AsByronEra)   (forall era (thing :: * -> *).
IsCardanoEra era =>
CardanoEra era -> thing era -> InAnyCardanoEra thing
InAnyCardanoEra CardanoEra ByronEra
ByronEra)
   , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall era. AsType era -> AsType (thing era)
asThing AsType ShelleyEra
AsShelleyEra) (forall era (thing :: * -> *).
IsCardanoEra era =>
CardanoEra era -> thing era -> InAnyCardanoEra thing
InAnyCardanoEra CardanoEra ShelleyEra
ShelleyEra)
   , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall era. AsType era -> AsType (thing era)
asThing AsType AllegraEra
AsAllegraEra) (forall era (thing :: * -> *).
IsCardanoEra era =>
CardanoEra era -> thing era -> InAnyCardanoEra thing
InAnyCardanoEra CardanoEra AllegraEra
AllegraEra)
   , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall era. AsType era -> AsType (thing era)
asThing AsType MaryEra
AsMaryEra)    (forall era (thing :: * -> *).
IsCardanoEra era =>
CardanoEra era -> thing era -> InAnyCardanoEra thing
InAnyCardanoEra CardanoEra MaryEra
MaryEra)
   , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall era. AsType era -> AsType (thing era)
asThing AsType AlonzoEra
AsAlonzoEra)  (forall era (thing :: * -> *).
IsCardanoEra era =>
CardanoEra era -> thing era -> InAnyCardanoEra thing
InAnyCardanoEra CardanoEra AlonzoEra
AlonzoEra)
   , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall era. AsType era -> AsType (thing era)
asThing AsType BabbageEra
AsBabbageEra) (forall era (thing :: * -> *).
IsCardanoEra era =>
CardanoEra era -> thing era -> InAnyCardanoEra thing
InAnyCardanoEra CardanoEra BabbageEra
BabbageEra)
   ]

-- | We need a type for handling files that may be actually be things like
-- pipes. Currently the CLI makes no guarantee that a "file" will only
-- be read once. This is a problem for a user who who expects to be able to pass
-- a pipe. To handle this, we have a type for representing either files or pipes
-- where the contents will be saved in memory if what we're reading is a pipe (so
-- it can be re-read later). Unfortunately this means we can't easily stream data
-- from pipes, but at present that's not an issue.
data FileOrPipe = FileOrPipe FilePath (IORef (Maybe LBS.ByteString))


instance Show FileOrPipe where
    show :: FileOrPipe -> String
show (FileOrPipe String
fp IORef (Maybe ByteString)
_) = forall a. Show a => a -> String
show String
fp

fileOrPipe :: FilePath -> IO FileOrPipe
fileOrPipe :: String -> IO FileOrPipe
fileOrPipe String
fp = String -> IORef (Maybe ByteString) -> FileOrPipe
FileOrPipe String
fp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing

-- | Get the path backing a FileOrPipe. This should primarily be used when
-- generating error messages for a user. A user should not call directly
-- call a function like readFile on the result of this function
fileOrPipePath :: FileOrPipe -> FilePath
fileOrPipePath :: FileOrPipe -> String
fileOrPipePath (FileOrPipe String
fp IORef (Maybe ByteString)
_) = String
fp

fileOrPipeCache :: FileOrPipe -> IO (Maybe LBS.ByteString)
fileOrPipeCache :: FileOrPipe -> IO (Maybe ByteString)
fileOrPipeCache (FileOrPipe String
_ IORef (Maybe ByteString)
c) = forall a. IORef a -> IO a
readIORef IORef (Maybe ByteString)
c

-- | Get the contents of a file or pipe. This function reads the entire
-- contents of the file or pipe, and is blocking.
readFileOrPipe :: FileOrPipe -> IO LBS.ByteString
readFileOrPipe :: FileOrPipe -> IO ByteString
readFileOrPipe (FileOrPipe String
fp IORef (Maybe ByteString)
cacheRef) = do
    Maybe ByteString
cached <- forall a. IORef a -> IO a
readIORef IORef (Maybe ByteString)
cacheRef
    case Maybe ByteString
cached of
      Just ByteString
dat -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
dat
      Maybe ByteString
Nothing -> forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
        (String -> IOMode -> IO Handle
openFileBlocking String
fp IOMode
ReadMode)
        Handle -> IO ()
hClose
        (\Handle
handle -> do
          -- An arbitrary block size.
          let blockSize :: Int
blockSize = Int
4096
          let go :: Builder -> IO Builder
go Builder
acc = do
                ByteString
next <- Handle -> Int -> IO ByteString
BS.hGet Handle
handle Int
blockSize
                if ByteString -> Bool
BS.null ByteString
next
                then forall (f :: * -> *) a. Applicative f => a -> f a
pure Builder
acc
                else Builder -> IO Builder
go (Builder
acc forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Builder.byteString ByteString
next)
          Builder
contents <- Builder -> IO Builder
go forall a. Monoid a => a
mempty
          let dat :: ByteString
dat = Builder -> ByteString
Builder.toLazyByteString Builder
contents
          -- If our file is not seekable, it's likely a pipe, so we need to
          -- save the result for subsequent calls
          Bool
seekable <- Handle -> IO Bool
hIsSeekable Handle
handle
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
seekable (forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe ByteString)
cacheRef (forall a. a -> Maybe a
Just ByteString
dat))
          forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
dat)

readFileOrPipeTextEnvelopeAnyOf
  :: [FromSomeType HasTextEnvelope b]
  -> FileOrPipe
  -> IO (Either (FileError TextEnvelopeError) b)
readFileOrPipeTextEnvelopeAnyOf :: forall b.
[FromSomeType HasTextEnvelope b]
-> FileOrPipe -> IO (Either (FileError TextEnvelopeError) b)
readFileOrPipeTextEnvelopeAnyOf [FromSomeType HasTextEnvelope b]
types FileOrPipe
file = do
    let path :: String
path = FileOrPipe -> String
fileOrPipePath FileOrPipe
file
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
      ByteString
content <- forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (forall e. String -> IOException -> FileError e
FileIOError String
path) forall a b. (a -> b) -> a -> b
$ FileOrPipe -> IO ByteString
readFileOrPipe FileOrPipe
file
      forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (forall e. String -> e -> FileError e
FileError String
path) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall a b. (a -> b) -> a -> b
$ do
        TextEnvelope
te <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> TextEnvelopeError
TextEnvelopeAesonDecodeError forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode' ByteString
content
        forall b.
[FromSomeType HasTextEnvelope b]
-> TextEnvelope -> Either TextEnvelopeError b
deserialiseFromTextEnvelopeAnyOf [FromSomeType HasTextEnvelope b]
types TextEnvelope
te

readFileOrPipeTextEnvelopeCddlAnyOf
  :: [FromSomeTypeCDDL TextEnvelopeCddl b]
  -> FileOrPipe
  -> IO (Either (FileError TextEnvelopeCddlError) b)
readFileOrPipeTextEnvelopeCddlAnyOf :: forall b.
[FromSomeTypeCDDL TextEnvelopeCddl b]
-> FileOrPipe -> IO (Either (FileError TextEnvelopeCddlError) b)
readFileOrPipeTextEnvelopeCddlAnyOf [FromSomeTypeCDDL TextEnvelopeCddl b]
types FileOrPipe
file = do
  let path :: String
path = FileOrPipe -> String
fileOrPipePath FileOrPipe
file
  forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
    TextEnvelopeCddl
te <- forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$ FileOrPipe
-> IO (Either (FileError TextEnvelopeCddlError) TextEnvelopeCddl)
readTextEnvelopeCddlFromFileOrPipe FileOrPipe
file
    forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (forall e. String -> e -> FileError e
FileError String
path) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall a b. (a -> b) -> a -> b
$ do
      forall b.
[FromSomeTypeCDDL TextEnvelopeCddl b]
-> TextEnvelopeCddl -> Either TextEnvelopeCddlError b
deserialiseFromTextEnvelopeCddlAnyOf [FromSomeTypeCDDL TextEnvelopeCddl b]
types TextEnvelopeCddl
te

readTextEnvelopeCddlFromFileOrPipe
  :: FileOrPipe
  -> IO (Either (FileError TextEnvelopeCddlError) TextEnvelopeCddl)
readTextEnvelopeCddlFromFileOrPipe :: FileOrPipe
-> IO (Either (FileError TextEnvelopeCddlError) TextEnvelopeCddl)
readTextEnvelopeCddlFromFileOrPipe FileOrPipe
file = do
  let path :: String
path = FileOrPipe -> String
fileOrPipePath FileOrPipe
file
  forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
    ByteString
bs <- forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (forall e. String -> IOException -> FileError e
FileIOError String
path) forall a b. (a -> b) -> a -> b
$
            FileOrPipe -> IO ByteString
readFileOrPipe FileOrPipe
file
    forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (forall e. String -> e -> FileError e
FileError String
path forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> TextEnvelopeCddlError
TextEnvelopeCddlAesonDecodeError String
path)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode' ByteString
bs