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

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

    -- * Script
  , ScriptWitnessError (..)
  , renderScriptWitnessError
  , readScriptDataOrFile
  , readScriptWitness
  , readScriptWitnessFiles
  , readScriptWitnessFilesTuple
  , ScriptDecodeError (..)
  , deserialiseScriptInAnyLang
  , readFileScriptInAnyLang
  , readFileSimpleScript
  , AnyPlutusScript (..)
  , PlutusScriptDecodeError (..)
  , readFilePlutusScript

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

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

    -- * Tx witnesses
  , ReadWitnessSigningDataError (..)
  , renderReadWitnessSigningDataError
  , SomeSigningWitness (..)
  , ByronOrShelleyWitness (..)
  , ShelleyBootstrapWitnessSigningKeyData (..)
  , CddlWitnessError (..)
  , readFileTxKeyWitness
  , readWitnessSigningData
  , txWitnessTextEnvelopeTypes -- For testing purposes

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

    -- * Governance related
  , ConstitutionError (..)
  , ProposalError (..)
  , VoteError (..)
  , readTxGovernanceActions
  , constitutionHashSourceToHash
  , readProposal
  , CostModelsError (..)
  , readCostModels

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

    -- * Stake credentials
  , getStakeCredentialFromVerifier
  , getStakeCredentialFromIdentifier
  , getStakeAddressFromVerifier
  , readVotingProceduresFiles
  , readSingleVote

    -- * DRep credentials
  , getDRepCredentialFromVerKeyHashOrFile
  , ReadSafeHashError (..)
  , readHexAsSafeHash
  , readSafeHash
  , scriptHashReader

    -- * Update proposals
  , readTxUpdateProposal

    -- * Vote related
  , readVoteDelegationTarget
  , readVerificationKeyOrHashOrFileOrScript
  , readVerificationKeySource

    -- * Genesis hashes
  , readShelleyOnwardsGenesisAndHash
  )
where

import           Cardano.Api as Api
import qualified Cardano.Api.Ledger as L
import           Cardano.Api.Shelley as Api

import qualified Cardano.Binary as CBOR
import           Cardano.CLI.Types.Common
import           Cardano.CLI.Types.Errors.DelegationError
import           Cardano.CLI.Types.Errors.PlutusScriptDecodeError
import           Cardano.CLI.Types.Errors.ScriptDataError
import           Cardano.CLI.Types.Errors.ScriptDecodeError
import           Cardano.CLI.Types.Errors.StakeCredentialError
import           Cardano.CLI.Types.Governance
import           Cardano.CLI.Types.Key
import qualified Cardano.Crypto.Hash as Crypto

import           Prelude

import           Control.Exception (bracket, displayException)
import           Control.Monad (forM, unless, when)
import qualified Data.Aeson as Aeson
import           Data.Bifunctor
import           Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Builder as Builder
import qualified Data.ByteString.Lazy.Char8 as LBS
import           Data.Function ((&))
import           Data.IORef (IORef, newIORef, readIORef, writeIORef)
import qualified Data.List as List
import           Data.Proxy (Proxy (..))
import           Data.String
import           Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Text.Encoding.Error as Text
import           Data.Word
import           GHC.IO.Handle (hClose, hIsSeekable)
import           GHC.IO.Handle.FD (openFileBlocking)
import qualified Options.Applicative as Opt
import           System.IO (IOMode (ReadMode))

-- Metadata

data MetadataError
  = MetadataErrorFile (FileError ())
  | MetadataErrorJsonParseError !FilePath !String
  | MetadataErrorConversionError !FilePath !TxMetadataJsonError
  | MetadataErrorValidationError !FilePath ![(Word64, TxMetadataRangeError)]
  | MetadataErrorDecodeError !FilePath !CBOR.DecoderError
  deriving Int -> MetadataError -> ShowS
[MetadataError] -> ShowS
MetadataError -> String
(Int -> MetadataError -> ShowS)
-> (MetadataError -> String)
-> ([MetadataError] -> ShowS)
-> Show MetadataError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MetadataError -> ShowS
showsPrec :: Int -> MetadataError -> ShowS
$cshow :: MetadataError -> String
show :: MetadataError -> String
$cshowList :: [MetadataError] -> ShowS
showList :: [MetadataError] -> ShowS
Show

renderMetadataError :: MetadataError -> Doc ann
renderMetadataError :: forall ann. MetadataError -> Doc ann
renderMetadataError = \case
  MetadataErrorFile FileError ()
fileErr ->
    FileError () -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError () -> Doc ann
prettyError FileError ()
fileErr
  MetadataErrorJsonParseError String
fp String
jsonErr ->
    Doc ann
"Invalid JSON format in file: "
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow String
fp
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"\nJSON parse error: "
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
jsonErr
  MetadataErrorConversionError String
fp TxMetadataJsonError
metadataErr ->
    Doc ann
"Error reading metadata at: "
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow String
fp
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"\n"
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> TxMetadataJsonError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. TxMetadataJsonError -> Doc ann
prettyError TxMetadataJsonError
metadataErr
  MetadataErrorValidationError String
fp [(Word64, TxMetadataRangeError)]
errs ->
    [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
      [ Doc ann
"Error validating transaction metadata at: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
fp Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"\n"
      , [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$
          Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
List.intersperse
            Doc ann
"\n"
            [ Doc ann
"key " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Word64 -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow Word64
k Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
":" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> TxMetadataRangeError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. TxMetadataRangeError -> Doc ann
prettyError TxMetadataRangeError
valErr
            | (Word64
k, TxMetadataRangeError
valErr) <- [(Word64, TxMetadataRangeError)]
errs
            ]
      ]
  MetadataErrorDecodeError String
fp DecoderError
metadataErr ->
    Doc ann
"Error decoding CBOR metadata at: "
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow String
fp
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" Error: "
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> DecoderError -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow DecoderError
metadataErr

readTxMetadata
  :: ShelleyBasedEra era
  -> TxMetadataJsonSchema
  -> [MetadataFile]
  -> IO (Either MetadataError (TxMetadataInEra era))
readTxMetadata :: forall era.
ShelleyBasedEra era
-> TxMetadataJsonSchema
-> [MetadataFile]
-> IO (Either MetadataError (TxMetadataInEra era))
readTxMetadata ShelleyBasedEra era
_ TxMetadataJsonSchema
_ [] = Either MetadataError (TxMetadataInEra era)
-> IO (Either MetadataError (TxMetadataInEra era))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MetadataError (TxMetadataInEra era)
 -> IO (Either MetadataError (TxMetadataInEra era)))
-> Either MetadataError (TxMetadataInEra era)
-> IO (Either MetadataError (TxMetadataInEra era))
forall a b. (a -> b) -> a -> b
$ TxMetadataInEra era -> Either MetadataError (TxMetadataInEra era)
forall a b. b -> Either a b
Right TxMetadataInEra era
forall era. TxMetadataInEra era
TxMetadataNone
readTxMetadata ShelleyBasedEra era
era TxMetadataJsonSchema
schema [MetadataFile]
files = ExceptT MetadataError IO (TxMetadataInEra era)
-> IO (Either MetadataError (TxMetadataInEra era))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT MetadataError IO (TxMetadataInEra era)
 -> IO (Either MetadataError (TxMetadataInEra era)))
-> ExceptT MetadataError IO (TxMetadataInEra era)
-> IO (Either MetadataError (TxMetadataInEra era))
forall a b. (a -> b) -> a -> b
$ do
  [TxMetadata]
metadata <- (MetadataFile -> ExceptT MetadataError IO TxMetadata)
-> [MetadataFile] -> ExceptT MetadataError IO [TxMetadata]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (TxMetadataJsonSchema
-> MetadataFile -> ExceptT MetadataError IO TxMetadata
readFileTxMetadata TxMetadataJsonSchema
schema) [MetadataFile]
files
  TxMetadataInEra era
-> ExceptT MetadataError IO (TxMetadataInEra era)
forall a. a -> ExceptT MetadataError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxMetadataInEra era
 -> ExceptT MetadataError IO (TxMetadataInEra era))
-> TxMetadataInEra era
-> ExceptT MetadataError IO (TxMetadataInEra era)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era -> TxMetadata -> TxMetadataInEra era
forall era.
ShelleyBasedEra era -> TxMetadata -> TxMetadataInEra era
TxMetadataInEra ShelleyBasedEra era
era (TxMetadata -> TxMetadataInEra era)
-> TxMetadata -> TxMetadataInEra era
forall a b. (a -> b) -> a -> b
$ [TxMetadata] -> TxMetadata
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 File () 'In
fp) = do
  ByteString
bs <-
    (IOException -> MetadataError)
-> IO ByteString -> ExceptT MetadataError IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> MetadataError
MetadataErrorFile (FileError () -> MetadataError)
-> (IOException -> FileError ()) -> IOException -> MetadataError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError (File () 'In -> String
forall content (direction :: FileDirection).
File content direction -> String
unFile File () 'In
fp)) (IO ByteString -> ExceptT MetadataError IO ByteString)
-> IO ByteString -> ExceptT MetadataError IO ByteString
forall a b. (a -> b) -> a -> b
$
      String -> IO ByteString
LBS.readFile (File () 'In -> String
forall content (direction :: FileDirection).
File content direction -> String
unFile File () 'In
fp)
  Value
v <-
    (String -> MetadataError)
-> ExceptT String IO Value -> ExceptT MetadataError IO Value
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> String -> MetadataError
MetadataErrorJsonParseError (File () 'In -> String
forall content (direction :: FileDirection).
File content direction -> String
unFile File () 'In
fp)) (ExceptT String IO Value -> ExceptT MetadataError IO Value)
-> ExceptT String IO Value -> ExceptT MetadataError IO Value
forall a b. (a -> b) -> a -> b
$
      Either String Value -> ExceptT String IO Value
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either String Value -> ExceptT String IO Value)
-> Either String Value -> ExceptT String IO Value
forall a b. (a -> b) -> a -> b
$
        ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode' ByteString
bs
  TxMetadata
txMetadata' <-
    (TxMetadataJsonError -> MetadataError)
-> ExceptT TxMetadataJsonError IO TxMetadata
-> ExceptT MetadataError IO TxMetadata
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> TxMetadataJsonError -> MetadataError
MetadataErrorConversionError (File () 'In -> String
forall content (direction :: FileDirection).
File content direction -> String
unFile File () 'In
fp))
      (ExceptT TxMetadataJsonError IO TxMetadata
 -> ExceptT MetadataError IO TxMetadata)
-> (Either TxMetadataJsonError TxMetadata
    -> ExceptT TxMetadataJsonError IO TxMetadata)
-> Either TxMetadataJsonError TxMetadata
-> ExceptT MetadataError IO TxMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either TxMetadataJsonError TxMetadata
-> ExceptT TxMetadataJsonError IO TxMetadata
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
      (Either TxMetadataJsonError TxMetadata
 -> ExceptT MetadataError IO TxMetadata)
-> Either TxMetadataJsonError TxMetadata
-> ExceptT MetadataError IO TxMetadata
forall a b. (a -> b) -> a -> b
$ TxMetadataJsonSchema
-> Value -> Either TxMetadataJsonError TxMetadata
metadataFromJson TxMetadataJsonSchema
mapping Value
v
  ([(Word64, TxMetadataRangeError)] -> MetadataError)
-> ExceptT [(Word64, TxMetadataRangeError)] IO TxMetadata
-> ExceptT MetadataError IO TxMetadata
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> [(Word64, TxMetadataRangeError)] -> MetadataError
MetadataErrorValidationError (File () 'In -> String
forall content (direction :: FileDirection).
File content direction -> String
unFile File () 'In
fp))
    (ExceptT [(Word64, TxMetadataRangeError)] IO TxMetadata
 -> ExceptT MetadataError IO TxMetadata)
-> (Either [(Word64, TxMetadataRangeError)] TxMetadata
    -> ExceptT [(Word64, TxMetadataRangeError)] IO TxMetadata)
-> Either [(Word64, TxMetadataRangeError)] TxMetadata
-> ExceptT MetadataError IO TxMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either [(Word64, TxMetadataRangeError)] TxMetadata
-> ExceptT [(Word64, TxMetadataRangeError)] IO TxMetadata
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
    (Either [(Word64, TxMetadataRangeError)] TxMetadata
 -> ExceptT MetadataError IO TxMetadata)
-> Either [(Word64, TxMetadataRangeError)] TxMetadata
-> ExceptT MetadataError IO TxMetadata
forall a b. (a -> b) -> a -> b
$ do
      TxMetadata -> Either [(Word64, TxMetadataRangeError)] ()
validateTxMetadata TxMetadata
txMetadata'
      TxMetadata -> Either [(Word64, TxMetadataRangeError)] TxMetadata
forall a. a -> Either [(Word64, TxMetadataRangeError)] a
forall (m :: * -> *) a. Monad m => a -> m a
return TxMetadata
txMetadata'
readFileTxMetadata TxMetadataJsonSchema
_ (MetadataFileCBOR File () 'In
fp) = do
  ByteString
bs <-
    (IOException -> MetadataError)
-> IO ByteString -> ExceptT MetadataError IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> MetadataError
MetadataErrorFile (FileError () -> MetadataError)
-> (IOException -> FileError ()) -> IOException -> MetadataError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError (File () 'In -> String
forall content (direction :: FileDirection).
File content direction -> String
unFile File () 'In
fp)) (IO ByteString -> ExceptT MetadataError IO ByteString)
-> IO ByteString -> ExceptT MetadataError IO ByteString
forall a b. (a -> b) -> a -> b
$
      String -> IO ByteString
BS.readFile (File () 'In -> String
forall content (direction :: FileDirection).
File content direction -> String
unFile File () 'In
fp)
  TxMetadata
txMetadata' <-
    (DecoderError -> MetadataError)
-> ExceptT DecoderError IO TxMetadata
-> ExceptT MetadataError IO TxMetadata
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> DecoderError -> MetadataError
MetadataErrorDecodeError (File () 'In -> String
forall content (direction :: FileDirection).
File content direction -> String
unFile File () 'In
fp))
      (ExceptT DecoderError IO TxMetadata
 -> ExceptT MetadataError IO TxMetadata)
-> (Either DecoderError TxMetadata
    -> ExceptT DecoderError IO TxMetadata)
-> Either DecoderError TxMetadata
-> ExceptT MetadataError IO TxMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either DecoderError TxMetadata
-> ExceptT DecoderError IO TxMetadata
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
      (Either DecoderError TxMetadata
 -> ExceptT MetadataError IO TxMetadata)
-> Either DecoderError TxMetadata
-> ExceptT MetadataError IO TxMetadata
forall a b. (a -> b) -> a -> b
$ AsType TxMetadata -> ByteString -> Either DecoderError TxMetadata
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
deserialiseFromCBOR AsType TxMetadata
AsTxMetadata ByteString
bs
  ([(Word64, TxMetadataRangeError)] -> MetadataError)
-> ExceptT [(Word64, TxMetadataRangeError)] IO TxMetadata
-> ExceptT MetadataError IO TxMetadata
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> [(Word64, TxMetadataRangeError)] -> MetadataError
MetadataErrorValidationError (File () 'In -> String
forall content (direction :: FileDirection).
File content direction -> String
unFile File () 'In
fp))
    (ExceptT [(Word64, TxMetadataRangeError)] IO TxMetadata
 -> ExceptT MetadataError IO TxMetadata)
-> (Either [(Word64, TxMetadataRangeError)] TxMetadata
    -> ExceptT [(Word64, TxMetadataRangeError)] IO TxMetadata)
-> Either [(Word64, TxMetadataRangeError)] TxMetadata
-> ExceptT MetadataError IO TxMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either [(Word64, TxMetadataRangeError)] TxMetadata
-> ExceptT [(Word64, TxMetadataRangeError)] IO TxMetadata
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither
    (Either [(Word64, TxMetadataRangeError)] TxMetadata
 -> ExceptT MetadataError IO TxMetadata)
-> Either [(Word64, TxMetadataRangeError)] TxMetadata
-> ExceptT MetadataError IO TxMetadata
forall a b. (a -> b) -> a -> b
$ do
      TxMetadata -> Either [(Word64, TxMetadataRangeError)] ()
validateTxMetadata TxMetadata
txMetadata'
      TxMetadata -> Either [(Word64, TxMetadataRangeError)] TxMetadata
forall a. a -> Either [(Word64, TxMetadataRangeError)] a
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 !AnyShelleyBasedEra
  | ScriptWitnessErrorScriptData ScriptDataError
  deriving Int -> ScriptWitnessError -> ShowS
[ScriptWitnessError] -> ShowS
ScriptWitnessError -> String
(Int -> ScriptWitnessError -> ShowS)
-> (ScriptWitnessError -> String)
-> ([ScriptWitnessError] -> ShowS)
-> Show ScriptWitnessError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScriptWitnessError -> ShowS
showsPrec :: Int -> ScriptWitnessError -> ShowS
$cshow :: ScriptWitnessError -> String
show :: ScriptWitnessError -> String
$cshowList :: [ScriptWitnessError] -> ShowS
showList :: [ScriptWitnessError] -> ShowS
Show

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

readScriptWitnessFiles
  :: ShelleyBasedEra era
  -> [(a, Maybe (ScriptWitnessFiles ctx))]
  -> ExceptT ScriptWitnessError IO [(a, Maybe (ScriptWitness ctx era))]
readScriptWitnessFiles :: forall era a ctx.
ShelleyBasedEra era
-> [(a, Maybe (ScriptWitnessFiles ctx))]
-> ExceptT
     ScriptWitnessError IO [(a, Maybe (ScriptWitness ctx era))]
readScriptWitnessFiles ShelleyBasedEra era
era = ((a, Maybe (ScriptWitnessFiles ctx))
 -> ExceptT
      ScriptWitnessError IO (a, Maybe (ScriptWitness ctx era)))
-> [(a, Maybe (ScriptWitnessFiles ctx))]
-> ExceptT
     ScriptWitnessError IO [(a, Maybe (ScriptWitness ctx era))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 <- ShelleyBasedEra era
-> ScriptWitnessFiles ctx
-> ExceptT ScriptWitnessError IO (ScriptWitness ctx era)
forall era witctx.
ShelleyBasedEra era
-> ScriptWitnessFiles witctx
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
readScriptWitness ShelleyBasedEra era
era ScriptWitnessFiles ctx
switFile
    (a, Maybe (ScriptWitness ctx era))
-> ExceptT ScriptWitnessError IO (a, Maybe (ScriptWitness ctx era))
forall a. a -> ExceptT ScriptWitnessError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
tIn, ScriptWitness ctx era -> Maybe (ScriptWitness ctx era)
forall a. a -> Maybe a
Just ScriptWitness ctx era
sWit)
  readSwitFile (a
tIn, Maybe (ScriptWitnessFiles ctx)
Nothing) = (a, Maybe (ScriptWitness ctx era))
-> ExceptT ScriptWitnessError IO (a, Maybe (ScriptWitness ctx era))
forall a. a -> ExceptT ScriptWitnessError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
tIn, Maybe (ScriptWitness ctx era)
forall a. Maybe a
Nothing)

readScriptWitnessFilesTuple
  :: ShelleyBasedEra era
  -> [(a, b, Maybe (ScriptWitnessFiles ctx))]
  -> ExceptT ScriptWitnessError IO [(a, b, Maybe (ScriptWitness ctx era))]
readScriptWitnessFilesTuple :: forall era a b ctx.
ShelleyBasedEra era
-> [(a, b, Maybe (ScriptWitnessFiles ctx))]
-> ExceptT
     ScriptWitnessError IO [(a, b, Maybe (ScriptWitness ctx era))]
readScriptWitnessFilesTuple ShelleyBasedEra era
era = ((a, b, Maybe (ScriptWitnessFiles ctx))
 -> ExceptT
      ScriptWitnessError IO (a, b, Maybe (ScriptWitness ctx era)))
-> [(a, b, Maybe (ScriptWitnessFiles ctx))]
-> ExceptT
     ScriptWitnessError IO [(a, b, Maybe (ScriptWitness ctx era))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 <- ShelleyBasedEra era
-> ScriptWitnessFiles ctx
-> ExceptT ScriptWitnessError IO (ScriptWitness ctx era)
forall era witctx.
ShelleyBasedEra era
-> ScriptWitnessFiles witctx
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
readScriptWitness ShelleyBasedEra era
era ScriptWitnessFiles ctx
switFile
    (a, b, Maybe (ScriptWitness ctx era))
-> ExceptT
     ScriptWitnessError IO (a, b, Maybe (ScriptWitness ctx era))
forall a. a -> ExceptT ScriptWitnessError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
tIn, b
b, ScriptWitness ctx era -> Maybe (ScriptWitness ctx era)
forall a. a -> Maybe a
Just ScriptWitness ctx era
sWit)
  readSwitFile (a
tIn, b
b, Maybe (ScriptWitnessFiles ctx)
Nothing) = (a, b, Maybe (ScriptWitness ctx era))
-> ExceptT
     ScriptWitnessError IO (a, b, Maybe (ScriptWitness ctx era))
forall a. a -> ExceptT ScriptWitnessError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
tIn, b
b, Maybe (ScriptWitness ctx era)
forall a. Maybe a
Nothing)

readScriptWitness
  :: ShelleyBasedEra era
  -> ScriptWitnessFiles witctx
  -> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
readScriptWitness :: forall era witctx.
ShelleyBasedEra era
-> ScriptWitnessFiles witctx
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
readScriptWitness ShelleyBasedEra era
era (SimpleScriptWitnessFile (File String
scriptFile)) = do
  script :: ScriptInAnyLang
script@(ScriptInAnyLang ScriptLanguage lang
lang Script lang
_) <-
    (FileError ScriptDecodeError -> ScriptWitnessError)
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
-> ExceptT ScriptWitnessError IO ScriptInAnyLang
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError ScriptDecodeError -> ScriptWitnessError
ScriptWitnessErrorFile (ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
 -> ExceptT ScriptWitnessError IO ScriptInAnyLang)
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
-> ExceptT ScriptWitnessError IO ScriptInAnyLang
forall a b. (a -> b) -> a -> b
$
      String -> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadIOTransError (FileError ScriptDecodeError) t m =>
String -> t m ScriptInAnyLang
readFileScriptInAnyLang String
scriptFile
  ScriptInEra ScriptLanguageInEra lang era
langInEra Script lang
script' <- ShelleyBasedEra era
-> ScriptInAnyLang
-> ExceptT ScriptWitnessError IO (ScriptInEra era)
forall era.
ShelleyBasedEra era
-> ScriptInAnyLang
-> ExceptT ScriptWitnessError IO (ScriptInEra era)
validateScriptSupportedInEra ShelleyBasedEra era
era ScriptInAnyLang
script
  case Script lang
script' of
    SimpleScript SimpleScript
sscript ->
      ScriptWitness witctx era
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall a. a -> ExceptT ScriptWitnessError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptWitness witctx era
 -> ExceptT ScriptWitnessError IO (ScriptWitness witctx era))
-> (SimpleScriptOrReferenceInput SimpleScript'
    -> ScriptWitness witctx era)
-> SimpleScriptOrReferenceInput SimpleScript'
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptLanguageInEra SimpleScript' era
-> SimpleScriptOrReferenceInput SimpleScript'
-> ScriptWitness witctx era
forall era witctx.
ScriptLanguageInEra SimpleScript' era
-> SimpleScriptOrReferenceInput SimpleScript'
-> ScriptWitness witctx era
SimpleScriptWitness ScriptLanguageInEra lang era
ScriptLanguageInEra SimpleScript' era
langInEra (SimpleScriptOrReferenceInput SimpleScript'
 -> ExceptT ScriptWitnessError IO (ScriptWitness witctx era))
-> SimpleScriptOrReferenceInput SimpleScript'
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall a b. (a -> b) -> a -> b
$ SimpleScript -> SimpleScriptOrReferenceInput SimpleScript'
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{} ->
      ScriptWitnessError
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ScriptWitnessError
 -> ExceptT ScriptWitnessError IO (ScriptWitness witctx era))
-> ScriptWitnessError
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall a b. (a -> b) -> a -> b
$
        String -> AnyScriptLanguage -> ScriptWitnessError
ScriptWitnessErrorExpectedSimple
          String
scriptFile
          (ScriptLanguage lang -> AnyScriptLanguage
forall lang. ScriptLanguage lang -> AnyScriptLanguage
AnyScriptLanguage ScriptLanguage lang
lang)
readScriptWitness
  ShelleyBasedEra era
era
  ( PlutusScriptWitnessFiles
      (File String
scriptFile)
      ScriptDatumOrFile witctx
datumOrFile
      ScriptRedeemerOrFile
redeemerOrFile
      ExecutionUnits
execUnits
    ) = do
    script :: ScriptInAnyLang
script@(ScriptInAnyLang ScriptLanguage lang
lang Script lang
_) <-
      (FileError ScriptDecodeError -> ScriptWitnessError)
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
-> ExceptT ScriptWitnessError IO ScriptInAnyLang
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError ScriptDecodeError -> ScriptWitnessError
ScriptWitnessErrorFile (ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
 -> ExceptT ScriptWitnessError IO ScriptInAnyLang)
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
-> ExceptT ScriptWitnessError IO ScriptInAnyLang
forall a b. (a -> b) -> a -> b
$
        String -> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadIOTransError (FileError ScriptDecodeError) t m =>
String -> t m ScriptInAnyLang
readFileScriptInAnyLang String
scriptFile
    ScriptInEra ScriptLanguageInEra lang era
langInEra Script lang
script' <- ShelleyBasedEra era
-> ScriptInAnyLang
-> ExceptT ScriptWitnessError IO (ScriptInEra era)
forall era.
ShelleyBasedEra era
-> ScriptInAnyLang
-> ExceptT ScriptWitnessError IO (ScriptInEra era)
validateScriptSupportedInEra ShelleyBasedEra era
era ScriptInAnyLang
script
    case Script lang
script' of
      PlutusScript PlutusScriptVersion lang
version PlutusScript lang
pscript -> do
        ScriptDatum witctx
datum <-
          (ScriptDataError -> ScriptWitnessError)
-> ExceptT ScriptDataError IO (ScriptDatum witctx)
-> ExceptT ScriptWitnessError IO (ScriptDatum witctx)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ScriptDataError -> ScriptWitnessError
ScriptWitnessErrorScriptData (ExceptT ScriptDataError IO (ScriptDatum witctx)
 -> ExceptT ScriptWitnessError IO (ScriptDatum witctx))
-> ExceptT ScriptDataError IO (ScriptDatum witctx)
-> ExceptT ScriptWitnessError IO (ScriptDatum witctx)
forall a b. (a -> b) -> a -> b
$
            ScriptDatumOrFile witctx
-> ExceptT ScriptDataError IO (ScriptDatum witctx)
forall witctx.
ScriptDatumOrFile witctx
-> ExceptT ScriptDataError IO (ScriptDatum witctx)
readScriptDatumOrFile ScriptDatumOrFile witctx
datumOrFile
        ScriptRedeemer
redeemer <-
          (ScriptDataError -> ScriptWitnessError)
-> ExceptT ScriptDataError IO ScriptRedeemer
-> ExceptT ScriptWitnessError IO ScriptRedeemer
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ScriptDataError -> ScriptWitnessError
ScriptWitnessErrorScriptData (ExceptT ScriptDataError IO ScriptRedeemer
 -> ExceptT ScriptWitnessError IO ScriptRedeemer)
-> ExceptT ScriptDataError IO ScriptRedeemer
-> ExceptT ScriptWitnessError IO ScriptRedeemer
forall a b. (a -> b) -> a -> b
$
            ScriptRedeemerOrFile -> ExceptT ScriptDataError IO ScriptRedeemer
readScriptRedeemerOrFile ScriptRedeemerOrFile
redeemerOrFile
        ScriptWitness witctx era
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall a. a -> ExceptT ScriptWitnessError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptWitness witctx era
 -> ExceptT ScriptWitnessError IO (ScriptWitness witctx era))
-> ScriptWitness witctx era
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall a b. (a -> b) -> a -> b
$
          ScriptLanguageInEra lang era
-> PlutusScriptVersion lang
-> PlutusScriptOrReferenceInput lang
-> ScriptDatum witctx
-> ScriptRedeemer
-> ExecutionUnits
-> ScriptWitness witctx era
forall lang era witctx.
IsPlutusScriptLanguage lang =>
ScriptLanguageInEra lang era
-> PlutusScriptVersion lang
-> PlutusScriptOrReferenceInput lang
-> ScriptDatum witctx
-> ScriptRedeemer
-> ExecutionUnits
-> ScriptWitness witctx era
PlutusScriptWitness
            ScriptLanguageInEra lang era
langInEra
            PlutusScriptVersion lang
version
            (PlutusScript lang -> PlutusScriptOrReferenceInput lang
forall lang. PlutusScript lang -> PlutusScriptOrReferenceInput lang
PScript PlutusScript lang
pscript)
            ScriptDatum witctx
datum
            ScriptRedeemer
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{} ->
        ScriptWitnessError
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ScriptWitnessError
 -> ExceptT ScriptWitnessError IO (ScriptWitness witctx era))
-> ScriptWitnessError
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall a b. (a -> b) -> a -> b
$
          String -> AnyScriptLanguage -> ScriptWitnessError
ScriptWitnessErrorExpectedPlutus
            String
scriptFile
            (ScriptLanguage lang -> AnyScriptLanguage
forall lang. ScriptLanguage lang -> AnyScriptLanguage
AnyScriptLanguage ScriptLanguage lang
lang)
readScriptWitness
  ShelleyBasedEra era
era
  ( PlutusReferenceScriptWitnessFiles
      TxIn
refTxIn
      (AnyPlutusScriptVersion PlutusScriptVersion lang
version)
      ScriptDatumOrFile witctx
datumOrFile
      ScriptRedeemerOrFile
redeemerOrFile
      ExecutionUnits
execUnits
    ) = do
    (ShelleyToAlonzoEraConstraints era =>
 ShelleyToAlonzoEra era
 -> ExceptT ScriptWitnessError IO (ScriptWitness witctx era))
-> (BabbageEraOnwardsConstraints era =>
    BabbageEraOnwards era
    -> ExceptT ScriptWitnessError IO (ScriptWitness witctx era))
-> ShelleyBasedEra era
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall era a.
(ShelleyToAlonzoEraConstraints era => ShelleyToAlonzoEra era -> a)
-> (BabbageEraOnwardsConstraints era => BabbageEraOnwards era -> a)
-> ShelleyBasedEra era
-> a
caseShelleyToAlonzoOrBabbageEraOnwards
      ( ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
-> ShelleyToAlonzoEra era
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall a b. a -> b -> a
const (ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
 -> ShelleyToAlonzoEra era
 -> ExceptT ScriptWitnessError IO (ScriptWitness witctx era))
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
-> ShelleyToAlonzoEra era
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall a b. (a -> b) -> a -> b
$
          ScriptWitnessError
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ScriptWitnessError
 -> ExceptT ScriptWitnessError IO (ScriptWitness witctx era))
-> ScriptWitnessError
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall a b. (a -> b) -> a -> b
$
            AnyShelleyBasedEra -> ScriptWitnessError
ScriptWitnessErrorReferenceScriptsNotSupportedInEra (AnyShelleyBasedEra -> ScriptWitnessError)
-> AnyShelleyBasedEra -> ScriptWitnessError
forall a b. (a -> b) -> a -> b
$
              CardanoEra era
-> (CardanoEraConstraints era => AnyShelleyBasedEra)
-> AnyShelleyBasedEra
forall era a.
CardanoEra era -> (CardanoEraConstraints era => a) -> a
cardanoEraConstraints (ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra ShelleyBasedEra era
era) (ShelleyBasedEra era -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra era
era)
      )
      ( ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
-> BabbageEraOnwards era
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall a b. a -> b -> a
const (ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
 -> BabbageEraOnwards era
 -> ExceptT ScriptWitnessError IO (ScriptWitness witctx era))
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
-> BabbageEraOnwards era
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall a b. (a -> b) -> a -> b
$
          case ShelleyBasedEra era
-> ScriptLanguage lang -> Maybe (ScriptLanguageInEra lang era)
forall era lang.
ShelleyBasedEra era
-> ScriptLanguage lang -> Maybe (ScriptLanguageInEra lang era)
scriptLanguageSupportedInEra ShelleyBasedEra era
era (ScriptLanguage lang -> Maybe (ScriptLanguageInEra lang era))
-> ScriptLanguage lang -> Maybe (ScriptLanguageInEra lang era)
forall a b. (a -> b) -> a -> b
$ PlutusScriptVersion lang -> ScriptLanguage lang
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion lang
version of
            Just ScriptLanguageInEra lang era
sLangInEra ->
              do
                ScriptDatum witctx
datum <-
                  (ScriptDataError -> ScriptWitnessError)
-> ExceptT ScriptDataError IO (ScriptDatum witctx)
-> ExceptT ScriptWitnessError IO (ScriptDatum witctx)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ScriptDataError -> ScriptWitnessError
ScriptWitnessErrorScriptData (ExceptT ScriptDataError IO (ScriptDatum witctx)
 -> ExceptT ScriptWitnessError IO (ScriptDatum witctx))
-> ExceptT ScriptDataError IO (ScriptDatum witctx)
-> ExceptT ScriptWitnessError IO (ScriptDatum witctx)
forall a b. (a -> b) -> a -> b
$
                    ScriptDatumOrFile witctx
-> ExceptT ScriptDataError IO (ScriptDatum witctx)
forall witctx.
ScriptDatumOrFile witctx
-> ExceptT ScriptDataError IO (ScriptDatum witctx)
readScriptDatumOrFile ScriptDatumOrFile witctx
datumOrFile
                ScriptRedeemer
redeemer <-
                  (ScriptDataError -> ScriptWitnessError)
-> ExceptT ScriptDataError IO ScriptRedeemer
-> ExceptT ScriptWitnessError IO ScriptRedeemer
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ScriptDataError -> ScriptWitnessError
ScriptWitnessErrorScriptData (ExceptT ScriptDataError IO ScriptRedeemer
 -> ExceptT ScriptWitnessError IO ScriptRedeemer)
-> ExceptT ScriptDataError IO ScriptRedeemer
-> ExceptT ScriptWitnessError IO ScriptRedeemer
forall a b. (a -> b) -> a -> b
$
                    ScriptRedeemerOrFile -> ExceptT ScriptDataError IO ScriptRedeemer
readScriptRedeemerOrFile ScriptRedeemerOrFile
redeemerOrFile
                ScriptWitness witctx era
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall a. a -> ExceptT ScriptWitnessError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptWitness witctx era
 -> ExceptT ScriptWitnessError IO (ScriptWitness witctx era))
-> ScriptWitness witctx era
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall a b. (a -> b) -> a -> b
$
                  ScriptLanguageInEra lang era
-> PlutusScriptVersion lang
-> PlutusScriptOrReferenceInput lang
-> ScriptDatum witctx
-> ScriptRedeemer
-> ExecutionUnits
-> ScriptWitness witctx era
forall lang era witctx.
IsPlutusScriptLanguage lang =>
ScriptLanguageInEra lang era
-> PlutusScriptVersion lang
-> PlutusScriptOrReferenceInput lang
-> ScriptDatum witctx
-> ScriptRedeemer
-> ExecutionUnits
-> ScriptWitness witctx era
PlutusScriptWitness
                    ScriptLanguageInEra lang era
sLangInEra
                    PlutusScriptVersion lang
version
                    (TxIn -> PlutusScriptOrReferenceInput lang
forall lang. TxIn -> PlutusScriptOrReferenceInput lang
PReferenceScript TxIn
refTxIn)
                    ScriptDatum witctx
datum
                    ScriptRedeemer
redeemer
                    ExecutionUnits
execUnits
            Maybe (ScriptLanguageInEra lang era)
Nothing ->
              ScriptWitnessError
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ScriptWitnessError
 -> ExceptT ScriptWitnessError IO (ScriptWitness witctx era))
-> ScriptWitnessError
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall a b. (a -> b) -> a -> b
$
                AnyScriptLanguage -> AnyCardanoEra -> ScriptWitnessError
ScriptWitnessErrorScriptLanguageNotSupportedInEra
                  (ScriptLanguage lang -> AnyScriptLanguage
forall lang. ScriptLanguage lang -> AnyScriptLanguage
AnyScriptLanguage (ScriptLanguage lang -> AnyScriptLanguage)
-> ScriptLanguage lang -> AnyScriptLanguage
forall a b. (a -> b) -> a -> b
$ PlutusScriptVersion lang -> ScriptLanguage lang
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion lang
version)
                  (CardanoEra era -> AnyCardanoEra
forall era. CardanoEra era -> AnyCardanoEra
anyCardanoEra (CardanoEra era -> AnyCardanoEra)
-> CardanoEra era -> AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra ShelleyBasedEra era
era)
      )
      ShelleyBasedEra era
era
readScriptWitness
  ShelleyBasedEra era
era
  ( SimpleReferenceScriptWitnessFiles
      TxIn
refTxIn
      anyScrLang :: AnyScriptLanguage
anyScrLang@(AnyScriptLanguage ScriptLanguage lang
anyScriptLanguage)
    ) = do
    (ShelleyToAlonzoEraConstraints era =>
 ShelleyToAlonzoEra era
 -> ExceptT ScriptWitnessError IO (ScriptWitness witctx era))
-> (BabbageEraOnwardsConstraints era =>
    BabbageEraOnwards era
    -> ExceptT ScriptWitnessError IO (ScriptWitness witctx era))
-> ShelleyBasedEra era
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall era a.
(ShelleyToAlonzoEraConstraints era => ShelleyToAlonzoEra era -> a)
-> (BabbageEraOnwardsConstraints era => BabbageEraOnwards era -> a)
-> ShelleyBasedEra era
-> a
caseShelleyToAlonzoOrBabbageEraOnwards
      ( ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
-> ShelleyToAlonzoEra era
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall a b. a -> b -> a
const (ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
 -> ShelleyToAlonzoEra era
 -> ExceptT ScriptWitnessError IO (ScriptWitness witctx era))
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
-> ShelleyToAlonzoEra era
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall a b. (a -> b) -> a -> b
$
          ScriptWitnessError
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ScriptWitnessError
 -> ExceptT ScriptWitnessError IO (ScriptWitness witctx era))
-> ScriptWitnessError
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall a b. (a -> b) -> a -> b
$
            AnyShelleyBasedEra -> ScriptWitnessError
ScriptWitnessErrorReferenceScriptsNotSupportedInEra (AnyShelleyBasedEra -> ScriptWitnessError)
-> AnyShelleyBasedEra -> ScriptWitnessError
forall a b. (a -> b) -> a -> b
$
              CardanoEra era
-> (CardanoEraConstraints era => AnyShelleyBasedEra)
-> AnyShelleyBasedEra
forall era a.
CardanoEra era -> (CardanoEraConstraints era => a) -> a
cardanoEraConstraints (ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra ShelleyBasedEra era
era) (ShelleyBasedEra era -> AnyShelleyBasedEra
forall era.
Typeable era =>
ShelleyBasedEra era -> AnyShelleyBasedEra
AnyShelleyBasedEra ShelleyBasedEra era
era)
      )
      ( ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
-> BabbageEraOnwards era
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall a b. a -> b -> a
const (ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
 -> BabbageEraOnwards era
 -> ExceptT ScriptWitnessError IO (ScriptWitness witctx era))
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
-> BabbageEraOnwards era
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall a b. (a -> b) -> a -> b
$
          case ShelleyBasedEra era
-> ScriptLanguage lang -> Maybe (ScriptLanguageInEra lang era)
forall era lang.
ShelleyBasedEra era
-> ScriptLanguage lang -> Maybe (ScriptLanguageInEra lang era)
scriptLanguageSupportedInEra ShelleyBasedEra era
era ScriptLanguage lang
anyScriptLanguage of
            Just ScriptLanguageInEra lang era
sLangInEra ->
              case ScriptLanguageInEra lang era -> ScriptLanguage lang
forall lang era.
ScriptLanguageInEra lang era -> ScriptLanguage lang
languageOfScriptLanguageInEra ScriptLanguageInEra lang era
sLangInEra of
                ScriptLanguage lang
SimpleScriptLanguage ->
                  ScriptWitness witctx era
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall a. a -> ExceptT ScriptWitnessError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptWitness witctx era
 -> ExceptT ScriptWitnessError IO (ScriptWitness witctx era))
-> (SimpleScriptOrReferenceInput SimpleScript'
    -> ScriptWitness witctx era)
-> SimpleScriptOrReferenceInput SimpleScript'
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptLanguageInEra SimpleScript' era
-> SimpleScriptOrReferenceInput SimpleScript'
-> ScriptWitness witctx era
forall era witctx.
ScriptLanguageInEra SimpleScript' era
-> SimpleScriptOrReferenceInput SimpleScript'
-> ScriptWitness witctx era
SimpleScriptWitness ScriptLanguageInEra lang era
ScriptLanguageInEra SimpleScript' era
sLangInEra (SimpleScriptOrReferenceInput SimpleScript'
 -> ExceptT ScriptWitnessError IO (ScriptWitness witctx era))
-> SimpleScriptOrReferenceInput SimpleScript'
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall a b. (a -> b) -> a -> b
$
                    TxIn -> SimpleScriptOrReferenceInput SimpleScript'
forall lang. TxIn -> SimpleScriptOrReferenceInput lang
SReferenceScript TxIn
refTxIn
                PlutusScriptLanguage{} ->
                  String -> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall a. HasCallStack => String -> a
error String
"readScriptWitness: Should not be possible to specify a plutus script"
            Maybe (ScriptLanguageInEra lang era)
Nothing ->
              ScriptWitnessError
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ScriptWitnessError
 -> ExceptT ScriptWitnessError IO (ScriptWitness witctx era))
-> ScriptWitnessError
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
forall a b. (a -> b) -> a -> b
$
                AnyScriptLanguage -> AnyCardanoEra -> ScriptWitnessError
ScriptWitnessErrorScriptLanguageNotSupportedInEra
                  AnyScriptLanguage
anyScrLang
                  (CardanoEra era -> AnyCardanoEra
forall era. CardanoEra era -> AnyCardanoEra
anyCardanoEra (CardanoEra era -> AnyCardanoEra)
-> CardanoEra era -> AnyCardanoEra
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra ShelleyBasedEra era
era)
      )
      ShelleyBasedEra era
era

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

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

readScriptRedeemerOrFile
  :: ScriptRedeemerOrFile
  -> ExceptT ScriptDataError IO ScriptRedeemer
readScriptRedeemerOrFile :: ScriptRedeemerOrFile -> ExceptT ScriptDataError IO ScriptRedeemer
readScriptRedeemerOrFile = ScriptRedeemerOrFile -> ExceptT ScriptDataError IO ScriptRedeemer
forall (m :: * -> *).
MonadIO m =>
ScriptRedeemerOrFile -> ExceptT ScriptDataError m ScriptRedeemer
readScriptDataOrFile

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

readVerificationKeyOrHashOrFileOrScript
  :: MonadIOTransError (Either (FileError ScriptDecodeError) (FileError InputDecodeError)) t m
  => Key keyrole
  => AsType keyrole
  -> (Hash keyrole -> L.KeyHash kr L.StandardCrypto)
  -> VerificationKeyOrHashOrFileOrScript keyrole
  -> t m (L.Credential kr L.StandardCrypto)
readVerificationKeyOrHashOrFileOrScript :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) keyrole
       (kr :: KeyRole).
(MonadIOTransError
   (Either (FileError ScriptDecodeError) (FileError InputDecodeError))
   t
   m,
 Key keyrole) =>
AsType keyrole
-> (Hash keyrole -> KeyHash kr StandardCrypto)
-> VerificationKeyOrHashOrFileOrScript keyrole
-> t m (Credential kr StandardCrypto)
readVerificationKeyOrHashOrFileOrScript AsType keyrole
asType Hash keyrole -> KeyHash kr StandardCrypto
extractHash = \case
  VkhfsScript (File String
fp) -> do
    ScriptInAnyLang ScriptLanguage lang
_lang Script lang
script <-
      (FileError ScriptDecodeError
 -> Either
      (FileError ScriptDecodeError) (FileError InputDecodeError))
-> ExceptT (FileError ScriptDecodeError) m ScriptInAnyLang
-> t m ScriptInAnyLang
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError FileError ScriptDecodeError
-> Either
     (FileError ScriptDecodeError) (FileError InputDecodeError)
forall a b. a -> Either a b
Left (ExceptT (FileError ScriptDecodeError) m ScriptInAnyLang
 -> t m ScriptInAnyLang)
-> ExceptT (FileError ScriptDecodeError) m ScriptInAnyLang
-> t m ScriptInAnyLang
forall a b. (a -> b) -> a -> b
$
        String -> ExceptT (FileError ScriptDecodeError) m ScriptInAnyLang
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadIOTransError (FileError ScriptDecodeError) t m =>
String -> t m ScriptInAnyLang
readFileScriptInAnyLang String
fp
    Credential kr StandardCrypto -> t m (Credential kr StandardCrypto)
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential kr StandardCrypto
 -> t m (Credential kr StandardCrypto))
-> (ScriptHash -> Credential kr StandardCrypto)
-> ScriptHash
-> t m (Credential kr StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash StandardCrypto -> Credential kr StandardCrypto
forall (kr :: KeyRole) c. ScriptHash c -> Credential kr c
L.ScriptHashObj (ScriptHash StandardCrypto -> Credential kr StandardCrypto)
-> (ScriptHash -> ScriptHash StandardCrypto)
-> ScriptHash
-> Credential kr StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> ScriptHash StandardCrypto
toShelleyScriptHash (ScriptHash -> t m (Credential kr StandardCrypto))
-> ScriptHash -> t m (Credential kr StandardCrypto)
forall a b. (a -> b) -> a -> b
$ Script lang -> ScriptHash
forall lang. Script lang -> ScriptHash
hashScript Script lang
script
  VkhfsKeyHashFile VerificationKeyOrHashOrFile keyrole
vkOrHashOrFp ->
    (Hash keyrole -> Credential kr StandardCrypto)
-> t m (Hash keyrole) -> t m (Credential kr StandardCrypto)
forall a b. (a -> b) -> t m a -> t m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (KeyHash kr StandardCrypto -> Credential kr StandardCrypto
forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
L.KeyHashObj (KeyHash kr StandardCrypto -> Credential kr StandardCrypto)
-> (Hash keyrole -> KeyHash kr StandardCrypto)
-> Hash keyrole
-> Credential kr StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash keyrole -> KeyHash kr StandardCrypto
extractHash) (t m (Hash keyrole) -> t m (Credential kr StandardCrypto))
-> (ExceptT (FileError InputDecodeError) m (Hash keyrole)
    -> t m (Hash keyrole))
-> ExceptT (FileError InputDecodeError) m (Hash keyrole)
-> t m (Credential kr StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FileError InputDecodeError
 -> Either
      (FileError ScriptDecodeError) (FileError InputDecodeError))
-> ExceptT (FileError InputDecodeError) m (Hash keyrole)
-> t m (Hash keyrole)
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError FileError InputDecodeError
-> Either
     (FileError ScriptDecodeError) (FileError InputDecodeError)
forall a b. b -> Either a b
Right (ExceptT (FileError InputDecodeError) m (Hash keyrole)
 -> t m (Credential kr StandardCrypto))
-> ExceptT (FileError InputDecodeError) m (Hash keyrole)
-> t m (Credential kr StandardCrypto)
forall a b. (a -> b) -> a -> b
$
      AsType keyrole
-> VerificationKeyOrHashOrFile keyrole
-> ExceptT (FileError InputDecodeError) m (Hash keyrole)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) keyrole.
(MonadIOTransError (FileError InputDecodeError) t m,
 Key keyrole) =>
AsType keyrole
-> VerificationKeyOrHashOrFile keyrole -> t m (Hash keyrole)
readVerificationKeyOrHashOrTextEnvFile AsType keyrole
asType VerificationKeyOrHashOrFile keyrole
vkOrHashOrFp

readVerificationKeySource
  :: MonadIOTransError (Either (FileError ScriptDecodeError) (FileError InputDecodeError)) t m
  => Key keyrole
  => AsType keyrole
  -> (Hash keyrole -> L.KeyHash kr L.StandardCrypto)
  -> VerificationKeySource keyrole
  -> t m (L.Credential kr L.StandardCrypto)
readVerificationKeySource :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) keyrole
       (kr :: KeyRole).
(MonadIOTransError
   (Either (FileError ScriptDecodeError) (FileError InputDecodeError))
   t
   m,
 Key keyrole) =>
AsType keyrole
-> (Hash keyrole -> KeyHash kr StandardCrypto)
-> VerificationKeySource keyrole
-> t m (Credential kr StandardCrypto)
readVerificationKeySource AsType keyrole
asType Hash keyrole -> KeyHash kr StandardCrypto
extractHash = \case
  VksScriptHash (ScriptHash ScriptHash StandardCrypto
scriptHash) ->
    Credential kr StandardCrypto -> t m (Credential kr StandardCrypto)
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential kr StandardCrypto
 -> t m (Credential kr StandardCrypto))
-> Credential kr StandardCrypto
-> t m (Credential kr StandardCrypto)
forall a b. (a -> b) -> a -> b
$ ScriptHash StandardCrypto -> Credential kr StandardCrypto
forall (kr :: KeyRole) c. ScriptHash c -> Credential kr c
L.ScriptHashObj ScriptHash StandardCrypto
scriptHash
  VksScript (File String
fp) -> do
    ScriptInAnyLang ScriptLanguage lang
_lang Script lang
script <-
      (FileError ScriptDecodeError
 -> Either
      (FileError ScriptDecodeError) (FileError InputDecodeError))
-> ExceptT (FileError ScriptDecodeError) m ScriptInAnyLang
-> t m ScriptInAnyLang
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError FileError ScriptDecodeError
-> Either
     (FileError ScriptDecodeError) (FileError InputDecodeError)
forall a b. a -> Either a b
Left (ExceptT (FileError ScriptDecodeError) m ScriptInAnyLang
 -> t m ScriptInAnyLang)
-> ExceptT (FileError ScriptDecodeError) m ScriptInAnyLang
-> t m ScriptInAnyLang
forall a b. (a -> b) -> a -> b
$
        String -> ExceptT (FileError ScriptDecodeError) m ScriptInAnyLang
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadIOTransError (FileError ScriptDecodeError) t m =>
String -> t m ScriptInAnyLang
readFileScriptInAnyLang String
fp
    Credential kr StandardCrypto -> t m (Credential kr StandardCrypto)
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential kr StandardCrypto
 -> t m (Credential kr StandardCrypto))
-> (ScriptHash -> Credential kr StandardCrypto)
-> ScriptHash
-> t m (Credential kr StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash StandardCrypto -> Credential kr StandardCrypto
forall (kr :: KeyRole) c. ScriptHash c -> Credential kr c
L.ScriptHashObj (ScriptHash StandardCrypto -> Credential kr StandardCrypto)
-> (ScriptHash -> ScriptHash StandardCrypto)
-> ScriptHash
-> Credential kr StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> ScriptHash StandardCrypto
toShelleyScriptHash (ScriptHash -> t m (Credential kr StandardCrypto))
-> ScriptHash -> t m (Credential kr StandardCrypto)
forall a b. (a -> b) -> a -> b
$ Script lang -> ScriptHash
forall lang. Script lang -> ScriptHash
hashScript Script lang
script
  VksKeyHashFile VerificationKeyOrHashOrFile keyrole
vKeyOrHashOrFile ->
    (Hash keyrole -> Credential kr StandardCrypto)
-> t m (Hash keyrole) -> t m (Credential kr StandardCrypto)
forall a b. (a -> b) -> t m a -> t m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (KeyHash kr StandardCrypto -> Credential kr StandardCrypto
forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
L.KeyHashObj (KeyHash kr StandardCrypto -> Credential kr StandardCrypto)
-> (Hash keyrole -> KeyHash kr StandardCrypto)
-> Hash keyrole
-> Credential kr StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash keyrole -> KeyHash kr StandardCrypto
extractHash) (t m (Hash keyrole) -> t m (Credential kr StandardCrypto))
-> (ExceptT (FileError InputDecodeError) m (Hash keyrole)
    -> t m (Hash keyrole))
-> ExceptT (FileError InputDecodeError) m (Hash keyrole)
-> t m (Credential kr StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FileError InputDecodeError
 -> Either
      (FileError ScriptDecodeError) (FileError InputDecodeError))
-> ExceptT (FileError InputDecodeError) m (Hash keyrole)
-> t m (Hash keyrole)
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError FileError InputDecodeError
-> Either
     (FileError ScriptDecodeError) (FileError InputDecodeError)
forall a b. b -> Either a b
Right (ExceptT (FileError InputDecodeError) m (Hash keyrole)
 -> t m (Credential kr StandardCrypto))
-> ExceptT (FileError InputDecodeError) m (Hash keyrole)
-> t m (Credential kr StandardCrypto)
forall a b. (a -> b) -> a -> b
$
      AsType keyrole
-> VerificationKeyOrHashOrFile keyrole
-> ExceptT (FileError InputDecodeError) m (Hash keyrole)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) keyrole.
(MonadIOTransError (FileError InputDecodeError) t m,
 Key keyrole) =>
AsType keyrole
-> VerificationKeyOrHashOrFile keyrole -> t m (Hash keyrole)
readVerificationKeyOrHashOrTextEnvFile AsType keyrole
asType VerificationKeyOrHashOrFile keyrole
vKeyOrHashOrFile

-- | 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
  :: MonadIOTransError (FileError ScriptDecodeError) t m
  => FilePath
  -> t m ScriptInAnyLang
readFileScriptInAnyLang :: forall (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadIOTransError (FileError ScriptDecodeError) t m =>
String -> t m ScriptInAnyLang
readFileScriptInAnyLang String
file = do
  ByteString
scriptBytes <- (IOException -> FileError ScriptDecodeError)
-> m ByteString -> t m ByteString
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
(MonadIOTransError e' t m, Exception e) =>
(e -> e') -> m a -> t m a
handleIOExceptionsLiftWith (String -> IOException -> FileError ScriptDecodeError
forall e. String -> IOException -> FileError e
FileIOError String
file) (m ByteString -> t m ByteString)
-> (IO ByteString -> m ByteString)
-> IO ByteString
-> t m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> t m ByteString)
-> IO ByteString -> t m ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
BS.readFile String
file
  (ScriptDecodeError -> FileError ScriptDecodeError)
-> ExceptT ScriptDecodeError m ScriptInAnyLang
-> t m ScriptInAnyLang
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError (String -> ScriptDecodeError -> FileError ScriptDecodeError
forall e. String -> e -> FileError e
FileError String
file) (ExceptT ScriptDecodeError m ScriptInAnyLang
 -> t m ScriptInAnyLang)
-> ExceptT ScriptDecodeError m ScriptInAnyLang
-> t m ScriptInAnyLang
forall a b. (a -> b) -> a -> b
$
    Either ScriptDecodeError ScriptInAnyLang
-> ExceptT ScriptDecodeError m ScriptInAnyLang
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either ScriptDecodeError ScriptInAnyLang
 -> ExceptT ScriptDecodeError m ScriptInAnyLang)
-> Either ScriptDecodeError ScriptInAnyLang
-> ExceptT ScriptDecodeError m ScriptInAnyLang
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 AsType TextEnvelope
-> ByteString -> Either JsonDecodeError TextEnvelope
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 ByteString -> Either String SimpleScript
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict' ByteString
bs of
        Left String
err -> ScriptDecodeError -> Either ScriptDecodeError ScriptInAnyLang
forall a b. a -> Either a b
Left (JsonDecodeError -> ScriptDecodeError
ScriptDecodeSimpleScriptError (JsonDecodeError -> ScriptDecodeError)
-> JsonDecodeError -> ScriptDecodeError
forall a b. (a -> b) -> a -> b
$ String -> JsonDecodeError
JsonDecodeError String
err)
        Right SimpleScript
script -> ScriptInAnyLang -> Either ScriptDecodeError ScriptInAnyLang
forall a b. b -> Either a b
Right (ScriptInAnyLang -> Either ScriptDecodeError ScriptInAnyLang)
-> ScriptInAnyLang -> Either ScriptDecodeError ScriptInAnyLang
forall a b. (a -> b) -> a -> b
$ ScriptLanguage SimpleScript'
-> Script SimpleScript' -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang ScriptLanguage SimpleScript'
SimpleScriptLanguage (Script SimpleScript' -> ScriptInAnyLang)
-> Script SimpleScript' -> ScriptInAnyLang
forall a b. (a -> b) -> a -> b
$ SimpleScript -> Script SimpleScript'
SimpleScript SimpleScript
script
    Right TextEnvelope
te ->
      case [FromSomeType HasTextEnvelope ScriptInAnyLang]
-> TextEnvelope -> Either TextEnvelopeError ScriptInAnyLang
forall b.
[FromSomeType HasTextEnvelope b]
-> TextEnvelope -> Either TextEnvelopeError b
deserialiseFromTextEnvelopeAnyOf [FromSomeType HasTextEnvelope ScriptInAnyLang]
textEnvTypes TextEnvelope
te of
        Left TextEnvelopeError
err -> ScriptDecodeError -> Either ScriptDecodeError ScriptInAnyLang
forall a b. a -> Either a b
Left (TextEnvelopeError -> ScriptDecodeError
ScriptDecodeTextEnvelopeError TextEnvelopeError
err)
        Right ScriptInAnyLang
script -> ScriptInAnyLang -> Either ScriptDecodeError ScriptInAnyLang
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 = FromSomeType HasTextEnvelope ScriptInAnyLang
fromSomeTypeSimpleScript FromSomeType HasTextEnvelope ScriptInAnyLang
-> [FromSomeType HasTextEnvelope ScriptInAnyLang]
-> [FromSomeType HasTextEnvelope ScriptInAnyLang]
forall a. a -> [a] -> [a]
: [FromSomeType HasTextEnvelope ScriptInAnyLang]
fromSomeTypePlutusScripts

fromSomeTypeSimpleScript :: FromSomeType HasTextEnvelope ScriptInAnyLang
fromSomeTypeSimpleScript :: FromSomeType HasTextEnvelope ScriptInAnyLang
fromSomeTypeSimpleScript =
  AsType (Script SimpleScript')
-> (Script SimpleScript' -> ScriptInAnyLang)
-> FromSomeType HasTextEnvelope ScriptInAnyLang
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType
    (AsType SimpleScript' -> AsType (Script SimpleScript')
forall lang. AsType lang -> AsType (Script lang)
AsScript AsType SimpleScript'
AsSimpleScript)
    (ScriptLanguage SimpleScript'
-> Script SimpleScript' -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang ScriptLanguage SimpleScript'
SimpleScriptLanguage)

fromSomeTypePlutusScripts :: [FromSomeType HasTextEnvelope ScriptInAnyLang]
fromSomeTypePlutusScripts :: [FromSomeType HasTextEnvelope ScriptInAnyLang]
fromSomeTypePlutusScripts =
  let [AnyPlutusScriptVersion]
allPlutusVersions :: [AnyPlutusScriptVersion] = [AnyPlutusScriptVersion
forall a. Bounded a => a
minBound .. AnyPlutusScriptVersion
forall a. Bounded a => a
maxBound]
   in [PlutusScriptVersion lang
-> FromSomeType HasTextEnvelope ScriptInAnyLang
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang
-> FromSomeType HasTextEnvelope ScriptInAnyLang
plutusScriptVersionFromSomeType PlutusScriptVersion lang
v | AnyPlutusScriptVersion PlutusScriptVersion lang
v <- [AnyPlutusScriptVersion]
allPlutusVersions]
 where
  plutusScriptVersionFromSomeType
    :: IsPlutusScriptLanguage lang
    => PlutusScriptVersion lang -> FromSomeType HasTextEnvelope ScriptInAnyLang
  plutusScriptVersionFromSomeType :: forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang
-> FromSomeType HasTextEnvelope ScriptInAnyLang
plutusScriptVersionFromSomeType PlutusScriptVersion lang
v =
    AsType (Script lang)
-> (Script lang -> ScriptInAnyLang)
-> FromSomeType HasTextEnvelope ScriptInAnyLang
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType
      (AsType lang -> AsType (Script lang)
forall lang. AsType lang -> AsType (Script lang)
AsScript (AsType lang -> AsType (Script lang))
-> AsType lang -> AsType (Script lang)
forall a b. (a -> b) -> a -> b
$ Proxy lang -> AsType lang
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType (Proxy lang
forall {lang}. Proxy lang
forall {k} (t :: k). Proxy t
Proxy :: Proxy lang))
      (ScriptLanguage lang -> Script lang -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang (ScriptLanguage lang -> Script lang -> ScriptInAnyLang)
-> ScriptLanguage lang -> Script lang -> ScriptInAnyLang
forall a b. (a -> b) -> a -> b
$ PlutusScriptVersion lang -> ScriptLanguage lang
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang -> ScriptLanguage lang
PlutusScriptLanguage PlutusScriptVersion lang
v)

readFileSimpleScript
  :: MonadIOTransError (FileError ScriptDecodeError) t m
  => FilePath
  -> t m (Script SimpleScript')
readFileSimpleScript :: forall (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadIOTransError (FileError ScriptDecodeError) t m =>
String -> t m (Script SimpleScript')
readFileSimpleScript String
file = do
  ByteString
scriptBytes <- (IOException -> FileError ScriptDecodeError)
-> m ByteString -> t m ByteString
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
(MonadIOTransError e' t m, Exception e) =>
(e -> e') -> m a -> t m a
handleIOExceptionsLiftWith (String -> IOException -> FileError ScriptDecodeError
forall e. String -> IOException -> FileError e
FileIOError String
file) (m ByteString -> t m ByteString)
-> (IO ByteString -> m ByteString)
-> IO ByteString
-> t m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> t m ByteString)
-> IO ByteString -> t m ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
BS.readFile String
file
  (ScriptDecodeError -> FileError ScriptDecodeError)
-> ExceptT ScriptDecodeError m (Script SimpleScript')
-> t m (Script SimpleScript')
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError (String -> ScriptDecodeError -> FileError ScriptDecodeError
forall e. String -> e -> FileError e
FileError String
file) (ExceptT ScriptDecodeError m (Script SimpleScript')
 -> t m (Script SimpleScript'))
-> ExceptT ScriptDecodeError m (Script SimpleScript')
-> t m (Script SimpleScript')
forall a b. (a -> b) -> a -> b
$
    Either ScriptDecodeError (Script SimpleScript')
-> ExceptT ScriptDecodeError m (Script SimpleScript')
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either ScriptDecodeError (Script SimpleScript')
 -> ExceptT ScriptDecodeError m (Script SimpleScript'))
-> Either ScriptDecodeError (Script SimpleScript')
-> ExceptT ScriptDecodeError m (Script SimpleScript')
forall a b. (a -> b) -> a -> b
$
      ByteString -> Either ScriptDecodeError (Script SimpleScript')
deserialiseSimpleScript ByteString
scriptBytes

deserialiseSimpleScript
  :: BS.ByteString
  -> Either ScriptDecodeError (Script SimpleScript')
deserialiseSimpleScript :: ByteString -> Either ScriptDecodeError (Script SimpleScript')
deserialiseSimpleScript ByteString
bs =
  case AsType TextEnvelope
-> ByteString -> Either JsonDecodeError TextEnvelope
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 ByteString -> Either String SimpleScript
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict' ByteString
bs of
        Left String
err -> ScriptDecodeError
-> Either ScriptDecodeError (Script SimpleScript')
forall a b. a -> Either a b
Left (JsonDecodeError -> ScriptDecodeError
ScriptDecodeSimpleScriptError (JsonDecodeError -> ScriptDecodeError)
-> JsonDecodeError -> ScriptDecodeError
forall a b. (a -> b) -> a -> b
$ String -> JsonDecodeError
JsonDecodeError String
err)
        Right SimpleScript
script -> Script SimpleScript'
-> Either ScriptDecodeError (Script SimpleScript')
forall a b. b -> Either a b
Right (Script SimpleScript'
 -> Either ScriptDecodeError (Script SimpleScript'))
-> Script SimpleScript'
-> Either ScriptDecodeError (Script SimpleScript')
forall a b. (a -> b) -> a -> b
$ SimpleScript -> Script SimpleScript'
SimpleScript SimpleScript
script
    Right TextEnvelope
te ->
      case [FromSomeType HasTextEnvelope (Script SimpleScript')]
-> TextEnvelope -> Either TextEnvelopeError (Script SimpleScript')
forall b.
[FromSomeType HasTextEnvelope b]
-> TextEnvelope -> Either TextEnvelopeError b
deserialiseFromTextEnvelopeAnyOf [FromSomeType HasTextEnvelope (Script SimpleScript')
teType'] TextEnvelope
te of
        Left TextEnvelopeError
err -> ScriptDecodeError
-> Either ScriptDecodeError (Script SimpleScript')
forall a b. a -> Either a b
Left (TextEnvelopeError -> ScriptDecodeError
ScriptDecodeTextEnvelopeError TextEnvelopeError
err)
        Right Script SimpleScript'
script -> Script SimpleScript'
-> Either ScriptDecodeError (Script SimpleScript')
forall a b. b -> Either a b
Right Script SimpleScript'
script
 where
  teType' :: FromSomeType HasTextEnvelope (Script SimpleScript')
  teType' :: FromSomeType HasTextEnvelope (Script SimpleScript')
teType' = AsType (Script SimpleScript')
-> (Script SimpleScript' -> Script SimpleScript')
-> FromSomeType HasTextEnvelope (Script SimpleScript')
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType SimpleScript' -> AsType (Script SimpleScript')
forall lang. AsType lang -> AsType (Script lang)
AsScript AsType SimpleScript'
AsSimpleScript) Script SimpleScript' -> Script SimpleScript'
forall a. a -> a
id

readFilePlutusScript
  :: MonadIOTransError (FileError PlutusScriptDecodeError) t m
  => FilePath
  -> t m AnyPlutusScript
readFilePlutusScript :: forall (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadIOTransError (FileError PlutusScriptDecodeError) t m =>
String -> t m AnyPlutusScript
readFilePlutusScript String
plutusScriptFp = do
  ByteString
bs <-
    (IOException -> FileError PlutusScriptDecodeError)
-> m ByteString -> t m ByteString
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
(MonadIOTransError e' t m, Exception e) =>
(e -> e') -> m a -> t m a
handleIOExceptionsLiftWith (String -> IOException -> FileError PlutusScriptDecodeError
forall e. String -> IOException -> FileError e
FileIOError String
plutusScriptFp) (m ByteString -> t m ByteString)
-> (IO ByteString -> m ByteString)
-> IO ByteString
-> t m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> t m ByteString)
-> IO ByteString -> t m ByteString
forall a b. (a -> b) -> a -> b
$
      String -> IO ByteString
BS.readFile String
plutusScriptFp
  (PlutusScriptDecodeError -> FileError PlutusScriptDecodeError)
-> ExceptT PlutusScriptDecodeError m AnyPlutusScript
-> t m AnyPlutusScript
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError (String
-> PlutusScriptDecodeError -> FileError PlutusScriptDecodeError
forall e. String -> e -> FileError e
FileError String
plutusScriptFp) (ExceptT PlutusScriptDecodeError m AnyPlutusScript
 -> t m AnyPlutusScript)
-> ExceptT PlutusScriptDecodeError m AnyPlutusScript
-> t m AnyPlutusScript
forall a b. (a -> b) -> a -> b
$
    Either PlutusScriptDecodeError AnyPlutusScript
-> ExceptT PlutusScriptDecodeError m AnyPlutusScript
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either PlutusScriptDecodeError AnyPlutusScript
 -> ExceptT PlutusScriptDecodeError m AnyPlutusScript)
-> Either PlutusScriptDecodeError AnyPlutusScript
-> ExceptT PlutusScriptDecodeError m AnyPlutusScript
forall a b. (a -> b) -> a -> b
$
      ByteString -> Either PlutusScriptDecodeError AnyPlutusScript
deserialisePlutusScript ByteString
bs

deserialisePlutusScript
  :: BS.ByteString
  -> Either PlutusScriptDecodeError AnyPlutusScript
deserialisePlutusScript :: ByteString -> Either PlutusScriptDecodeError AnyPlutusScript
deserialisePlutusScript ByteString
bs = do
  TextEnvelope
te <- (JsonDecodeError -> PlutusScriptDecodeError)
-> Either JsonDecodeError TextEnvelope
-> Either PlutusScriptDecodeError TextEnvelope
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first JsonDecodeError -> PlutusScriptDecodeError
PlutusScriptJsonDecodeError (Either JsonDecodeError TextEnvelope
 -> Either PlutusScriptDecodeError TextEnvelope)
-> Either JsonDecodeError TextEnvelope
-> Either PlutusScriptDecodeError TextEnvelope
forall a b. (a -> b) -> a -> b
$ AsType TextEnvelope
-> ByteString -> Either JsonDecodeError TextEnvelope
forall a.
FromJSON a =>
AsType a -> ByteString -> Either JsonDecodeError a
deserialiseFromJSON AsType TextEnvelope
AsTextEnvelope ByteString
bs
  case TextEnvelope -> TextEnvelopeType
teType TextEnvelope
te of
    TextEnvelopeType String
s -> case String
s of
      sVer :: String
sVer@String
"PlutusScriptV1" -> String
-> PlutusScriptVersion PlutusScriptV1
-> TextEnvelope
-> Either PlutusScriptDecodeError AnyPlutusScript
forall lang.
IsPlutusScriptLanguage lang =>
String
-> PlutusScriptVersion lang
-> TextEnvelope
-> Either PlutusScriptDecodeError AnyPlutusScript
deserialiseAnyPlutusScriptVersion String
sVer PlutusScriptVersion PlutusScriptV1
PlutusScriptV1 TextEnvelope
te
      sVer :: String
sVer@String
"PlutusScriptV2" -> String
-> PlutusScriptVersion PlutusScriptV2
-> TextEnvelope
-> Either PlutusScriptDecodeError AnyPlutusScript
forall lang.
IsPlutusScriptLanguage lang =>
String
-> PlutusScriptVersion lang
-> TextEnvelope
-> Either PlutusScriptDecodeError AnyPlutusScript
deserialiseAnyPlutusScriptVersion String
sVer PlutusScriptVersion PlutusScriptV2
PlutusScriptV2 TextEnvelope
te
      sVer :: String
sVer@String
"PlutusScriptV3" -> String
-> PlutusScriptVersion PlutusScriptV3
-> TextEnvelope
-> Either PlutusScriptDecodeError AnyPlutusScript
forall lang.
IsPlutusScriptLanguage lang =>
String
-> PlutusScriptVersion lang
-> TextEnvelope
-> Either PlutusScriptDecodeError AnyPlutusScript
deserialiseAnyPlutusScriptVersion String
sVer PlutusScriptVersion PlutusScriptV3
PlutusScriptV3 TextEnvelope
te
      String
unknownScriptVersion ->
        PlutusScriptDecodeError
-> Either PlutusScriptDecodeError AnyPlutusScript
forall a b. a -> Either a b
Left (PlutusScriptDecodeError
 -> Either PlutusScriptDecodeError AnyPlutusScript)
-> (Text -> PlutusScriptDecodeError)
-> Text
-> Either PlutusScriptDecodeError AnyPlutusScript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PlutusScriptDecodeError
PlutusScriptDecodeErrorUnknownVersion (Text -> Either PlutusScriptDecodeError AnyPlutusScript)
-> Text -> Either PlutusScriptDecodeError AnyPlutusScript
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
unknownScriptVersion
 where
  deserialiseAnyPlutusScriptVersion
    :: IsPlutusScriptLanguage lang
    => String
    -> PlutusScriptVersion lang
    -> TextEnvelope
    -> Either PlutusScriptDecodeError AnyPlutusScript
  deserialiseAnyPlutusScriptVersion :: forall lang.
IsPlutusScriptLanguage lang =>
String
-> PlutusScriptVersion lang
-> TextEnvelope
-> Either PlutusScriptDecodeError AnyPlutusScript
deserialiseAnyPlutusScriptVersion String
v PlutusScriptVersion lang
lang TextEnvelope
tEnv =
    if String
v String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== PlutusScriptVersion lang -> String
forall a. Show a => a -> String
show PlutusScriptVersion lang
lang
      then
        (TextEnvelopeError -> PlutusScriptDecodeError)
-> Either TextEnvelopeError AnyPlutusScript
-> Either PlutusScriptDecodeError AnyPlutusScript
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TextEnvelopeError -> PlutusScriptDecodeError
PlutusScriptDecodeTextEnvelopeError (Either TextEnvelopeError AnyPlutusScript
 -> Either PlutusScriptDecodeError AnyPlutusScript)
-> Either TextEnvelopeError AnyPlutusScript
-> Either PlutusScriptDecodeError AnyPlutusScript
forall a b. (a -> b) -> a -> b
$
          [FromSomeType HasTextEnvelope AnyPlutusScript]
-> TextEnvelope -> Either TextEnvelopeError AnyPlutusScript
forall b.
[FromSomeType HasTextEnvelope b]
-> TextEnvelope -> Either TextEnvelopeError b
deserialiseFromTextEnvelopeAnyOf [AnyPlutusScriptVersion
-> FromSomeType HasTextEnvelope AnyPlutusScript
teTypes (PlutusScriptVersion lang -> AnyPlutusScriptVersion
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang -> AnyPlutusScriptVersion
AnyPlutusScriptVersion PlutusScriptVersion lang
lang)] TextEnvelope
tEnv
      else PlutusScriptDecodeError
-> Either PlutusScriptDecodeError AnyPlutusScript
forall a b. a -> Either a b
Left (PlutusScriptDecodeError
 -> Either PlutusScriptDecodeError AnyPlutusScript)
-> PlutusScriptDecodeError
-> Either PlutusScriptDecodeError AnyPlutusScript
forall a b. (a -> b) -> a -> b
$ Text -> AnyPlutusScriptVersion -> PlutusScriptDecodeError
PlutusScriptDecodeErrorVersionMismatch (String -> Text
Text.pack String
v) (PlutusScriptVersion lang -> AnyPlutusScriptVersion
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang -> AnyPlutusScriptVersion
AnyPlutusScriptVersion PlutusScriptVersion lang
lang)

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

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

-- Tx & TxBody

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

readFileTx :: FileOrPipe -> IO (Either (FileError TextEnvelopeCddlError) (InAnyShelleyBasedEra Tx))
readFileTx :: FileOrPipe
-> IO
     (Either
        (FileError TextEnvelopeCddlError) (InAnyShelleyBasedEra Tx))
readFileTx FileOrPipe
file = do
  Either (FileError TextEnvelopeCddlError) CddlTx
cddlTxOrErr <- FileOrPipe -> IO (Either (FileError TextEnvelopeCddlError) CddlTx)
readCddlTx FileOrPipe
file
  case Either (FileError TextEnvelopeCddlError) CddlTx
cddlTxOrErr of
    Left FileError TextEnvelopeCddlError
e -> Either (FileError TextEnvelopeCddlError) (InAnyShelleyBasedEra Tx)
-> IO
     (Either
        (FileError TextEnvelopeCddlError) (InAnyShelleyBasedEra Tx))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (FileError TextEnvelopeCddlError) (InAnyShelleyBasedEra Tx)
 -> IO
      (Either
         (FileError TextEnvelopeCddlError) (InAnyShelleyBasedEra Tx)))
-> Either
     (FileError TextEnvelopeCddlError) (InAnyShelleyBasedEra Tx)
-> IO
     (Either
        (FileError TextEnvelopeCddlError) (InAnyShelleyBasedEra Tx))
forall a b. (a -> b) -> a -> b
$ FileError TextEnvelopeCddlError
-> Either
     (FileError TextEnvelopeCddlError) (InAnyShelleyBasedEra Tx)
forall a b. a -> Either a b
Left FileError TextEnvelopeCddlError
e
    Right CddlTx
cddlTx -> do
      InAnyShelleyBasedEra ShelleyBasedEra era
sbe Tx era
tx <- InAnyShelleyBasedEra Tx -> IO (InAnyShelleyBasedEra Tx)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InAnyShelleyBasedEra Tx -> IO (InAnyShelleyBasedEra Tx))
-> InAnyShelleyBasedEra Tx -> IO (InAnyShelleyBasedEra Tx)
forall a b. (a -> b) -> a -> b
$ CddlTx -> InAnyShelleyBasedEra Tx
unCddlTx CddlTx
cddlTx
      Either (FileError TextEnvelopeCddlError) (InAnyShelleyBasedEra Tx)
-> IO
     (Either
        (FileError TextEnvelopeCddlError) (InAnyShelleyBasedEra Tx))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (FileError TextEnvelopeCddlError) (InAnyShelleyBasedEra Tx)
 -> IO
      (Either
         (FileError TextEnvelopeCddlError) (InAnyShelleyBasedEra Tx)))
-> Either
     (FileError TextEnvelopeCddlError) (InAnyShelleyBasedEra Tx)
-> IO
     (Either
        (FileError TextEnvelopeCddlError) (InAnyShelleyBasedEra Tx))
forall a b. (a -> b) -> a -> b
$ InAnyShelleyBasedEra Tx
-> Either
     (FileError TextEnvelopeCddlError) (InAnyShelleyBasedEra Tx)
forall a b. b -> Either a b
Right (InAnyShelleyBasedEra Tx
 -> Either
      (FileError TextEnvelopeCddlError) (InAnyShelleyBasedEra Tx))
-> InAnyShelleyBasedEra Tx
-> Either
     (FileError TextEnvelopeCddlError) (InAnyShelleyBasedEra Tx)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era -> Tx era -> InAnyShelleyBasedEra Tx
forall era (thing :: * -> *).
ShelleyBasedEra era -> thing era -> InAnyShelleyBasedEra thing
inAnyShelleyBasedEra ShelleyBasedEra era
sbe Tx era
tx

newtype IncompleteCddlTxBody
  = IncompleteCddlTxBody {IncompleteCddlTxBody -> InAnyShelleyBasedEra TxBody
unIncompleteCddlTxBody :: InAnyShelleyBasedEra TxBody}

readFileTxBody :: FileOrPipe -> IO (Either (FileError TextEnvelopeCddlError) IncompleteCddlTxBody)
readFileTxBody :: FileOrPipe
-> IO
     (Either (FileError TextEnvelopeCddlError) IncompleteCddlTxBody)
readFileTxBody FileOrPipe
file = do
  Either (FileError TextEnvelopeCddlError) CddlTx
cddlTxOrErr <- FileOrPipe -> IO (Either (FileError TextEnvelopeCddlError) CddlTx)
readCddlTx FileOrPipe
file
  case Either (FileError TextEnvelopeCddlError) CddlTx
cddlTxOrErr of
    Left FileError TextEnvelopeCddlError
e -> Either (FileError TextEnvelopeCddlError) IncompleteCddlTxBody
-> IO
     (Either (FileError TextEnvelopeCddlError) IncompleteCddlTxBody)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (FileError TextEnvelopeCddlError) IncompleteCddlTxBody
 -> IO
      (Either (FileError TextEnvelopeCddlError) IncompleteCddlTxBody))
-> Either (FileError TextEnvelopeCddlError) IncompleteCddlTxBody
-> IO
     (Either (FileError TextEnvelopeCddlError) IncompleteCddlTxBody)
forall a b. (a -> b) -> a -> b
$ FileError TextEnvelopeCddlError
-> Either (FileError TextEnvelopeCddlError) IncompleteCddlTxBody
forall a b. a -> Either a b
Left FileError TextEnvelopeCddlError
e
    Right CddlTx
cddlTx -> do
      InAnyShelleyBasedEra ShelleyBasedEra era
sbe Tx era
tx <- InAnyShelleyBasedEra Tx -> IO (InAnyShelleyBasedEra Tx)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InAnyShelleyBasedEra Tx -> IO (InAnyShelleyBasedEra Tx))
-> InAnyShelleyBasedEra Tx -> IO (InAnyShelleyBasedEra Tx)
forall a b. (a -> b) -> a -> b
$ CddlTx -> InAnyShelleyBasedEra Tx
unCddlTx CddlTx
cddlTx
      Either (FileError TextEnvelopeCddlError) IncompleteCddlTxBody
-> IO
     (Either (FileError TextEnvelopeCddlError) IncompleteCddlTxBody)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (FileError TextEnvelopeCddlError) IncompleteCddlTxBody
 -> IO
      (Either (FileError TextEnvelopeCddlError) IncompleteCddlTxBody))
-> Either (FileError TextEnvelopeCddlError) IncompleteCddlTxBody
-> IO
     (Either (FileError TextEnvelopeCddlError) IncompleteCddlTxBody)
forall a b. (a -> b) -> a -> b
$ IncompleteCddlTxBody
-> Either (FileError TextEnvelopeCddlError) IncompleteCddlTxBody
forall a b. b -> Either a b
Right (IncompleteCddlTxBody
 -> Either (FileError TextEnvelopeCddlError) IncompleteCddlTxBody)
-> IncompleteCddlTxBody
-> Either (FileError TextEnvelopeCddlError) IncompleteCddlTxBody
forall a b. (a -> b) -> a -> b
$ InAnyShelleyBasedEra TxBody -> IncompleteCddlTxBody
IncompleteCddlTxBody (InAnyShelleyBasedEra TxBody -> IncompleteCddlTxBody)
-> InAnyShelleyBasedEra TxBody -> IncompleteCddlTxBody
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era -> TxBody era -> InAnyShelleyBasedEra TxBody
forall era (thing :: * -> *).
ShelleyBasedEra era -> thing era -> InAnyShelleyBasedEra thing
inAnyShelleyBasedEra ShelleyBasedEra era
sbe (TxBody era -> InAnyShelleyBasedEra TxBody)
-> TxBody era -> InAnyShelleyBasedEra TxBody
forall a b. (a -> b) -> a -> b
$ Tx era -> TxBody era
forall era. Tx era -> TxBody era
getTxBody Tx era
tx

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

instance Error CddlError where
  prettyError :: forall ann. CddlError -> Doc ann
prettyError = \case
    CddlErrorTextEnv FileError TextEnvelopeError
textEnvErr FileError TextEnvelopeCddlError
cddlErr ->
      Doc ann
"Failed to decode the ledger's CDDL serialisation format. "
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"TextEnvelope error: "
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> FileError TextEnvelopeError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError TextEnvelopeError -> Doc ann
prettyError FileError TextEnvelopeError
textEnvErr
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"\n"
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"TextEnvelopeCddl error: "
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> FileError TextEnvelopeCddlError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError TextEnvelopeCddlError -> Doc ann
prettyError FileError TextEnvelopeCddlError
cddlErr
    CddlIOError FileError TextEnvelopeError
e ->
      FileError TextEnvelopeError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError TextEnvelopeError -> Doc ann
prettyError FileError TextEnvelopeError
e

readCddlTx :: FileOrPipe -> IO (Either (FileError TextEnvelopeCddlError) CddlTx)
readCddlTx :: FileOrPipe -> IO (Either (FileError TextEnvelopeCddlError) CddlTx)
readCddlTx =
  [FromSomeTypeCDDL TextEnvelope CddlTx]
-> FileOrPipe
-> IO (Either (FileError TextEnvelopeCddlError) CddlTx)
forall b.
[FromSomeTypeCDDL TextEnvelope b]
-> FileOrPipe -> IO (Either (FileError TextEnvelopeCddlError) b)
readFileOrPipeTextEnvelopeCddlAnyOf ([FromSomeTypeCDDL TextEnvelope CddlTx]
 -> FileOrPipe
 -> IO (Either (FileError TextEnvelopeCddlError) CddlTx))
-> [FromSomeTypeCDDL TextEnvelope CddlTx]
-> FileOrPipe
-> IO (Either (FileError TextEnvelopeCddlError) CddlTx)
forall a b. (a -> b) -> a -> b
$
    (Text -> FromSomeTypeCDDL TextEnvelope CddlTx)
-> [Text] -> [FromSomeTypeCDDL TextEnvelope CddlTx]
forall a b. (a -> b) -> [a] -> [b]
map (Text
-> (InAnyShelleyBasedEra Tx -> CddlTx)
-> FromSomeTypeCDDL TextEnvelope CddlTx
forall b.
Text
-> (InAnyShelleyBasedEra Tx -> b)
-> FromSomeTypeCDDL TextEnvelope b
`FromCDDLTx` InAnyShelleyBasedEra Tx -> CddlTx
CddlTx) [Text]
txTextEnvelopeTypes

txTextEnvelopeTypes :: [Text]
txTextEnvelopeTypes :: [Text]
txTextEnvelopeTypes =
  [ let TextEnvelopeType String
d = ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => TextEnvelopeType)
-> TextEnvelopeType
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => TextEnvelopeType)
 -> TextEnvelopeType)
-> (ShelleyBasedEraConstraints era => TextEnvelopeType)
-> TextEnvelopeType
forall a b. (a -> b) -> a -> b
$ AsType (Tx era) -> TextEnvelopeType
forall a. HasTextEnvelope a => AsType a -> TextEnvelopeType
textEnvelopeType (Proxy (Tx era) -> AsType (Tx era)
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType (ShelleyBasedEra era -> Proxy (Tx era)
forall era. ShelleyBasedEra era -> Proxy (Tx era)
makeTxProxy ShelleyBasedEra era
sbe))
     in String -> Text
T.pack String
d
  | AnyShelleyBasedEra ShelleyBasedEra era
sbe <- [AnyShelleyBasedEra
forall a. Bounded a => a
minBound .. AnyShelleyBasedEra
forall a. Bounded a => a
maxBound]
  ]
 where
  makeTxProxy :: ShelleyBasedEra era -> Proxy (Tx era)
  makeTxProxy :: forall era. ShelleyBasedEra era -> Proxy (Tx era)
makeTxProxy ShelleyBasedEra era
_ = Proxy (Tx era)
forall {k} (t :: k). Proxy t
Proxy

-- Tx witnesses

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

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

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

instance Error CddlWitnessError where
  prettyError :: forall ann. CddlWitnessError -> Doc ann
prettyError = \case
    CddlWitnessErrorTextEnv FileError TextEnvelopeError
teErr FileError TextEnvelopeCddlError
cddlErr ->
      Doc ann
"Failed to decode the ledger's CDDL serialisation format. TextEnvelope error: "
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> FileError TextEnvelopeError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError TextEnvelopeError -> Doc ann
prettyError FileError TextEnvelopeError
teErr
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"\n"
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"TextEnvelopeCddl error: "
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> FileError TextEnvelopeCddlError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError TextEnvelopeCddlError -> Doc ann
prettyError FileError TextEnvelopeCddlError
cddlErr
    CddlWitnessIOError FileError TextEnvelopeError
fileE ->
      FileError TextEnvelopeError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError TextEnvelopeError -> Doc ann
prettyError 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
_)) ->
      (FileError TextEnvelopeCddlError -> CddlWitnessError)
-> Either (FileError TextEnvelopeCddlError) CddlWitness
-> Either CddlWitnessError CddlWitness
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (FileError TextEnvelopeError
-> FileError TextEnvelopeCddlError -> CddlWitnessError
CddlWitnessErrorTextEnv FileError TextEnvelopeError
e) (Either (FileError TextEnvelopeCddlError) CddlWitness
 -> Either CddlWitnessError CddlWitness)
-> IO (Either (FileError TextEnvelopeCddlError) CddlWitness)
-> IO (Either CddlWitnessError CddlWitness)
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
_)) ->
      (FileError TextEnvelopeCddlError -> CddlWitnessError)
-> Either (FileError TextEnvelopeCddlError) CddlWitness
-> Either CddlWitnessError CddlWitness
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (FileError TextEnvelopeError
-> FileError TextEnvelopeCddlError -> CddlWitnessError
CddlWitnessErrorTextEnv FileError TextEnvelopeError
e) (Either (FileError TextEnvelopeCddlError) CddlWitness
 -> Either CddlWitnessError CddlWitness)
-> IO (Either (FileError TextEnvelopeCddlError) CddlWitness)
-> IO (Either CddlWitnessError CddlWitness)
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
_)) ->
      (FileError TextEnvelopeCddlError -> CddlWitnessError)
-> Either (FileError TextEnvelopeCddlError) CddlWitness
-> Either CddlWitnessError CddlWitness
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (FileError TextEnvelopeError
-> FileError TextEnvelopeCddlError -> CddlWitnessError
CddlWitnessErrorTextEnv FileError TextEnvelopeError
e) (Either (FileError TextEnvelopeCddlError) CddlWitness
 -> Either CddlWitnessError CddlWitness)
-> IO (Either (FileError TextEnvelopeCddlError) CddlWitness)
-> IO (Either CddlWitnessError CddlWitness)
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{} -> Either CddlWitnessError CddlWitness
-> IO (Either CddlWitnessError CddlWitness)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CddlWitnessError CddlWitness
 -> IO (Either CddlWitnessError CddlWitness))
-> (CddlWitnessError -> Either CddlWitnessError CddlWitness)
-> CddlWitnessError
-> IO (Either CddlWitnessError CddlWitness)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CddlWitnessError -> Either CddlWitnessError CddlWitness
forall a b. a -> Either a b
Left (CddlWitnessError -> IO (Either CddlWitnessError CddlWitness))
-> CddlWitnessError -> IO (Either CddlWitnessError CddlWitness)
forall a b. (a -> b) -> a -> b
$ FileError TextEnvelopeError -> CddlWitnessError
CddlWitnessIOError FileError TextEnvelopeError
e
    e :: FileError TextEnvelopeError
e@FileDoesNotExistError{} -> Either CddlWitnessError CddlWitness
-> IO (Either CddlWitnessError CddlWitness)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CddlWitnessError CddlWitness
 -> IO (Either CddlWitnessError CddlWitness))
-> (CddlWitnessError -> Either CddlWitnessError CddlWitness)
-> CddlWitnessError
-> IO (Either CddlWitnessError CddlWitness)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CddlWitnessError -> Either CddlWitnessError CddlWitness
forall a b. a -> Either a b
Left (CddlWitnessError -> IO (Either CddlWitnessError CddlWitness))
-> CddlWitnessError -> IO (Either CddlWitnessError CddlWitness)
forall a b. (a -> b) -> a -> b
$ FileError TextEnvelopeError -> CddlWitnessError
CddlWitnessIOError FileError TextEnvelopeError
e
    e :: FileError TextEnvelopeError
e@FileIOError{} -> Either CddlWitnessError CddlWitness
-> IO (Either CddlWitnessError CddlWitness)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CddlWitnessError CddlWitness
 -> IO (Either CddlWitnessError CddlWitness))
-> (CddlWitnessError -> Either CddlWitnessError CddlWitness)
-> CddlWitnessError
-> IO (Either CddlWitnessError CddlWitness)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CddlWitnessError -> Either CddlWitnessError CddlWitness
forall a b. a -> Either a b
Left (CddlWitnessError -> IO (Either CddlWitnessError CddlWitness))
-> CddlWitnessError -> IO (Either CddlWitnessError CddlWitness)
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
  [FromSomeTypeCDDL TextEnvelope CddlWitness]
-> String
-> IO (Either (FileError TextEnvelopeCddlError) CddlWitness)
forall b.
[FromSomeTypeCDDL TextEnvelope b]
-> String -> IO (Either (FileError TextEnvelopeCddlError) b)
readFileTextEnvelopeCddlAnyOf ((Text -> FromSomeTypeCDDL TextEnvelope CddlWitness)
-> [Text] -> [FromSomeTypeCDDL TextEnvelope CddlWitness]
forall a b. (a -> b) -> [a] -> [b]
map (Text
-> (InAnyShelleyBasedEra KeyWitness -> CddlWitness)
-> FromSomeTypeCDDL TextEnvelope CddlWitness
forall b.
Text
-> (InAnyShelleyBasedEra KeyWitness -> b)
-> FromSomeTypeCDDL TextEnvelope b
`FromCDDLWitness` InAnyShelleyBasedEra KeyWitness -> CddlWitness
CddlWitness) [Text]
txWitnessTextEnvelopeTypes) String
fp

txWitnessTextEnvelopeTypes :: [Text]
txWitnessTextEnvelopeTypes :: [Text]
txWitnessTextEnvelopeTypes =
  [ let TextEnvelopeType String
d = ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => TextEnvelopeType)
-> TextEnvelopeType
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => TextEnvelopeType)
 -> TextEnvelopeType)
-> (ShelleyBasedEraConstraints era => TextEnvelopeType)
-> TextEnvelopeType
forall a b. (a -> b) -> a -> b
$ AsType (KeyWitness era) -> TextEnvelopeType
forall a. HasTextEnvelope a => AsType a -> TextEnvelopeType
textEnvelopeType (Proxy (KeyWitness era) -> AsType (KeyWitness era)
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType (ShelleyBasedEra era -> Proxy (KeyWitness era)
forall era. ShelleyBasedEra era -> Proxy (KeyWitness era)
makeWitnessProxy ShelleyBasedEra era
sbe))
     in String -> Text
T.pack String
d
  | AnyShelleyBasedEra ShelleyBasedEra era
sbe <- [AnyShelleyBasedEra
forall a. Bounded a => a
minBound .. AnyShelleyBasedEra
forall a. Bounded a => a
maxBound]
  ]
 where
  makeWitnessProxy :: ShelleyBasedEra era -> Proxy (KeyWitness era)
  makeWitnessProxy :: forall era. ShelleyBasedEra era -> Proxy (KeyWitness era)
makeWitnessProxy ShelleyBasedEra era
_ = Proxy (KeyWitness era)
forall {k} (t :: k). Proxy t
Proxy

-- Witness handling

data SomeSigningWitness
  = AByronSigningWitness (SigningKey ByronKey) (Maybe (Address ByronAddr))
  | APaymentSigningWitness (SigningKey PaymentKey)
  | APaymentExtendedSigningWitness (SigningKey PaymentExtendedKey)
  | AStakeSigningWitness (SigningKey StakeKey)
  | AStakeExtendedSigningWitness (SigningKey StakeExtendedKey)
  | AStakePoolSigningWitness (SigningKey StakePoolKey)
  | AGenesisSigningWitness (SigningKey GenesisKey)
  | AGenesisExtendedSigningWitness (SigningKey GenesisExtendedKey)
  | AGenesisDelegateSigningWitness (SigningKey GenesisDelegateKey)
  | AGenesisDelegateExtendedSigningWitness (SigningKey GenesisDelegateExtendedKey)
  | AGenesisUTxOSigningWitness (SigningKey GenesisUTxOKey)
  | ADRepSigningWitness (SigningKey DRepKey)
  | ADRepExtendedSigningWitness (SigningKey DRepExtendedKey)
  | ACommitteeColdSigningWitness (SigningKey CommitteeColdKey)
  | ACommitteeColdExtendedSigningWitness (SigningKey CommitteeColdExtendedKey)
  | ACommitteeHotSigningWitness (SigningKey CommitteeHotKey)
  | ACommitteeHotExtendedSigningWitness (SigningKey CommitteeHotExtendedKey)
  deriving Int -> SomeSigningWitness -> ShowS
[SomeSigningWitness] -> ShowS
SomeSigningWitness -> String
(Int -> SomeSigningWitness -> ShowS)
-> (SomeSigningWitness -> String)
-> ([SomeSigningWitness] -> ShowS)
-> Show SomeSigningWitness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SomeSigningWitness -> ShowS
showsPrec :: Int -> SomeSigningWitness -> ShowS
$cshow :: SomeSigningWitness -> String
show :: SomeSigningWitness -> String
$cshowList :: [SomeSigningWitness] -> ShowS
showList :: [SomeSigningWitness] -> ShowS
Show

-- | 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

categoriseSomeSigningWitness :: SomeSigningWitness -> ByronOrShelleyWitness
categoriseSomeSigningWitness :: SomeSigningWitness -> ByronOrShelleyWitness
categoriseSomeSigningWitness SomeSigningWitness
swsk =
  case SomeSigningWitness
swsk of
    AByronSigningWitness SigningKey ByronKey
sk Maybe (Address ByronAddr)
addr -> ShelleyBootstrapWitnessSigningKeyData -> ByronOrShelleyWitness
AByronWitness (SigningKey ByronKey
-> Maybe (Address ByronAddr)
-> ShelleyBootstrapWitnessSigningKeyData
ShelleyBootstrapWitnessSigningKeyData SigningKey ByronKey
sk Maybe (Address ByronAddr)
addr)
    APaymentSigningWitness SigningKey PaymentKey
sk -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey PaymentKey -> ShelleyWitnessSigningKey
WitnessPaymentKey SigningKey PaymentKey
sk)
    APaymentExtendedSigningWitness SigningKey PaymentExtendedKey
sk -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey PaymentExtendedKey -> ShelleyWitnessSigningKey
WitnessPaymentExtendedKey SigningKey PaymentExtendedKey
sk)
    AStakeSigningWitness SigningKey StakeKey
sk -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey StakeKey -> ShelleyWitnessSigningKey
WitnessStakeKey SigningKey StakeKey
sk)
    AStakeExtendedSigningWitness SigningKey StakeExtendedKey
sk -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey StakeExtendedKey -> ShelleyWitnessSigningKey
WitnessStakeExtendedKey SigningKey StakeExtendedKey
sk)
    AStakePoolSigningWitness SigningKey StakePoolKey
sk -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey StakePoolKey -> ShelleyWitnessSigningKey
WitnessStakePoolKey SigningKey StakePoolKey
sk)
    AGenesisSigningWitness SigningKey GenesisKey
sk -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey GenesisKey -> ShelleyWitnessSigningKey
WitnessGenesisKey SigningKey GenesisKey
sk)
    AGenesisExtendedSigningWitness SigningKey GenesisExtendedKey
sk -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey GenesisExtendedKey -> ShelleyWitnessSigningKey
WitnessGenesisExtendedKey SigningKey GenesisExtendedKey
sk)
    AGenesisDelegateSigningWitness SigningKey GenesisDelegateKey
sk -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey GenesisDelegateKey -> ShelleyWitnessSigningKey
WitnessGenesisDelegateKey SigningKey GenesisDelegateKey
sk)
    AGenesisDelegateExtendedSigningWitness SigningKey GenesisDelegateExtendedKey
sk -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey GenesisDelegateExtendedKey -> ShelleyWitnessSigningKey
WitnessGenesisDelegateExtendedKey SigningKey GenesisDelegateExtendedKey
sk)
    AGenesisUTxOSigningWitness SigningKey GenesisUTxOKey
sk -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey GenesisUTxOKey -> ShelleyWitnessSigningKey
WitnessGenesisUTxOKey SigningKey GenesisUTxOKey
sk)
    ADRepSigningWitness SigningKey DRepKey
sk -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey DRepKey -> ShelleyWitnessSigningKey
WitnessDRepKey SigningKey DRepKey
sk)
    ADRepExtendedSigningWitness SigningKey DRepExtendedKey
sk -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey DRepExtendedKey -> ShelleyWitnessSigningKey
WitnessDRepExtendedKey SigningKey DRepExtendedKey
sk)
    ACommitteeColdSigningWitness SigningKey CommitteeColdKey
sk -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey CommitteeColdKey -> ShelleyWitnessSigningKey
WitnessCommitteeColdKey SigningKey CommitteeColdKey
sk)
    ACommitteeColdExtendedSigningWitness SigningKey CommitteeColdExtendedKey
sk -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey CommitteeColdExtendedKey -> ShelleyWitnessSigningKey
WitnessCommitteeColdExtendedKey SigningKey CommitteeColdExtendedKey
sk)
    ACommitteeHotSigningWitness SigningKey CommitteeHotKey
sk -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey CommitteeHotKey -> ShelleyWitnessSigningKey
WitnessCommitteeHotKey SigningKey CommitteeHotKey
sk)
    ACommitteeHotExtendedSigningWitness SigningKey CommitteeHotExtendedKey
sk -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey CommitteeHotExtendedKey -> ShelleyWitnessSigningKey
WitnessCommitteeHotExtendedKey SigningKey CommitteeHotExtendedKey
sk)

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

-- | Render an error message for a 'ReadWitnessSigningDataError'.
renderReadWitnessSigningDataError :: ReadWitnessSigningDataError -> Doc ann
renderReadWitnessSigningDataError :: forall ann. ReadWitnessSigningDataError -> Doc ann
renderReadWitnessSigningDataError = \case
  ReadWitnessSigningDataSigningKeyDecodeError FileError InputDecodeError
fileErr ->
    Doc ann
"Error reading signing key: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> FileError InputDecodeError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError InputDecodeError -> Doc ann
prettyError FileError InputDecodeError
fileErr
  ReadWitnessSigningDataScriptError FileError JsonDecodeError
fileErr ->
    Doc ann
"Error reading script: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> FileError JsonDecodeError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError JsonDecodeError -> Doc ann
prettyError FileError JsonDecodeError
fileErr
  ReadWitnessSigningDataError
ReadWitnessSigningDataSigningKeyAndAddressMismatch ->
    Doc ann
"Only a Byron signing key may be accompanied by a Byron address."

readWitnessSigningData
  :: WitnessSigningData
  -> IO (Either ReadWitnessSigningDataError SomeSigningWitness)
readWitnessSigningData :: WitnessSigningData
-> IO (Either ReadWitnessSigningDataError SomeSigningWitness)
readWitnessSigningData (KeyWitnessSigningData SigningKeyFile 'In
skFile Maybe (Address ByronAddr)
mbByronAddr) = do
  Either ReadWitnessSigningDataError SomeSigningWitness
eRes <-
    (FileError InputDecodeError -> ReadWitnessSigningDataError)
-> Either (FileError InputDecodeError) SomeSigningWitness
-> Either ReadWitnessSigningDataError SomeSigningWitness
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first FileError InputDecodeError -> ReadWitnessSigningDataError
ReadWitnessSigningDataSigningKeyDecodeError
      (Either (FileError InputDecodeError) SomeSigningWitness
 -> Either ReadWitnessSigningDataError SomeSigningWitness)
-> IO (Either (FileError InputDecodeError) SomeSigningWitness)
-> IO (Either ReadWitnessSigningDataError SomeSigningWitness)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FromSomeType SerialiseAsBech32 SomeSigningWitness]
-> [FromSomeType HasTextEnvelope SomeSigningWitness]
-> SigningKeyFile 'In
-> IO (Either (FileError InputDecodeError) SomeSigningWitness)
forall content b.
[FromSomeType SerialiseAsBech32 b]
-> [FromSomeType HasTextEnvelope b]
-> File content 'In
-> IO (Either (FileError InputDecodeError) b)
readKeyFileAnyOf [FromSomeType SerialiseAsBech32 SomeSigningWitness]
bech32FileTypes [FromSomeType HasTextEnvelope SomeSigningWitness]
textEnvFileTypes SigningKeyFile 'In
skFile
  Either ReadWitnessSigningDataError SomeSigningWitness
-> IO (Either ReadWitnessSigningDataError SomeSigningWitness)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ReadWitnessSigningDataError SomeSigningWitness
 -> IO (Either ReadWitnessSigningDataError SomeSigningWitness))
-> Either ReadWitnessSigningDataError SomeSigningWitness
-> IO (Either ReadWitnessSigningDataError SomeSigningWitness)
forall a b. (a -> b) -> a -> b
$ do
    SomeSigningWitness
res <- Either ReadWitnessSigningDataError SomeSigningWitness
eRes
    case (SomeSigningWitness
res, Maybe (Address ByronAddr)
mbByronAddr) of
      (AByronSigningWitness SigningKey ByronKey
_ Maybe (Address ByronAddr)
_, Just Address ByronAddr
_) -> SomeSigningWitness
-> Either ReadWitnessSigningDataError SomeSigningWitness
forall a. a -> Either ReadWitnessSigningDataError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SomeSigningWitness
res
      (AByronSigningWitness SigningKey ByronKey
_ Maybe (Address ByronAddr)
_, Maybe (Address ByronAddr)
Nothing) -> SomeSigningWitness
-> Either ReadWitnessSigningDataError SomeSigningWitness
forall a. a -> Either ReadWitnessSigningDataError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SomeSigningWitness
res
      (SomeSigningWitness
_, Maybe (Address ByronAddr)
Nothing) -> SomeSigningWitness
-> Either ReadWitnessSigningDataError SomeSigningWitness
forall a. a -> Either ReadWitnessSigningDataError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SomeSigningWitness
res
      (SomeSigningWitness
_, Just Address ByronAddr
_) ->
        -- A Byron address should only be specified along with a Byron signing key.
        ReadWitnessSigningDataError
-> Either ReadWitnessSigningDataError SomeSigningWitness
forall a b. a -> Either a b
Left ReadWitnessSigningDataError
ReadWitnessSigningDataSigningKeyAndAddressMismatch
 where
  -- If you update these variables, consider updating the ones with the same
  -- names in Cardano.CLI.Types.Key
  textEnvFileTypes :: [FromSomeType HasTextEnvelope SomeSigningWitness]
textEnvFileTypes =
    [ AsType (SigningKey ByronKey)
-> (SigningKey ByronKey -> SomeSigningWitness)
-> FromSomeType HasTextEnvelope SomeSigningWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType ByronKey -> AsType (SigningKey ByronKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType ByronKey
AsByronKey) (SigningKey ByronKey
-> Maybe (Address ByronAddr) -> SomeSigningWitness
`AByronSigningWitness` Maybe (Address ByronAddr)
mbByronAddr)
    , AsType (SigningKey PaymentKey)
-> (SigningKey PaymentKey -> SomeSigningWitness)
-> FromSomeType HasTextEnvelope SomeSigningWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType PaymentKey -> AsType (SigningKey PaymentKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType PaymentKey
AsPaymentKey) SigningKey PaymentKey -> SomeSigningWitness
APaymentSigningWitness
    , AsType (SigningKey PaymentExtendedKey)
-> (SigningKey PaymentExtendedKey -> SomeSigningWitness)
-> FromSomeType HasTextEnvelope SomeSigningWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType PaymentExtendedKey -> AsType (SigningKey PaymentExtendedKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType PaymentExtendedKey
AsPaymentExtendedKey) SigningKey PaymentExtendedKey -> SomeSigningWitness
APaymentExtendedSigningWitness
    , AsType (SigningKey StakeKey)
-> (SigningKey StakeKey -> SomeSigningWitness)
-> FromSomeType HasTextEnvelope SomeSigningWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType StakeKey -> AsType (SigningKey StakeKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakeKey
AsStakeKey) SigningKey StakeKey -> SomeSigningWitness
AStakeSigningWitness
    , AsType (SigningKey StakeExtendedKey)
-> (SigningKey StakeExtendedKey -> SomeSigningWitness)
-> FromSomeType HasTextEnvelope SomeSigningWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType StakeExtendedKey -> AsType (SigningKey StakeExtendedKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakeExtendedKey
AsStakeExtendedKey) SigningKey StakeExtendedKey -> SomeSigningWitness
AStakeExtendedSigningWitness
    , AsType (SigningKey StakePoolKey)
-> (SigningKey StakePoolKey -> SomeSigningWitness)
-> FromSomeType HasTextEnvelope SomeSigningWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType StakePoolKey -> AsType (SigningKey StakePoolKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakePoolKey
AsStakePoolKey) SigningKey StakePoolKey -> SomeSigningWitness
AStakePoolSigningWitness
    , AsType (SigningKey GenesisKey)
-> (SigningKey GenesisKey -> SomeSigningWitness)
-> FromSomeType HasTextEnvelope SomeSigningWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType GenesisKey -> AsType (SigningKey GenesisKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisKey
AsGenesisKey) SigningKey GenesisKey -> SomeSigningWitness
AGenesisSigningWitness
    , AsType (SigningKey GenesisExtendedKey)
-> (SigningKey GenesisExtendedKey -> SomeSigningWitness)
-> FromSomeType HasTextEnvelope SomeSigningWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType GenesisExtendedKey -> AsType (SigningKey GenesisExtendedKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisExtendedKey
AsGenesisExtendedKey) SigningKey GenesisExtendedKey -> SomeSigningWitness
AGenesisExtendedSigningWitness
    , AsType (SigningKey GenesisDelegateKey)
-> (SigningKey GenesisDelegateKey -> SomeSigningWitness)
-> FromSomeType HasTextEnvelope SomeSigningWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType GenesisDelegateKey -> AsType (SigningKey GenesisDelegateKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisDelegateKey
AsGenesisDelegateKey) SigningKey GenesisDelegateKey -> SomeSigningWitness
AGenesisDelegateSigningWitness
    , AsType (SigningKey GenesisDelegateExtendedKey)
-> (SigningKey GenesisDelegateExtendedKey -> SomeSigningWitness)
-> FromSomeType HasTextEnvelope SomeSigningWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType GenesisDelegateExtendedKey
-> AsType (SigningKey GenesisDelegateExtendedKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisDelegateExtendedKey
AsGenesisDelegateExtendedKey) SigningKey GenesisDelegateExtendedKey -> SomeSigningWitness
AGenesisDelegateExtendedSigningWitness
    , AsType (SigningKey GenesisUTxOKey)
-> (SigningKey GenesisUTxOKey -> SomeSigningWitness)
-> FromSomeType HasTextEnvelope SomeSigningWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType GenesisUTxOKey -> AsType (SigningKey GenesisUTxOKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisUTxOKey
AsGenesisUTxOKey) SigningKey GenesisUTxOKey -> SomeSigningWitness
AGenesisUTxOSigningWitness
    , AsType (SigningKey DRepKey)
-> (SigningKey DRepKey -> SomeSigningWitness)
-> FromSomeType HasTextEnvelope SomeSigningWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType DRepKey -> AsType (SigningKey DRepKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType DRepKey
AsDRepKey) SigningKey DRepKey -> SomeSigningWitness
ADRepSigningWitness
    , AsType (SigningKey DRepExtendedKey)
-> (SigningKey DRepExtendedKey -> SomeSigningWitness)
-> FromSomeType HasTextEnvelope SomeSigningWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType DRepExtendedKey -> AsType (SigningKey DRepExtendedKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType DRepExtendedKey
AsDRepExtendedKey) SigningKey DRepExtendedKey -> SomeSigningWitness
ADRepExtendedSigningWitness
    , AsType (SigningKey CommitteeColdKey)
-> (SigningKey CommitteeColdKey -> SomeSigningWitness)
-> FromSomeType HasTextEnvelope SomeSigningWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType CommitteeColdKey -> AsType (SigningKey CommitteeColdKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType CommitteeColdKey
AsCommitteeColdKey) SigningKey CommitteeColdKey -> SomeSigningWitness
ACommitteeColdSigningWitness
    , AsType (SigningKey CommitteeColdExtendedKey)
-> (SigningKey CommitteeColdExtendedKey -> SomeSigningWitness)
-> FromSomeType HasTextEnvelope SomeSigningWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType CommitteeColdExtendedKey
-> AsType (SigningKey CommitteeColdExtendedKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType CommitteeColdExtendedKey
AsCommitteeColdExtendedKey) SigningKey CommitteeColdExtendedKey -> SomeSigningWitness
ACommitteeColdExtendedSigningWitness
    , AsType (SigningKey CommitteeHotKey)
-> (SigningKey CommitteeHotKey -> SomeSigningWitness)
-> FromSomeType HasTextEnvelope SomeSigningWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType CommitteeHotKey -> AsType (SigningKey CommitteeHotKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType CommitteeHotKey
AsCommitteeHotKey) SigningKey CommitteeHotKey -> SomeSigningWitness
ACommitteeHotSigningWitness
    , AsType (SigningKey CommitteeHotExtendedKey)
-> (SigningKey CommitteeHotExtendedKey -> SomeSigningWitness)
-> FromSomeType HasTextEnvelope SomeSigningWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType CommitteeHotExtendedKey
-> AsType (SigningKey CommitteeHotExtendedKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType CommitteeHotExtendedKey
AsCommitteeHotExtendedKey) SigningKey CommitteeHotExtendedKey -> SomeSigningWitness
ACommitteeHotExtendedSigningWitness
    ]

  bech32FileTypes :: [FromSomeType SerialiseAsBech32 SomeSigningWitness]
bech32FileTypes =
    [ AsType (SigningKey PaymentKey)
-> (SigningKey PaymentKey -> SomeSigningWitness)
-> FromSomeType SerialiseAsBech32 SomeSigningWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType PaymentKey -> AsType (SigningKey PaymentKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType PaymentKey
AsPaymentKey) SigningKey PaymentKey -> SomeSigningWitness
APaymentSigningWitness
    , AsType (SigningKey PaymentExtendedKey)
-> (SigningKey PaymentExtendedKey -> SomeSigningWitness)
-> FromSomeType SerialiseAsBech32 SomeSigningWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType PaymentExtendedKey -> AsType (SigningKey PaymentExtendedKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType PaymentExtendedKey
AsPaymentExtendedKey) SigningKey PaymentExtendedKey -> SomeSigningWitness
APaymentExtendedSigningWitness
    , AsType (SigningKey StakeKey)
-> (SigningKey StakeKey -> SomeSigningWitness)
-> FromSomeType SerialiseAsBech32 SomeSigningWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType StakeKey -> AsType (SigningKey StakeKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakeKey
AsStakeKey) SigningKey StakeKey -> SomeSigningWitness
AStakeSigningWitness
    , AsType (SigningKey StakeExtendedKey)
-> (SigningKey StakeExtendedKey -> SomeSigningWitness)
-> FromSomeType SerialiseAsBech32 SomeSigningWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType StakeExtendedKey -> AsType (SigningKey StakeExtendedKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakeExtendedKey
AsStakeExtendedKey) SigningKey StakeExtendedKey -> SomeSigningWitness
AStakeExtendedSigningWitness
    , AsType (SigningKey StakePoolKey)
-> (SigningKey StakePoolKey -> SomeSigningWitness)
-> FromSomeType SerialiseAsBech32 SomeSigningWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType StakePoolKey -> AsType (SigningKey StakePoolKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakePoolKey
AsStakePoolKey) SigningKey StakePoolKey -> SomeSigningWitness
AStakePoolSigningWitness
    ]

-- Required signers

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

instance Error RequiredSignerError where
  prettyError :: forall ann. RequiredSignerError -> Doc ann
prettyError = \case
    RequiredSignerErrorFile FileError InputDecodeError
e ->
      FileError InputDecodeError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError InputDecodeError -> Doc ann
prettyError FileError InputDecodeError
e
    RequiredSignerErrorByronKey (File String
byronSkeyfile) ->
      Doc ann
"Byron witnesses cannot be used for required signers: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
byronSkeyfile

readRequiredSigner :: RequiredSigner -> IO (Either RequiredSignerError (Hash PaymentKey))
readRequiredSigner :: RequiredSigner -> IO (Either RequiredSignerError (Hash PaymentKey))
readRequiredSigner (RequiredSignerHash Hash PaymentKey
h) = Either RequiredSignerError (Hash PaymentKey)
-> IO (Either RequiredSignerError (Hash PaymentKey))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either RequiredSignerError (Hash PaymentKey)
 -> IO (Either RequiredSignerError (Hash PaymentKey)))
-> Either RequiredSignerError (Hash PaymentKey)
-> IO (Either RequiredSignerError (Hash PaymentKey))
forall a b. (a -> b) -> a -> b
$ Hash PaymentKey -> Either RequiredSignerError (Hash PaymentKey)
forall a b. b -> Either a b
Right Hash PaymentKey
h
readRequiredSigner (RequiredSignerSkeyFile SigningKeyFile 'In
skFile) = do
  Either RequiredSignerError SomeSigningWitness
eKeyWit <-
    (FileError InputDecodeError -> RequiredSignerError)
-> Either (FileError InputDecodeError) SomeSigningWitness
-> Either RequiredSignerError SomeSigningWitness
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first FileError InputDecodeError -> RequiredSignerError
RequiredSignerErrorFile (Either (FileError InputDecodeError) SomeSigningWitness
 -> Either RequiredSignerError SomeSigningWitness)
-> IO (Either (FileError InputDecodeError) SomeSigningWitness)
-> IO (Either RequiredSignerError SomeSigningWitness)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FromSomeType SerialiseAsBech32 SomeSigningWitness]
-> [FromSomeType HasTextEnvelope SomeSigningWitness]
-> SigningKeyFile 'In
-> IO (Either (FileError InputDecodeError) SomeSigningWitness)
forall content b.
[FromSomeType SerialiseAsBech32 b]
-> [FromSomeType HasTextEnvelope b]
-> File content 'In
-> IO (Either (FileError InputDecodeError) b)
readKeyFileAnyOf [FromSomeType SerialiseAsBech32 SomeSigningWitness]
forall {a}. [a]
bech32FileTypes [FromSomeType HasTextEnvelope SomeSigningWitness]
textEnvFileTypes SigningKeyFile 'In
skFile
  Either RequiredSignerError (Hash PaymentKey)
-> IO (Either RequiredSignerError (Hash PaymentKey))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either RequiredSignerError (Hash PaymentKey)
 -> IO (Either RequiredSignerError (Hash PaymentKey)))
-> Either RequiredSignerError (Hash PaymentKey)
-> IO (Either RequiredSignerError (Hash PaymentKey))
forall a b. (a -> b) -> a -> b
$ do
    SomeSigningWitness
keyWit <- Either RequiredSignerError SomeSigningWitness
eKeyWit
    case SomeSigningWitness -> ByronOrShelleyWitness
categoriseSomeSigningWitness SomeSigningWitness
keyWit of
      AByronWitness ShelleyBootstrapWitnessSigningKeyData
_ ->
        RequiredSignerError -> Either RequiredSignerError (Hash PaymentKey)
forall a b. a -> Either a b
Left (RequiredSignerError
 -> Either RequiredSignerError (Hash PaymentKey))
-> RequiredSignerError
-> Either RequiredSignerError (Hash PaymentKey)
forall a b. (a -> b) -> a -> b
$ SigningKeyFile 'In -> RequiredSignerError
RequiredSignerErrorByronKey SigningKeyFile 'In
skFile
      AShelleyKeyWitness ShelleyWitnessSigningKey
skey ->
        Hash PaymentKey -> Either RequiredSignerError (Hash PaymentKey)
forall a. a -> Either RequiredSignerError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Hash PaymentKey -> Either RequiredSignerError (Hash PaymentKey))
-> (ShelleySigningKey -> Hash PaymentKey)
-> ShelleySigningKey
-> Either RequiredSignerError (Hash PaymentKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleySigningKey -> Hash PaymentKey
getHash (ShelleySigningKey -> Either RequiredSignerError (Hash PaymentKey))
-> ShelleySigningKey
-> Either RequiredSignerError (Hash PaymentKey)
forall a b. (a -> b) -> a -> b
$ ShelleyWitnessSigningKey -> ShelleySigningKey
toShelleySigningKey ShelleyWitnessSigningKey
skey
 where
  textEnvFileTypes :: [FromSomeType HasTextEnvelope SomeSigningWitness]
textEnvFileTypes =
    [ AsType (SigningKey PaymentKey)
-> (SigningKey PaymentKey -> SomeSigningWitness)
-> FromSomeType HasTextEnvelope SomeSigningWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType PaymentKey -> AsType (SigningKey PaymentKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType PaymentKey
AsPaymentKey) SigningKey PaymentKey -> SomeSigningWitness
APaymentSigningWitness
    , AsType (SigningKey PaymentExtendedKey)
-> (SigningKey PaymentExtendedKey -> SomeSigningWitness)
-> FromSomeType HasTextEnvelope SomeSigningWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType PaymentExtendedKey -> AsType (SigningKey PaymentExtendedKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType PaymentExtendedKey
AsPaymentExtendedKey) SigningKey PaymentExtendedKey -> SomeSigningWitness
APaymentExtendedSigningWitness
    , AsType (SigningKey StakePoolKey)
-> (SigningKey StakePoolKey -> SomeSigningWitness)
-> FromSomeType HasTextEnvelope SomeSigningWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType StakePoolKey -> AsType (SigningKey StakePoolKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakePoolKey
AsStakePoolKey) SigningKey StakePoolKey -> SomeSigningWitness
AStakePoolSigningWitness
    , AsType (SigningKey GenesisDelegateKey)
-> (SigningKey GenesisDelegateKey -> SomeSigningWitness)
-> FromSomeType HasTextEnvelope SomeSigningWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType GenesisDelegateKey -> AsType (SigningKey GenesisDelegateKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisDelegateKey
AsGenesisDelegateKey) SigningKey GenesisDelegateKey -> SomeSigningWitness
AGenesisDelegateSigningWitness
    ]
  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 = VerificationKey PaymentExtendedKey -> VerificationKey PaymentKey
forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey (VerificationKey PaymentExtendedKey -> VerificationKey PaymentKey)
-> VerificationKey PaymentExtendedKey -> VerificationKey PaymentKey
forall a b. (a -> b) -> a -> b
$ SigningKey PaymentExtendedKey -> VerificationKey PaymentExtendedKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey PaymentExtendedKey
extSKey
     in VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey PaymentKey
payVKey
  getHash (ShelleyNormalSigningKey SignKeyDSIGN StandardCrypto
sk) =
    VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash (VerificationKey PaymentKey -> Hash PaymentKey)
-> (SigningKey PaymentKey -> VerificationKey PaymentKey)
-> SigningKey PaymentKey
-> Hash PaymentKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigningKey PaymentKey -> VerificationKey PaymentKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey (SigningKey PaymentKey -> Hash PaymentKey)
-> SigningKey PaymentKey -> Hash PaymentKey
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN StandardCrypto -> SigningKey PaymentKey
PaymentSigningKey SignKeyDSIGN StandardCrypto
sk

data VoteError
  = VoteErrorFile (FileError TextEnvelopeError)
  | VoteErrorTextNotUnicode Text.UnicodeException
  | VoteErrorScriptWitness ScriptWitnessError
  deriving Int -> VoteError -> ShowS
[VoteError] -> ShowS
VoteError -> String
(Int -> VoteError -> ShowS)
-> (VoteError -> String)
-> ([VoteError] -> ShowS)
-> Show VoteError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VoteError -> ShowS
showsPrec :: Int -> VoteError -> ShowS
$cshow :: VoteError -> String
show :: VoteError -> String
$cshowList :: [VoteError] -> ShowS
showList :: [VoteError] -> ShowS
Show

instance Error VoteError where
  prettyError :: forall ann. VoteError -> Doc ann
prettyError = \case
    VoteErrorFile FileError TextEnvelopeError
e ->
      FileError TextEnvelopeError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError TextEnvelopeError -> Doc ann
prettyError FileError TextEnvelopeError
e
    VoteErrorTextNotUnicode UnicodeException
e ->
      Doc ann
"Vote text file not UTF8-encoded: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (UnicodeException -> String
forall e. Exception e => e -> String
displayException UnicodeException
e)
    VoteErrorScriptWitness ScriptWitnessError
e ->
      ScriptWitnessError -> Doc ann
forall ann. ScriptWitnessError -> Doc ann
renderScriptWitnessError ScriptWitnessError
e

readVotingProceduresFiles
  :: ConwayEraOnwards era
  -> [(VoteFile In, Maybe (ScriptWitnessFiles WitCtxStake))]
  -> IO (Either VoteError [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))])
readVotingProceduresFiles :: forall era.
ConwayEraOnwards era
-> [(VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
-> IO
     (Either
        VoteError
        [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))])
readVotingProceduresFiles ConwayEraOnwards era
w = \case
  [] -> Either
  VoteError
  [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))]
-> IO
     (Either
        VoteError
        [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   VoteError
   [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))]
 -> IO
      (Either
         VoteError
         [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))]))
-> Either
     VoteError
     [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))]
-> IO
     (Either
        VoteError
        [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))])
forall a b. (a -> b) -> a -> b
$ [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))]
-> Either
     VoteError
     [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))]
forall a. a -> Either VoteError a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  [(VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
files -> ExceptT
  VoteError
  IO
  [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))]
-> IO
     (Either
        VoteError
        [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   VoteError
   IO
   [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))]
 -> IO
      (Either
         VoteError
         [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))]))
-> ExceptT
     VoteError
     IO
     [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))]
-> IO
     (Either
        VoteError
        [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))])
forall a b. (a -> b) -> a -> b
$ [(VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
-> ((VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))
    -> ExceptT
         VoteError
         IO
         (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era)))
-> ExceptT
     VoteError
     IO
     [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
files (IO
  (Either
     VoteError
     (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era)))
-> ExceptT
     VoteError
     IO
     (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO
   (Either
      VoteError
      (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era)))
 -> ExceptT
      VoteError
      IO
      (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era)))
-> ((VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))
    -> IO
         (Either
            VoteError
            (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))))
-> (VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))
-> ExceptT
     VoteError
     IO
     (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayEraOnwards era
-> (VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))
-> IO
     (Either
        VoteError
        (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era)))
forall era.
ConwayEraOnwards era
-> (VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))
-> IO
     (Either
        VoteError
        (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era)))
readSingleVote ConwayEraOnwards era
w)

readTxUpdateProposal
  :: ()
  => ShelleyToBabbageEra era
  -> UpdateProposalFile
  -> ExceptT (FileError TextEnvelopeError) IO (TxUpdateProposal era)
readTxUpdateProposal :: forall era.
ShelleyToBabbageEra era
-> UpdateProposalFile
-> ExceptT (FileError TextEnvelopeError) IO (TxUpdateProposal era)
readTxUpdateProposal ShelleyToBabbageEra era
w (UpdateProposalFile String
upFp) = do
  ShelleyToBabbageEra era -> UpdateProposal -> TxUpdateProposal era
forall era.
ShelleyToBabbageEra era -> UpdateProposal -> TxUpdateProposal era
TxUpdateProposal ShelleyToBabbageEra era
w (UpdateProposal -> TxUpdateProposal era)
-> ExceptT (FileError TextEnvelopeError) IO UpdateProposal
-> ExceptT (FileError TextEnvelopeError) IO (TxUpdateProposal era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either (FileError TextEnvelopeError) UpdateProposal)
-> ExceptT (FileError TextEnvelopeError) IO UpdateProposal
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (AsType UpdateProposal
-> File Any 'In
-> IO (Either (FileError TextEnvelopeError) UpdateProposal)
forall a content.
HasTextEnvelope a =>
AsType a
-> File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope AsType UpdateProposal
AsUpdateProposal (String -> File Any 'In
forall content (direction :: FileDirection).
String -> File content direction
File String
upFp))

-- Because the 'Voter' type is contained only in the 'VotingProcedures'
-- type, we must read a single vote as 'VotingProcedures'. The cli will
-- not read vote files with multiple votes in them because this will
-- complicate the code further in terms of contructing the redeemer map
-- when it comes to script witnessed votes.
readSingleVote
  :: ()
  => ConwayEraOnwards era
  -> (VoteFile In, Maybe (ScriptWitnessFiles WitCtxStake))
  -> IO (Either VoteError (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era)))
readSingleVote :: forall era.
ConwayEraOnwards era
-> (VoteFile 'In, Maybe (ScriptWitnessFiles WitCtxStake))
-> IO
     (Either
        VoteError
        (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era)))
readSingleVote ConwayEraOnwards era
w (VoteFile 'In
voteFp, Maybe (ScriptWitnessFiles WitCtxStake)
mScriptWitFiles) = do
  Either VoteError (VotingProcedures era)
votProceds <-
    ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
    IO (Either VoteError (VotingProcedures era)))
-> IO (Either VoteError (VotingProcedures era))
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
w ((ConwayEraOnwardsConstraints era =>
  IO (Either VoteError (VotingProcedures era)))
 -> IO (Either VoteError (VotingProcedures era)))
-> (ConwayEraOnwardsConstraints era =>
    IO (Either VoteError (VotingProcedures era)))
-> IO (Either VoteError (VotingProcedures era))
forall a b. (a -> b) -> a -> b
$
      (FileError TextEnvelopeError -> VoteError)
-> Either (FileError TextEnvelopeError) (VotingProcedures era)
-> Either VoteError (VotingProcedures era)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first FileError TextEnvelopeError -> VoteError
VoteErrorFile (Either (FileError TextEnvelopeError) (VotingProcedures era)
 -> Either VoteError (VotingProcedures era))
-> IO (Either (FileError TextEnvelopeError) (VotingProcedures era))
-> IO (Either VoteError (VotingProcedures era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsType (VotingProcedures era)
-> VoteFile 'In
-> IO (Either (FileError TextEnvelopeError) (VotingProcedures era))
forall a content.
HasTextEnvelope a =>
AsType a
-> File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope AsType (VotingProcedures era)
forall era. AsType (VotingProcedures era)
AsVotingProcedures VoteFile 'In
voteFp
  case Maybe (ScriptWitnessFiles WitCtxStake)
mScriptWitFiles of
    Maybe (ScriptWitnessFiles WitCtxStake)
Nothing -> Either
  VoteError
  (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))
-> IO
     (Either
        VoteError
        (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era)))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   VoteError
   (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))
 -> IO
      (Either
         VoteError
         (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))))
-> Either
     VoteError
     (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))
-> IO
     (Either
        VoteError
        (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era)))
forall a b. (a -> b) -> a -> b
$ (,Maybe (ScriptWitness WitCtxStake era)
forall a. Maybe a
Nothing) (VotingProcedures era
 -> (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era)))
-> Either VoteError (VotingProcedures era)
-> Either
     VoteError
     (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either VoteError (VotingProcedures era)
votProceds
    Maybe (ScriptWitnessFiles WitCtxStake)
sWitFile -> do
      let sbe :: ShelleyBasedEra era
sbe = ConwayEraOnwards era -> ShelleyBasedEra era
forall era. ConwayEraOnwards era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ConwayEraOnwards era
w
      ExceptT
  VoteError
  IO
  (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))
-> IO
     (Either
        VoteError
        (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era)))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   VoteError
   IO
   (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))
 -> IO
      (Either
         VoteError
         (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))))
-> ExceptT
     VoteError
     IO
     (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))
-> IO
     (Either
        VoteError
        (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era)))
forall a b. (a -> b) -> a -> b
$ do
        Maybe (ScriptWitness WitCtxStake era)
sWits <-
          (ScriptWitnessError -> VoteError)
-> ExceptT
     ScriptWitnessError IO (Maybe (ScriptWitness WitCtxStake era))
-> ExceptT VoteError IO (Maybe (ScriptWitness WitCtxStake era))
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ScriptWitnessError -> VoteError
VoteErrorScriptWitness (ExceptT
   ScriptWitnessError IO (Maybe (ScriptWitness WitCtxStake era))
 -> ExceptT VoteError IO (Maybe (ScriptWitness WitCtxStake era)))
-> ExceptT
     ScriptWitnessError IO (Maybe (ScriptWitness WitCtxStake era))
-> ExceptT VoteError IO (Maybe (ScriptWitness WitCtxStake era))
forall a b. (a -> b) -> a -> b
$
            (ScriptWitnessFiles WitCtxStake
 -> ExceptT ScriptWitnessError IO (ScriptWitness WitCtxStake era))
-> Maybe (ScriptWitnessFiles WitCtxStake)
-> ExceptT
     ScriptWitnessError IO (Maybe (ScriptWitness WitCtxStake era))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (ShelleyBasedEra era
-> ScriptWitnessFiles WitCtxStake
-> ExceptT ScriptWitnessError IO (ScriptWitness WitCtxStake era)
forall era witctx.
ShelleyBasedEra era
-> ScriptWitnessFiles witctx
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
readScriptWitness ShelleyBasedEra era
sbe) Maybe (ScriptWitnessFiles WitCtxStake)
sWitFile
        Either
  VoteError
  (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))
-> ExceptT
     VoteError
     IO
     (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either
   VoteError
   (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))
 -> ExceptT
      VoteError
      IO
      (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era)))
-> Either
     VoteError
     (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))
-> ExceptT
     VoteError
     IO
     (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))
forall a b. (a -> b) -> a -> b
$ (,Maybe (ScriptWitness WitCtxStake era)
sWits) (VotingProcedures era
 -> (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era)))
-> Either VoteError (VotingProcedures era)
-> Either
     VoteError
     (VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either VoteError (VotingProcedures era)
votProceds

data ConstitutionError
  = ConstitutionErrorFile (FileError TextEnvelopeError)
  | ConstitutionNotSupportedInEra AnyCardanoEra
  | ConstitutionNotUnicodeError Text.UnicodeException
  deriving Int -> ConstitutionError -> ShowS
[ConstitutionError] -> ShowS
ConstitutionError -> String
(Int -> ConstitutionError -> ShowS)
-> (ConstitutionError -> String)
-> ([ConstitutionError] -> ShowS)
-> Show ConstitutionError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConstitutionError -> ShowS
showsPrec :: Int -> ConstitutionError -> ShowS
$cshow :: ConstitutionError -> String
show :: ConstitutionError -> String
$cshowList :: [ConstitutionError] -> ShowS
showList :: [ConstitutionError] -> ShowS
Show

data ProposalError
  = ProposalErrorFile (FileError TextEnvelopeError)
  | ProposalNotSupportedInEra AnyCardanoEra
  | ProposalNotUnicodeError Text.UnicodeException
  | ProposalErrorScriptWitness ScriptWitnessError
  deriving Int -> ProposalError -> ShowS
[ProposalError] -> ShowS
ProposalError -> String
(Int -> ProposalError -> ShowS)
-> (ProposalError -> String)
-> ([ProposalError] -> ShowS)
-> Show ProposalError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProposalError -> ShowS
showsPrec :: Int -> ProposalError -> ShowS
$cshow :: ProposalError -> String
show :: ProposalError -> String
$cshowList :: [ProposalError] -> ShowS
showList :: [ProposalError] -> ShowS
Show

readTxGovernanceActions
  :: ShelleyBasedEra era
  -> [(ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))]
  -> IO (Either ProposalError [(Proposal era, Maybe (ScriptWitness WitCtxStake era))])
readTxGovernanceActions :: forall era.
ShelleyBasedEra era
-> [(File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
-> IO
     (Either
        ProposalError
        [(Proposal era, Maybe (ScriptWitness WitCtxStake era))])
readTxGovernanceActions ShelleyBasedEra era
_ [] = Either
  ProposalError
  [(Proposal era, Maybe (ScriptWitness WitCtxStake era))]
-> IO
     (Either
        ProposalError
        [(Proposal era, Maybe (ScriptWitness WitCtxStake era))])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   ProposalError
   [(Proposal era, Maybe (ScriptWitness WitCtxStake era))]
 -> IO
      (Either
         ProposalError
         [(Proposal era, Maybe (ScriptWitness WitCtxStake era))]))
-> Either
     ProposalError
     [(Proposal era, Maybe (ScriptWitness WitCtxStake era))]
-> IO
     (Either
        ProposalError
        [(Proposal era, Maybe (ScriptWitness WitCtxStake era))])
forall a b. (a -> b) -> a -> b
$ [(Proposal era, Maybe (ScriptWitness WitCtxStake era))]
-> Either
     ProposalError
     [(Proposal era, Maybe (ScriptWitness WitCtxStake era))]
forall a b. b -> Either a b
Right []
readTxGovernanceActions ShelleyBasedEra era
era [(File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
files = ExceptT
  ProposalError
  IO
  [(Proposal era, Maybe (ScriptWitness WitCtxStake era))]
-> IO
     (Either
        ProposalError
        [(Proposal era, Maybe (ScriptWitness WitCtxStake era))])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   ProposalError
   IO
   [(Proposal era, Maybe (ScriptWitness WitCtxStake era))]
 -> IO
      (Either
         ProposalError
         [(Proposal era, Maybe (ScriptWitness WitCtxStake era))]))
-> ExceptT
     ProposalError
     IO
     [(Proposal era, Maybe (ScriptWitness WitCtxStake era))]
-> IO
     (Either
        ProposalError
        [(Proposal era, Maybe (ScriptWitness WitCtxStake era))])
forall a b. (a -> b) -> a -> b
$ do
  ConwayEraOnwards era
w <-
    ShelleyBasedEra era -> Maybe (ConwayEraOnwards era)
forall (eon :: * -> *) era.
Eon eon =>
ShelleyBasedEra era -> Maybe (eon era)
forShelleyBasedEraMaybeEon ShelleyBasedEra era
era
      Maybe (ConwayEraOnwards era)
-> (Maybe (ConwayEraOnwards era)
    -> ExceptT ProposalError IO (ConwayEraOnwards era))
-> ExceptT ProposalError IO (ConwayEraOnwards era)
forall a b. a -> (a -> b) -> b
& ProposalError
-> Maybe (ConwayEraOnwards era)
-> ExceptT ProposalError IO (ConwayEraOnwards era)
forall (m :: * -> *) x a. Monad m => x -> Maybe a -> ExceptT x m a
hoistMaybe
        ( AnyCardanoEra -> ProposalError
ProposalNotSupportedInEra (AnyCardanoEra -> ProposalError) -> AnyCardanoEra -> ProposalError
forall a b. (a -> b) -> a -> b
$
            CardanoEra era
-> (CardanoEraConstraints era => AnyCardanoEra) -> AnyCardanoEra
forall era a.
CardanoEra era -> (CardanoEraConstraints era => a) -> a
cardanoEraConstraints (ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra ShelleyBasedEra era
era) ((CardanoEraConstraints era => AnyCardanoEra) -> AnyCardanoEra)
-> (CardanoEraConstraints era => AnyCardanoEra) -> AnyCardanoEra
forall a b. (a -> b) -> a -> b
$
              CardanoEra era -> AnyCardanoEra
forall era. Typeable era => CardanoEra era -> AnyCardanoEra
AnyCardanoEra (ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra ShelleyBasedEra era
era)
        )
  IO
  (Either
     ProposalError
     [(Proposal era, Maybe (ScriptWitness WitCtxStake era))])
-> ExceptT
     ProposalError
     IO
     [(Proposal era, Maybe (ScriptWitness WitCtxStake era))]
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO
   (Either
      ProposalError
      [(Proposal era, Maybe (ScriptWitness WitCtxStake era))])
 -> ExceptT
      ProposalError
      IO
      [(Proposal era, Maybe (ScriptWitness WitCtxStake era))])
-> IO
     (Either
        ProposalError
        [(Proposal era, Maybe (ScriptWitness WitCtxStake era))])
-> ExceptT
     ProposalError
     IO
     [(Proposal era, Maybe (ScriptWitness WitCtxStake era))]
forall a b. (a -> b) -> a -> b
$ [Either
   ProposalError
   (Proposal era, Maybe (ScriptWitness WitCtxStake era))]
-> Either
     ProposalError
     [(Proposal era, Maybe (ScriptWitness WitCtxStake era))]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([Either
    ProposalError
    (Proposal era, Maybe (ScriptWitness WitCtxStake era))]
 -> Either
      ProposalError
      [(Proposal era, Maybe (ScriptWitness WitCtxStake era))])
-> IO
     [Either
        ProposalError
        (Proposal era, Maybe (ScriptWitness WitCtxStake era))]
-> IO
     (Either
        ProposalError
        [(Proposal era, Maybe (ScriptWitness WitCtxStake era))])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))
 -> IO
      (Either
         ProposalError
         (Proposal era, Maybe (ScriptWitness WitCtxStake era))))
-> [(File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
-> IO
     [Either
        ProposalError
        (Proposal era, Maybe (ScriptWitness WitCtxStake era))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ConwayEraOnwards era
-> (File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))
-> IO
     (Either
        ProposalError
        (Proposal era, Maybe (ScriptWitness WitCtxStake era)))
forall era.
ConwayEraOnwards era
-> (File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))
-> IO
     (Either
        ProposalError
        (Proposal era, Maybe (ScriptWitness WitCtxStake era)))
readProposal ConwayEraOnwards era
w) [(File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))]
files

readProposal
  :: ConwayEraOnwards era
  -> (ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))
  -> IO (Either ProposalError (Proposal era, Maybe (ScriptWitness WitCtxStake era)))
readProposal :: forall era.
ConwayEraOnwards era
-> (File () 'In, Maybe (ScriptWitnessFiles WitCtxStake))
-> IO
     (Either
        ProposalError
        (Proposal era, Maybe (ScriptWitness WitCtxStake era)))
readProposal ConwayEraOnwards era
w (File () 'In
fp, Maybe (ScriptWitnessFiles WitCtxStake)
mScriptWit) = do
  Either ProposalError (Proposal era)
prop <-
    ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era =>
    IO (Either ProposalError (Proposal era)))
-> IO (Either ProposalError (Proposal era))
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
w ((ConwayEraOnwardsConstraints era =>
  IO (Either ProposalError (Proposal era)))
 -> IO (Either ProposalError (Proposal era)))
-> (ConwayEraOnwardsConstraints era =>
    IO (Either ProposalError (Proposal era)))
-> IO (Either ProposalError (Proposal era))
forall a b. (a -> b) -> a -> b
$
      (FileError TextEnvelopeError -> ProposalError)
-> Either (FileError TextEnvelopeError) (Proposal era)
-> Either ProposalError (Proposal era)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first FileError TextEnvelopeError -> ProposalError
ProposalErrorFile (Either (FileError TextEnvelopeError) (Proposal era)
 -> Either ProposalError (Proposal era))
-> IO (Either (FileError TextEnvelopeError) (Proposal era))
-> IO (Either ProposalError (Proposal era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsType (Proposal era)
-> File () 'In
-> IO (Either (FileError TextEnvelopeError) (Proposal era))
forall a content.
HasTextEnvelope a =>
AsType a
-> File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope AsType (Proposal era)
forall era. AsType (Proposal era)
AsProposal File () 'In
fp
  case Maybe (ScriptWitnessFiles WitCtxStake)
mScriptWit of
    Maybe (ScriptWitnessFiles WitCtxStake)
Nothing -> Either
  ProposalError (Proposal era, Maybe (ScriptWitness WitCtxStake era))
-> IO
     (Either
        ProposalError
        (Proposal era, Maybe (ScriptWitness WitCtxStake era)))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   ProposalError (Proposal era, Maybe (ScriptWitness WitCtxStake era))
 -> IO
      (Either
         ProposalError
         (Proposal era, Maybe (ScriptWitness WitCtxStake era))))
-> Either
     ProposalError (Proposal era, Maybe (ScriptWitness WitCtxStake era))
-> IO
     (Either
        ProposalError
        (Proposal era, Maybe (ScriptWitness WitCtxStake era)))
forall a b. (a -> b) -> a -> b
$ (,Maybe (ScriptWitness WitCtxStake era)
forall a. Maybe a
Nothing) (Proposal era
 -> (Proposal era, Maybe (ScriptWitness WitCtxStake era)))
-> Either ProposalError (Proposal era)
-> Either
     ProposalError (Proposal era, Maybe (ScriptWitness WitCtxStake era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either ProposalError (Proposal era)
prop
    Maybe (ScriptWitnessFiles WitCtxStake)
sWitFile -> do
      let sbe :: ShelleyBasedEra era
sbe = ConwayEraOnwards era -> ShelleyBasedEra era
forall era. ConwayEraOnwards era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ConwayEraOnwards era
w
      ExceptT
  ProposalError
  IO
  (Proposal era, Maybe (ScriptWitness WitCtxStake era))
-> IO
     (Either
        ProposalError
        (Proposal era, Maybe (ScriptWitness WitCtxStake era)))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   ProposalError
   IO
   (Proposal era, Maybe (ScriptWitness WitCtxStake era))
 -> IO
      (Either
         ProposalError
         (Proposal era, Maybe (ScriptWitness WitCtxStake era))))
-> ExceptT
     ProposalError
     IO
     (Proposal era, Maybe (ScriptWitness WitCtxStake era))
-> IO
     (Either
        ProposalError
        (Proposal era, Maybe (ScriptWitness WitCtxStake era)))
forall a b. (a -> b) -> a -> b
$ do
        Maybe (ScriptWitness WitCtxStake era)
sWit <-
          (ScriptWitnessError -> ProposalError)
-> ExceptT
     ScriptWitnessError IO (Maybe (ScriptWitness WitCtxStake era))
-> ExceptT ProposalError IO (Maybe (ScriptWitness WitCtxStake era))
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ScriptWitnessError -> ProposalError
ProposalErrorScriptWitness (ExceptT
   ScriptWitnessError IO (Maybe (ScriptWitness WitCtxStake era))
 -> ExceptT
      ProposalError IO (Maybe (ScriptWitness WitCtxStake era)))
-> ExceptT
     ScriptWitnessError IO (Maybe (ScriptWitness WitCtxStake era))
-> ExceptT ProposalError IO (Maybe (ScriptWitness WitCtxStake era))
forall a b. (a -> b) -> a -> b
$
            (ScriptWitnessFiles WitCtxStake
 -> ExceptT ScriptWitnessError IO (ScriptWitness WitCtxStake era))
-> Maybe (ScriptWitnessFiles WitCtxStake)
-> ExceptT
     ScriptWitnessError IO (Maybe (ScriptWitness WitCtxStake era))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (ShelleyBasedEra era
-> ScriptWitnessFiles WitCtxStake
-> ExceptT ScriptWitnessError IO (ScriptWitness WitCtxStake era)
forall era witctx.
ShelleyBasedEra era
-> ScriptWitnessFiles witctx
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
readScriptWitness ShelleyBasedEra era
sbe) Maybe (ScriptWitnessFiles WitCtxStake)
sWitFile
        Either
  ProposalError (Proposal era, Maybe (ScriptWitness WitCtxStake era))
-> ExceptT
     ProposalError
     IO
     (Proposal era, Maybe (ScriptWitness WitCtxStake era))
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either
   ProposalError (Proposal era, Maybe (ScriptWitness WitCtxStake era))
 -> ExceptT
      ProposalError
      IO
      (Proposal era, Maybe (ScriptWitness WitCtxStake era)))
-> Either
     ProposalError (Proposal era, Maybe (ScriptWitness WitCtxStake era))
-> ExceptT
     ProposalError
     IO
     (Proposal era, Maybe (ScriptWitness WitCtxStake era))
forall a b. (a -> b) -> a -> b
$ (,Maybe (ScriptWitness WitCtxStake era)
sWit) (Proposal era
 -> (Proposal era, Maybe (ScriptWitness WitCtxStake era)))
-> Either ProposalError (Proposal era)
-> Either
     ProposalError (Proposal era, Maybe (ScriptWitness WitCtxStake era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either ProposalError (Proposal era)
prop

constitutionHashSourceToHash
  :: ()
  => ConstitutionHashSource
  -> ExceptT ConstitutionError IO (L.SafeHash L.StandardCrypto L.AnchorData)
constitutionHashSourceToHash :: ConstitutionHashSource
-> ExceptT
     ConstitutionError IO (SafeHash StandardCrypto AnchorData)
constitutionHashSourceToHash ConstitutionHashSource
constitutionHashSource = do
  case ConstitutionHashSource
constitutionHashSource of
    ConstitutionHashSourceFile File ConstitutionText 'In
fp -> do
      ByteString
cBs <- IO ByteString -> ExceptT ConstitutionError IO ByteString
forall a. IO a -> ExceptT ConstitutionError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ExceptT ConstitutionError IO ByteString)
-> IO ByteString -> ExceptT ConstitutionError IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
BS.readFile (String -> IO ByteString) -> String -> IO ByteString
forall a b. (a -> b) -> a -> b
$ File ConstitutionText 'In -> String
forall content (direction :: FileDirection).
File content direction -> String
unFile File ConstitutionText 'In
fp
      Text
_utf8EncodedText <- (UnicodeException -> ConstitutionError)
-> ExceptT UnicodeException IO Text
-> ExceptT ConstitutionError IO Text
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT UnicodeException -> ConstitutionError
ConstitutionNotUnicodeError (ExceptT UnicodeException IO Text
 -> ExceptT ConstitutionError IO Text)
-> (Either UnicodeException Text
    -> ExceptT UnicodeException IO Text)
-> Either UnicodeException Text
-> ExceptT ConstitutionError IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either UnicodeException Text -> ExceptT UnicodeException IO Text
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either UnicodeException Text -> ExceptT ConstitutionError IO Text)
-> Either UnicodeException Text
-> ExceptT ConstitutionError IO Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Either UnicodeException Text
Text.decodeUtf8' ByteString
cBs
      SafeHash StandardCrypto AnchorData
-> ExceptT
     ConstitutionError IO (SafeHash StandardCrypto AnchorData)
forall a. a -> ExceptT ConstitutionError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SafeHash StandardCrypto AnchorData
 -> ExceptT
      ConstitutionError IO (SafeHash StandardCrypto AnchorData))
-> SafeHash StandardCrypto AnchorData
-> ExceptT
     ConstitutionError IO (SafeHash StandardCrypto AnchorData)
forall a b. (a -> b) -> a -> b
$ AnchorData -> SafeHash StandardCrypto AnchorData
forall c. Crypto c => AnchorData -> SafeHash c AnchorData
L.hashAnchorData (AnchorData -> SafeHash StandardCrypto AnchorData)
-> AnchorData -> SafeHash StandardCrypto AnchorData
forall a b. (a -> b) -> a -> b
$ ByteString -> AnchorData
L.AnchorData ByteString
cBs
    ConstitutionHashSourceText Text
c -> do
      SafeHash StandardCrypto AnchorData
-> ExceptT
     ConstitutionError IO (SafeHash StandardCrypto AnchorData)
forall a. a -> ExceptT ConstitutionError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SafeHash StandardCrypto AnchorData
 -> ExceptT
      ConstitutionError IO (SafeHash StandardCrypto AnchorData))
-> SafeHash StandardCrypto AnchorData
-> ExceptT
     ConstitutionError IO (SafeHash StandardCrypto AnchorData)
forall a b. (a -> b) -> a -> b
$ AnchorData -> SafeHash StandardCrypto AnchorData
forall c. Crypto c => AnchorData -> SafeHash c AnchorData
L.hashAnchorData (AnchorData -> SafeHash StandardCrypto AnchorData)
-> AnchorData -> SafeHash StandardCrypto AnchorData
forall a b. (a -> b) -> a -> b
$ ByteString -> AnchorData
L.AnchorData (ByteString -> AnchorData) -> ByteString -> AnchorData
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
Text.encodeUtf8 Text
c
    ConstitutionHashSourceHash SafeHash StandardCrypto AnchorData
h ->
      SafeHash StandardCrypto AnchorData
-> ExceptT
     ConstitutionError IO (SafeHash StandardCrypto AnchorData)
forall a. a -> ExceptT ConstitutionError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SafeHash StandardCrypto AnchorData
h

data CostModelsError
  = CostModelsErrorReadFile (FileError ())
  | CostModelsErrorJSONDecode FilePath String
  | CostModelsErrorEmpty FilePath
  deriving Int -> CostModelsError -> ShowS
[CostModelsError] -> ShowS
CostModelsError -> String
(Int -> CostModelsError -> ShowS)
-> (CostModelsError -> String)
-> ([CostModelsError] -> ShowS)
-> Show CostModelsError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CostModelsError -> ShowS
showsPrec :: Int -> CostModelsError -> ShowS
$cshow :: CostModelsError -> String
show :: CostModelsError -> String
$cshowList :: [CostModelsError] -> ShowS
showList :: [CostModelsError] -> ShowS
Show

instance Error CostModelsError where
  prettyError :: forall ann. CostModelsError -> Doc ann
prettyError = \case
    CostModelsErrorReadFile FileError ()
e ->
      Doc ann
"Cannot read cost model: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> FileError () -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError () -> Doc ann
prettyError FileError ()
e
    CostModelsErrorJSONDecode String
fp String
err ->
      Doc ann
"Error decoding JSON cost model at " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow String
fp Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
": " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
err Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall {ann}. Doc ann
formatExplanation
    CostModelsErrorEmpty String
fp ->
      Doc ann
"The decoded cost model was empty at: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow String
fp Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall {ann}. Doc ann
formatExplanation
   where
    formatExplanation :: Doc ann
formatExplanation =
      [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
        [ Doc ann
""
        , Doc ann
"The expected format of the cost models file is "
        , Doc ann
"{"
        , Doc ann
"  \"PlutusV1\" : <costModel>,"
        , Doc ann
"  \"PlutusV2\" : <costModel>,"
        , Doc ann
"  \"PlutusV3\" : <costModel>,"
        , Doc ann
"}"
        , Doc ann
"where each of the three entries may be ommited, and a <cost model> is either an ordered list of parameter values like"
        , Doc ann
"[205665, 812, 1, ...]"
        , Doc ann
"or a map like"
        , Doc ann
"{ \"addInteger-cpu-arguments-intercept\": 205665, \"addInteger-cpu-arguments-slope\": 812, \"addInteger-memory-arguments-intercept\": 1, ... }"
        , Doc ann
"In both cases, the cost model must be complete, i.e. it must specify all parameters that are needed for the specific Plutus version."
        , Doc ann
"It's not specified what will happen if you provide more parameters than necessary."
        ]

readCostModels
  :: File L.CostModels In
  -> ExceptT CostModelsError IO L.CostModels
readCostModels :: File CostModels 'In -> ExceptT CostModelsError IO CostModels
readCostModels (File String
fp) = do
  ByteString
bytes <- (IOException -> CostModelsError)
-> IO ByteString -> ExceptT CostModelsError IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> CostModelsError
CostModelsErrorReadFile (FileError () -> CostModelsError)
-> (IOException -> FileError ()) -> IOException -> CostModelsError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
fp) (IO ByteString -> ExceptT CostModelsError IO ByteString)
-> IO ByteString -> ExceptT CostModelsError IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
LBS.readFile String
fp
  CostModels
costModels <- (String -> CostModelsError)
-> ExceptT String IO CostModels
-> ExceptT CostModelsError IO CostModels
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> String -> CostModelsError
CostModelsErrorJSONDecode String
fp) (ExceptT String IO CostModels
 -> ExceptT CostModelsError IO CostModels)
-> (Either String CostModels -> ExceptT String IO CostModels)
-> Either String CostModels
-> ExceptT CostModelsError IO CostModels
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String CostModels -> ExceptT String IO CostModels
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
except (Either String CostModels -> ExceptT CostModelsError IO CostModels)
-> Either String CostModels
-> ExceptT CostModelsError IO CostModels
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String CostModels
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode ByteString
bytes
  Bool
-> ExceptT CostModelsError IO () -> ExceptT CostModelsError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Map AnyPlutusScriptVersion CostModel -> Bool
forall a. Map AnyPlutusScriptVersion a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Map AnyPlutusScriptVersion CostModel -> Bool)
-> Map AnyPlutusScriptVersion CostModel -> Bool
forall a b. (a -> b) -> a -> b
$ CostModels -> Map AnyPlutusScriptVersion CostModel
fromAlonzoCostModels CostModels
costModels) (ExceptT CostModelsError IO () -> ExceptT CostModelsError IO ())
-> ExceptT CostModelsError IO () -> ExceptT CostModelsError IO ()
forall a b. (a -> b) -> a -> b
$ CostModelsError -> ExceptT CostModelsError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
throwE (CostModelsError -> ExceptT CostModelsError IO ())
-> CostModelsError -> ExceptT CostModelsError IO ()
forall a b. (a -> b) -> a -> b
$ String -> CostModelsError
CostModelsErrorEmpty String
fp
  CostModels -> ExceptT CostModelsError IO CostModels
forall a. a -> ExceptT CostModelsError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CostModels
costModels

-- Misc

readFileInAnyShelleyBasedEra
  :: ( HasTextEnvelope (thing ShelleyEra)
     , HasTextEnvelope (thing AllegraEra)
     , HasTextEnvelope (thing MaryEra)
     , HasTextEnvelope (thing AlonzoEra)
     , HasTextEnvelope (thing BabbageEra)
     , HasTextEnvelope (thing ConwayEra)
     )
  => (forall era. AsType era -> AsType (thing era))
  -> FileOrPipe
  -> IO (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra thing))
readFileInAnyShelleyBasedEra :: forall (thing :: * -> *).
(HasTextEnvelope (thing ShelleyEra),
 HasTextEnvelope (thing AllegraEra),
 HasTextEnvelope (thing MaryEra), HasTextEnvelope (thing AlonzoEra),
 HasTextEnvelope (thing BabbageEra),
 HasTextEnvelope (thing ConwayEra)) =>
(forall era. AsType era -> AsType (thing era))
-> FileOrPipe
-> IO
     (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra thing))
readFileInAnyShelleyBasedEra forall era. AsType era -> AsType (thing era)
asThing =
  [FromSomeType HasTextEnvelope (InAnyShelleyBasedEra thing)]
-> FileOrPipe
-> IO
     (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra thing))
forall b.
[FromSomeType HasTextEnvelope b]
-> FileOrPipe -> IO (Either (FileError TextEnvelopeError) b)
readFileOrPipeTextEnvelopeAnyOf
    [ AsType (thing ShelleyEra)
-> (thing ShelleyEra -> InAnyShelleyBasedEra thing)
-> FromSomeType HasTextEnvelope (InAnyShelleyBasedEra thing)
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType ShelleyEra -> AsType (thing ShelleyEra)
forall era. AsType era -> AsType (thing era)
asThing AsType ShelleyEra
AsShelleyEra) (ShelleyBasedEra ShelleyEra
-> thing ShelleyEra -> InAnyShelleyBasedEra thing
forall era (thing :: * -> *).
Typeable era =>
ShelleyBasedEra era -> thing era -> InAnyShelleyBasedEra thing
InAnyShelleyBasedEra ShelleyBasedEra ShelleyEra
ShelleyBasedEraShelley)
    , AsType (thing AllegraEra)
-> (thing AllegraEra -> InAnyShelleyBasedEra thing)
-> FromSomeType HasTextEnvelope (InAnyShelleyBasedEra thing)
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType AllegraEra -> AsType (thing AllegraEra)
forall era. AsType era -> AsType (thing era)
asThing AsType AllegraEra
AsAllegraEra) (ShelleyBasedEra AllegraEra
-> thing AllegraEra -> InAnyShelleyBasedEra thing
forall era (thing :: * -> *).
Typeable era =>
ShelleyBasedEra era -> thing era -> InAnyShelleyBasedEra thing
InAnyShelleyBasedEra ShelleyBasedEra AllegraEra
ShelleyBasedEraAllegra)
    , AsType (thing MaryEra)
-> (thing MaryEra -> InAnyShelleyBasedEra thing)
-> FromSomeType HasTextEnvelope (InAnyShelleyBasedEra thing)
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType MaryEra -> AsType (thing MaryEra)
forall era. AsType era -> AsType (thing era)
asThing AsType MaryEra
AsMaryEra) (ShelleyBasedEra MaryEra
-> thing MaryEra -> InAnyShelleyBasedEra thing
forall era (thing :: * -> *).
Typeable era =>
ShelleyBasedEra era -> thing era -> InAnyShelleyBasedEra thing
InAnyShelleyBasedEra ShelleyBasedEra MaryEra
ShelleyBasedEraMary)
    , AsType (thing AlonzoEra)
-> (thing AlonzoEra -> InAnyShelleyBasedEra thing)
-> FromSomeType HasTextEnvelope (InAnyShelleyBasedEra thing)
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType AlonzoEra -> AsType (thing AlonzoEra)
forall era. AsType era -> AsType (thing era)
asThing AsType AlonzoEra
AsAlonzoEra) (ShelleyBasedEra AlonzoEra
-> thing AlonzoEra -> InAnyShelleyBasedEra thing
forall era (thing :: * -> *).
Typeable era =>
ShelleyBasedEra era -> thing era -> InAnyShelleyBasedEra thing
InAnyShelleyBasedEra ShelleyBasedEra AlonzoEra
ShelleyBasedEraAlonzo)
    , AsType (thing BabbageEra)
-> (thing BabbageEra -> InAnyShelleyBasedEra thing)
-> FromSomeType HasTextEnvelope (InAnyShelleyBasedEra thing)
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType BabbageEra -> AsType (thing BabbageEra)
forall era. AsType era -> AsType (thing era)
asThing AsType BabbageEra
AsBabbageEra) (ShelleyBasedEra BabbageEra
-> thing BabbageEra -> InAnyShelleyBasedEra thing
forall era (thing :: * -> *).
Typeable era =>
ShelleyBasedEra era -> thing era -> InAnyShelleyBasedEra thing
InAnyShelleyBasedEra ShelleyBasedEra BabbageEra
ShelleyBasedEraBabbage)
    , AsType (thing ConwayEra)
-> (thing ConwayEra -> InAnyShelleyBasedEra thing)
-> FromSomeType HasTextEnvelope (InAnyShelleyBasedEra thing)
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType ConwayEra -> AsType (thing ConwayEra)
forall era. AsType era -> AsType (thing era)
asThing AsType ConwayEra
AsConwayEra) (ShelleyBasedEra ConwayEra
-> thing ConwayEra -> InAnyShelleyBasedEra thing
forall era (thing :: * -> *).
Typeable era =>
ShelleyBasedEra era -> thing era -> InAnyShelleyBasedEra thing
InAnyShelleyBasedEra ShelleyBasedEra ConwayEra
ShelleyBasedEraConway)
    ]

-- | 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)
_) = ShowS
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 (IORef (Maybe ByteString) -> FileOrPipe)
-> IO (IORef (Maybe ByteString)) -> IO FileOrPipe
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString -> IO (IORef (Maybe ByteString))
forall a. a -> IO (IORef a)
newIORef Maybe ByteString
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) = IORef (Maybe ByteString) -> IO (Maybe ByteString)
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 <- IORef (Maybe ByteString) -> IO (Maybe ByteString)
forall a. IORef a -> IO a
readIORef IORef (Maybe ByteString)
cacheRef
  case Maybe ByteString
cached of
    Just ByteString
dat -> ByteString -> IO ByteString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
dat
    Maybe ByteString
Nothing ->
      IO Handle
-> (Handle -> IO ()) -> (Handle -> IO ByteString) -> IO ByteString
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 Builder -> IO Builder
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Builder
acc
                    else Builder -> IO Builder
go (Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Builder.byteString ByteString
next)
            Builder
contents <- Builder -> IO Builder
go Builder
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
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
seekable (IORef (Maybe ByteString) -> Maybe ByteString -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe ByteString)
cacheRef (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
dat))
            ByteString -> IO ByteString
forall a. a -> IO a
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
  ExceptT (FileError TextEnvelopeError) IO b
-> IO (Either (FileError TextEnvelopeError) b)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (FileError TextEnvelopeError) IO b
 -> IO (Either (FileError TextEnvelopeError) b))
-> ExceptT (FileError TextEnvelopeError) IO b
-> IO (Either (FileError TextEnvelopeError) b)
forall a b. (a -> b) -> a -> b
$ do
    ByteString
content <- (IOException -> FileError TextEnvelopeError)
-> IO ByteString
-> ExceptT (FileError TextEnvelopeError) IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (String -> IOException -> FileError TextEnvelopeError
forall e. String -> IOException -> FileError e
FileIOError String
path) (IO ByteString
 -> ExceptT (FileError TextEnvelopeError) IO ByteString)
-> IO ByteString
-> ExceptT (FileError TextEnvelopeError) IO ByteString
forall a b. (a -> b) -> a -> b
$ FileOrPipe -> IO ByteString
readFileOrPipe FileOrPipe
file
    (TextEnvelopeError -> FileError TextEnvelopeError)
-> ExceptT TextEnvelopeError IO b
-> ExceptT (FileError TextEnvelopeError) IO b
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> TextEnvelopeError -> FileError TextEnvelopeError
forall e. String -> e -> FileError e
FileError String
path) (ExceptT TextEnvelopeError IO b
 -> ExceptT (FileError TextEnvelopeError) IO b)
-> ExceptT TextEnvelopeError IO b
-> ExceptT (FileError TextEnvelopeError) IO b
forall a b. (a -> b) -> a -> b
$ Either TextEnvelopeError b -> ExceptT TextEnvelopeError IO b
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either TextEnvelopeError b -> ExceptT TextEnvelopeError IO b)
-> Either TextEnvelopeError b -> ExceptT TextEnvelopeError IO b
forall a b. (a -> b) -> a -> b
$ do
      TextEnvelope
te <- (String -> TextEnvelopeError)
-> Either String TextEnvelope
-> Either TextEnvelopeError TextEnvelope
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> TextEnvelopeError
TextEnvelopeAesonDecodeError (Either String TextEnvelope
 -> Either TextEnvelopeError TextEnvelope)
-> Either String TextEnvelope
-> Either TextEnvelopeError TextEnvelope
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String TextEnvelope
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode' ByteString
content
      [FromSomeType HasTextEnvelope b]
-> TextEnvelope -> Either TextEnvelopeError b
forall b.
[FromSomeType HasTextEnvelope b]
-> TextEnvelope -> Either TextEnvelopeError b
deserialiseFromTextEnvelopeAnyOf [FromSomeType HasTextEnvelope b]
types TextEnvelope
te

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

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

----------------------------------------------------------------------------------------------------

getStakeCredentialFromVerifier
  :: ()
  => StakeVerifier
  -> ExceptT StakeCredentialError IO StakeCredential
getStakeCredentialFromVerifier :: StakeVerifier -> ExceptT StakeCredentialError IO StakeCredential
getStakeCredentialFromVerifier = \case
  StakeVerifierScriptFile (File String
sFile) -> do
    ScriptInAnyLang ScriptLanguage lang
_ Script lang
script <-
      String -> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadIOTransError (FileError ScriptDecodeError) t m =>
String -> t m ScriptInAnyLang
readFileScriptInAnyLang String
sFile
        ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
-> (ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
    -> ExceptT StakeCredentialError IO ScriptInAnyLang)
-> ExceptT StakeCredentialError IO ScriptInAnyLang
forall a b. a -> (a -> b) -> b
& (FileError ScriptDecodeError -> StakeCredentialError)
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
-> ExceptT StakeCredentialError IO ScriptInAnyLang
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError ScriptDecodeError -> StakeCredentialError
StakeCredentialScriptDecodeError
    StakeCredential -> ExceptT StakeCredentialError IO StakeCredential
forall a. a -> ExceptT StakeCredentialError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StakeCredential
 -> ExceptT StakeCredentialError IO StakeCredential)
-> StakeCredential
-> ExceptT StakeCredentialError IO StakeCredential
forall a b. (a -> b) -> a -> b
$ ScriptHash -> StakeCredential
StakeCredentialByScript (ScriptHash -> StakeCredential) -> ScriptHash -> StakeCredential
forall a b. (a -> b) -> a -> b
$ Script lang -> ScriptHash
forall lang. Script lang -> ScriptHash
hashScript Script lang
script
  StakeVerifierKey VerificationKeyOrHashOrFile StakeKey
stakeVerKeyOrFile -> do
    Hash StakeKey
stakeVerKeyHash <-
      (FileError InputDecodeError -> StakeCredentialError)
-> ExceptT (FileError InputDecodeError) IO (Hash StakeKey)
-> ExceptT StakeCredentialError IO (Hash StakeKey)
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError FileError InputDecodeError -> StakeCredentialError
StakeCredentialInputDecodeError (ExceptT (FileError InputDecodeError) IO (Hash StakeKey)
 -> ExceptT StakeCredentialError IO (Hash StakeKey))
-> ExceptT (FileError InputDecodeError) IO (Hash StakeKey)
-> ExceptT StakeCredentialError IO (Hash StakeKey)
forall a b. (a -> b) -> a -> b
$
        AsType StakeKey
-> VerificationKeyOrHashOrFile StakeKey
-> ExceptT (FileError InputDecodeError) IO (Hash StakeKey)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) keyrole.
(MonadIOTransError (FileError InputDecodeError) t m, Key keyrole,
 SerialiseAsBech32 (VerificationKey keyrole)) =>
AsType keyrole
-> VerificationKeyOrHashOrFile keyrole -> t m (Hash keyrole)
readVerificationKeyOrHashOrFile AsType StakeKey
AsStakeKey VerificationKeyOrHashOrFile StakeKey
stakeVerKeyOrFile
    StakeCredential -> ExceptT StakeCredentialError IO StakeCredential
forall a. a -> ExceptT StakeCredentialError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StakeCredential
 -> ExceptT StakeCredentialError IO StakeCredential)
-> StakeCredential
-> ExceptT StakeCredentialError IO StakeCredential
forall a b. (a -> b) -> a -> b
$ Hash StakeKey -> StakeCredential
StakeCredentialByKey Hash StakeKey
stakeVerKeyHash

getStakeCredentialFromIdentifier
  :: ()
  => StakeIdentifier
  -> ExceptT StakeCredentialError IO StakeCredential
getStakeCredentialFromIdentifier :: StakeIdentifier -> ExceptT StakeCredentialError IO StakeCredential
getStakeCredentialFromIdentifier = \case
  StakeIdentifierAddress StakeAddress
stakeAddr -> StakeCredential -> ExceptT StakeCredentialError IO StakeCredential
forall a. a -> ExceptT StakeCredentialError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StakeCredential
 -> ExceptT StakeCredentialError IO StakeCredential)
-> StakeCredential
-> ExceptT StakeCredentialError IO StakeCredential
forall a b. (a -> b) -> a -> b
$ StakeAddress -> StakeCredential
stakeAddressCredential StakeAddress
stakeAddr
  StakeIdentifierVerifier StakeVerifier
stakeVerifier -> StakeVerifier -> ExceptT StakeCredentialError IO StakeCredential
getStakeCredentialFromVerifier StakeVerifier
stakeVerifier

getStakeAddressFromVerifier
  :: ()
  => NetworkId
  -> StakeVerifier
  -> ExceptT StakeCredentialError IO StakeAddress
getStakeAddressFromVerifier :: NetworkId
-> StakeVerifier -> ExceptT StakeCredentialError IO StakeAddress
getStakeAddressFromVerifier NetworkId
networkId StakeVerifier
stakeVerifier =
  NetworkId -> StakeCredential -> StakeAddress
makeStakeAddress NetworkId
networkId (StakeCredential -> StakeAddress)
-> ExceptT StakeCredentialError IO StakeCredential
-> ExceptT StakeCredentialError IO StakeAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StakeVerifier -> ExceptT StakeCredentialError IO StakeCredential
getStakeCredentialFromVerifier StakeVerifier
stakeVerifier

getDRepCredentialFromVerKeyHashOrFile
  :: ()
  => MonadIOTransError (FileError InputDecodeError) t m
  => VerificationKeyOrHashOrFile DRepKey
  -> t m (L.Credential L.DRepRole L.StandardCrypto)
getDRepCredentialFromVerKeyHashOrFile :: forall (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadIOTransError (FileError InputDecodeError) t m =>
VerificationKeyOrHashOrFile DRepKey
-> t m (Credential 'DRepRole StandardCrypto)
getDRepCredentialFromVerKeyHashOrFile = \case
  VerificationKeyOrFile VerificationKeyOrFile DRepKey
verKeyOrFile -> do
    VerificationKey DRepKey
drepVerKey <- AsType DRepKey
-> VerificationKeyOrFile DRepKey -> t m (VerificationKey DRepKey)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) keyrole.
(MonadIOTransError (FileError InputDecodeError) t m,
 HasTextEnvelope (VerificationKey keyrole),
 SerialiseAsBech32 (VerificationKey keyrole)) =>
AsType keyrole
-> VerificationKeyOrFile keyrole -> t m (VerificationKey keyrole)
readVerificationKeyOrFile AsType DRepKey
AsDRepKey VerificationKeyOrFile DRepKey
verKeyOrFile
    Credential 'DRepRole StandardCrypto
-> t m (Credential 'DRepRole StandardCrypto)
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential 'DRepRole StandardCrypto
 -> t m (Credential 'DRepRole StandardCrypto))
-> (Hash DRepKey -> Credential 'DRepRole StandardCrypto)
-> Hash DRepKey
-> t m (Credential 'DRepRole StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'DRepRole StandardCrypto
-> Credential 'DRepRole StandardCrypto
forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
L.KeyHashObj (KeyHash 'DRepRole StandardCrypto
 -> Credential 'DRepRole StandardCrypto)
-> (Hash DRepKey -> KeyHash 'DRepRole StandardCrypto)
-> Hash DRepKey
-> Credential 'DRepRole StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash DRepKey -> KeyHash 'DRepRole StandardCrypto
unDRepKeyHash (Hash DRepKey -> t m (Credential 'DRepRole StandardCrypto))
-> Hash DRepKey -> t m (Credential 'DRepRole StandardCrypto)
forall a b. (a -> b) -> a -> b
$ VerificationKey DRepKey -> Hash DRepKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey DRepKey
drepVerKey
  VerificationKeyHash Hash DRepKey
kh -> Credential 'DRepRole StandardCrypto
-> t m (Credential 'DRepRole StandardCrypto)
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential 'DRepRole StandardCrypto
 -> t m (Credential 'DRepRole StandardCrypto))
-> (KeyHash 'DRepRole StandardCrypto
    -> Credential 'DRepRole StandardCrypto)
-> KeyHash 'DRepRole StandardCrypto
-> t m (Credential 'DRepRole StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'DRepRole StandardCrypto
-> Credential 'DRepRole StandardCrypto
forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
L.KeyHashObj (KeyHash 'DRepRole StandardCrypto
 -> t m (Credential 'DRepRole StandardCrypto))
-> KeyHash 'DRepRole StandardCrypto
-> t m (Credential 'DRepRole StandardCrypto)
forall a b. (a -> b) -> a -> b
$ Hash DRepKey -> KeyHash 'DRepRole StandardCrypto
unDRepKeyHash Hash DRepKey
kh

data ReadSafeHashError
  = ReadSafeHashErrorNotHex ByteString String
  | ReadSafeHashErrorInvalidHash Text

renderReadSafeHashError :: ReadSafeHashError -> Text
renderReadSafeHashError :: ReadSafeHashError -> Text
renderReadSafeHashError = \case
  ReadSafeHashErrorNotHex ByteString
bs String
err ->
    Text
"Error reading anchor data hash: Invalid hex: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
Text.decodeUtf8 ByteString
bs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
err
  ReadSafeHashErrorInvalidHash Text
err ->
    Text
"Error reading anchor data hash: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err

readHexAsSafeHash
  :: ()
  => Text
  -> Either ReadSafeHashError (L.SafeHash L.StandardCrypto L.AnchorData)
readHexAsSafeHash :: Text
-> Either ReadSafeHashError (SafeHash StandardCrypto AnchorData)
readHexAsSafeHash Text
hex = do
  let bs :: ByteString
bs = Text -> ByteString
Text.encodeUtf8 Text
hex

  ByteString
raw <- ByteString -> Either String ByteString
Base16.decode ByteString
bs Either String ByteString
-> (Either String ByteString
    -> Either ReadSafeHashError ByteString)
-> Either ReadSafeHashError ByteString
forall a b. a -> (a -> b) -> b
& (String -> ReadSafeHashError)
-> Either String ByteString -> Either ReadSafeHashError ByteString
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ByteString -> String -> ReadSafeHashError
ReadSafeHashErrorNotHex ByteString
bs)

  case ByteString -> Maybe (Hash Blake2b_256 AnchorData)
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Crypto.hashFromBytes ByteString
raw of
    Just Hash Blake2b_256 AnchorData
a -> SafeHash StandardCrypto AnchorData
-> Either ReadSafeHashError (SafeHash StandardCrypto AnchorData)
forall a b. b -> Either a b
Right (Hash (HASH StandardCrypto) AnchorData
-> SafeHash StandardCrypto AnchorData
forall c index. Hash (HASH c) index -> SafeHash c index
L.unsafeMakeSafeHash Hash Blake2b_256 AnchorData
Hash (HASH StandardCrypto) AnchorData
a)
    Maybe (Hash Blake2b_256 AnchorData)
Nothing -> ReadSafeHashError
-> Either ReadSafeHashError (SafeHash StandardCrypto AnchorData)
forall a b. a -> Either a b
Left (ReadSafeHashError
 -> Either ReadSafeHashError (SafeHash StandardCrypto AnchorData))
-> ReadSafeHashError
-> Either ReadSafeHashError (SafeHash StandardCrypto AnchorData)
forall a b. (a -> b) -> a -> b
$ Text -> ReadSafeHashError
ReadSafeHashErrorInvalidHash Text
"Unable to read hash"

readSafeHash :: Opt.ReadM (L.SafeHash L.StandardCrypto L.AnchorData)
readSafeHash :: ReadM (SafeHash StandardCrypto AnchorData)
readSafeHash =
  (String -> Either String (SafeHash StandardCrypto AnchorData))
-> ReadM (SafeHash StandardCrypto AnchorData)
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader ((String -> Either String (SafeHash StandardCrypto AnchorData))
 -> ReadM (SafeHash StandardCrypto AnchorData))
-> (String -> Either String (SafeHash StandardCrypto AnchorData))
-> ReadM (SafeHash StandardCrypto AnchorData)
forall a b. (a -> b) -> a -> b
$ \String
s ->
    Text
-> Either ReadSafeHashError (SafeHash StandardCrypto AnchorData)
readHexAsSafeHash (String -> Text
Text.pack String
s)
      Either ReadSafeHashError (SafeHash StandardCrypto AnchorData)
-> (Either ReadSafeHashError (SafeHash StandardCrypto AnchorData)
    -> Either String (SafeHash StandardCrypto AnchorData))
-> Either String (SafeHash StandardCrypto AnchorData)
forall a b. a -> (a -> b) -> b
& (ReadSafeHashError -> String)
-> Either ReadSafeHashError (SafeHash StandardCrypto AnchorData)
-> Either String (SafeHash StandardCrypto AnchorData)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> String
Text.unpack (Text -> String)
-> (ReadSafeHashError -> Text) -> ReadSafeHashError -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadSafeHashError -> Text
renderReadSafeHashError)

scriptHashReader :: Opt.ReadM ScriptHash
scriptHashReader :: ReadM ScriptHash
scriptHashReader = (String -> Either String ScriptHash) -> ReadM ScriptHash
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader ((String -> Either String ScriptHash) -> ReadM ScriptHash)
-> (String -> Either String ScriptHash) -> ReadM ScriptHash
forall a b. (a -> b) -> a -> b
$ ScriptHash -> Either String ScriptHash
forall a b. b -> Either a b
Right (ScriptHash -> Either String ScriptHash)
-> (String -> ScriptHash) -> String -> Either String ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ScriptHash
forall a. IsString a => String -> a
fromString

readVoteDelegationTarget
  :: ()
  => VoteDelegationTarget
  -> ExceptT DelegationError IO (L.DRep L.StandardCrypto)
readVoteDelegationTarget :: VoteDelegationTarget
-> ExceptT DelegationError IO (DRep StandardCrypto)
readVoteDelegationTarget VoteDelegationTarget
voteDelegationTarget =
  case VoteDelegationTarget
voteDelegationTarget of
    VoteDelegationTargetOfDRep DRepHashSource
drepHashSource ->
      (FileError InputDecodeError -> DelegationError)
-> ExceptT (FileError InputDecodeError) IO (DRep StandardCrypto)
-> ExceptT DelegationError IO (DRep StandardCrypto)
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError FileError InputDecodeError -> DelegationError
DelegationDRepReadError (ExceptT (FileError InputDecodeError) IO (DRep StandardCrypto)
 -> ExceptT DelegationError IO (DRep StandardCrypto))
-> ExceptT (FileError InputDecodeError) IO (DRep StandardCrypto)
-> ExceptT DelegationError IO (DRep StandardCrypto)
forall a b. (a -> b) -> a -> b
$
        Credential 'DRepRole StandardCrypto -> DRep StandardCrypto
forall c. Credential 'DRepRole c -> DRep c
L.DRepCredential (Credential 'DRepRole StandardCrypto -> DRep StandardCrypto)
-> ExceptT
     (FileError InputDecodeError)
     IO
     (Credential 'DRepRole StandardCrypto)
-> ExceptT (FileError InputDecodeError) IO (DRep StandardCrypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DRepHashSource
-> ExceptT
     (FileError InputDecodeError)
     IO
     (Credential 'DRepRole StandardCrypto)
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadIOTransError (FileError InputDecodeError) t m =>
DRepHashSource -> t m (Credential 'DRepRole StandardCrypto)
readDRepCredential DRepHashSource
drepHashSource
    VoteDelegationTarget
VoteDelegationTargetOfAbstain ->
      DRep StandardCrypto
-> ExceptT DelegationError IO (DRep StandardCrypto)
forall a. a -> ExceptT DelegationError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DRep StandardCrypto
forall c. DRep c
L.DRepAlwaysAbstain
    VoteDelegationTarget
VoteDelegationTargetOfNoConfidence ->
      DRep StandardCrypto
-> ExceptT DelegationError IO (DRep StandardCrypto)
forall a. a -> ExceptT DelegationError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DRep StandardCrypto
forall c. DRep c
L.DRepAlwaysNoConfidence

--- | Read the given file and hashes its content using 'Blake2b_256'
readShelleyOnwardsGenesisAndHash
  :: MonadIO m
  => FilePath
  -- ^ The file to read
  -> m (Crypto.Hash Crypto.Blake2b_256 BS.ByteString)
readShelleyOnwardsGenesisAndHash :: forall (m :: * -> *).
MonadIO m =>
String -> m (Hash Blake2b_256 ByteString)
readShelleyOnwardsGenesisAndHash String
path = do
  ByteString
content <- IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
BS.readFile String
path
  Hash Blake2b_256 ByteString -> m (Hash Blake2b_256 ByteString)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Hash Blake2b_256 ByteString -> m (Hash Blake2b_256 ByteString))
-> Hash Blake2b_256 ByteString -> m (Hash Blake2b_256 ByteString)
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString)
-> ByteString -> Hash Blake2b_256 ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Crypto.hashWith ByteString -> ByteString
forall a. a -> a
id ByteString
content