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

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

    -- * Script
  , ScriptWitnessError (..)
  , renderScriptWitnessError
  , ScriptDecodeError (..)
  , deserialiseScriptInAnyLang
  , readFileScriptInAnyLang
  , PlutusScriptDecodeError (..)

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

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

    -- * Tx witnesses
  , ReadWitnessSigningDataError (..)
  , renderReadWitnessSigningDataError
  , SomeSigningWitness (..)
  , ByronOrShelleyWitness (..)
  , mkShelleyBootstrapWitness
  , 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

    -- * 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 Cardano.Api.Byron qualified as Byron
import Cardano.Api.Ledger qualified as L
import Cardano.Api.Shelley as Api

import Cardano.Binary qualified as CBOR
import Cardano.CLI.EraBased.Script.Proposal.Read
import Cardano.CLI.EraBased.Script.Proposal.Type
  ( CliProposalScriptRequirements
  , ProposalScriptWitness
  )
import Cardano.CLI.EraBased.Script.Type
import Cardano.CLI.EraBased.Script.Vote.Read
import Cardano.CLI.EraBased.Script.Vote.Type
import Cardano.CLI.Type.Common
import Cardano.CLI.Type.Error.BootstrapWitnessError
import Cardano.CLI.Type.Error.DelegationError
import Cardano.CLI.Type.Error.PlutusScriptDecodeError
import Cardano.CLI.Type.Error.ScriptDataError
import Cardano.CLI.Type.Error.ScriptDecodeError
import Cardano.CLI.Type.Error.StakeCredentialError
import Cardano.CLI.Type.Governance
import Cardano.CLI.Type.Key
import Cardano.Crypto.Hash qualified as Crypto
import Cardano.Ledger.Api qualified as L
import Cardano.Ledger.Hashes qualified as L

import Prelude

import Control.Exception (bracket)
import Control.Monad (forM, unless, when)
import Data.Aeson qualified as Aeson
import Data.Bifunctor
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.ByteString.Base16 qualified as Base16
import Data.ByteString.Builder qualified as Builder
import Data.ByteString.Lazy.Char8 qualified as LBS
import Data.Function ((&))
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Data.List qualified as List
import Data.Proxy (Proxy (..))
import Data.String
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import Data.Text.Encoding.Error qualified as Text
import Data.Word
import GHC.IO.Handle (hClose, hIsSeekable)
import GHC.IO.Handle.FD (openFileBlocking)
import Options.Applicative qualified 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

readVerificationKeyOrHashOrFileOrScript
  :: MonadIOTransError (Either (FileError ScriptDecodeError) (FileError InputDecodeError)) t m
  => Key keyrole
  => AsType keyrole
  -> (Hash keyrole -> L.KeyHash kr)
  -> VerificationKeyOrHashOrFileOrScript keyrole
  -> t m (L.Credential kr)
readVerificationKeyOrHashOrFileOrScript :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) keyrole
       (kr :: KeyRole).
(MonadIOTransError
   (Either (FileError ScriptDecodeError) (FileError InputDecodeError))
   t
   m,
 Key keyrole) =>
AsType keyrole
-> (Hash keyrole -> KeyHash kr)
-> VerificationKeyOrHashOrFileOrScript keyrole
-> t m (Credential kr)
readVerificationKeyOrHashOrFileOrScript AsType keyrole
asType Hash keyrole -> KeyHash kr
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 -> t m (Credential kr)
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential kr -> t m (Credential kr))
-> (ScriptHash -> Credential kr)
-> ScriptHash
-> t m (Credential kr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> Credential kr
forall (kr :: KeyRole). ScriptHash -> Credential kr
L.ScriptHashObj (ScriptHash -> Credential kr)
-> (ScriptHash -> ScriptHash) -> ScriptHash -> Credential kr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> ScriptHash
toShelleyScriptHash (ScriptHash -> t m (Credential kr))
-> ScriptHash -> t m (Credential kr)
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)
-> t m (Hash keyrole) -> t m (Credential kr)
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 -> Credential kr
forall (kr :: KeyRole). KeyHash kr -> Credential kr
L.KeyHashObj (KeyHash kr -> Credential kr)
-> (Hash keyrole -> KeyHash kr) -> Hash keyrole -> Credential kr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash keyrole -> KeyHash kr
extractHash) (t m (Hash keyrole) -> t m (Credential kr))
-> (ExceptT (FileError InputDecodeError) m (Hash keyrole)
    -> t m (Hash keyrole))
-> ExceptT (FileError InputDecodeError) m (Hash keyrole)
-> t m (Credential kr)
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))
-> ExceptT (FileError InputDecodeError) m (Hash keyrole)
-> t m (Credential kr)
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)
  -> VerificationKeySource keyrole
  -> t m (L.Credential kr)
readVerificationKeySource :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) keyrole
       (kr :: KeyRole).
(MonadIOTransError
   (Either (FileError ScriptDecodeError) (FileError InputDecodeError))
   t
   m,
 Key keyrole) =>
AsType keyrole
-> (Hash keyrole -> KeyHash kr)
-> VerificationKeySource keyrole
-> t m (Credential kr)
readVerificationKeySource AsType keyrole
asType Hash keyrole -> KeyHash kr
extractHash = \case
  VksScriptHash (ScriptHash ScriptHash
scriptHash) ->
    Credential kr -> t m (Credential kr)
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential kr -> t m (Credential kr))
-> Credential kr -> t m (Credential kr)
forall a b. (a -> b) -> a -> b
$ ScriptHash -> Credential kr
forall (kr :: KeyRole). ScriptHash -> Credential kr
L.ScriptHashObj ScriptHash
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 -> t m (Credential kr)
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential kr -> t m (Credential kr))
-> (ScriptHash -> Credential kr)
-> ScriptHash
-> t m (Credential kr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> Credential kr
forall (kr :: KeyRole). ScriptHash -> Credential kr
L.ScriptHashObj (ScriptHash -> Credential kr)
-> (ScriptHash -> ScriptHash) -> ScriptHash -> Credential kr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> ScriptHash
toShelleyScriptHash (ScriptHash -> t m (Credential kr))
-> ScriptHash -> t m (Credential kr)
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)
-> t m (Hash keyrole) -> t m (Credential kr)
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 -> Credential kr
forall (kr :: KeyRole). KeyHash kr -> Credential kr
L.KeyHashObj (KeyHash kr -> Credential kr)
-> (Hash keyrole -> KeyHash kr) -> Hash keyrole -> Credential kr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash keyrole -> KeyHash kr
extractHash) (t m (Hash keyrole) -> t m (Credential kr))
-> (ExceptT (FileError InputDecodeError) m (Hash keyrole)
    -> t m (Hash keyrole))
-> ExceptT (FileError InputDecodeError) m (Hash keyrole)
-> t m (Credential kr)
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))
-> ExceptT (FileError InputDecodeError) m (Hash keyrole)
-> t m (Credential kr)
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)

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

-- | Construct a Shelley bootstrap witness (i.e. a Byron key witness in the
-- Shelley era).
mkShelleyBootstrapWitness
  :: ()
  => ShelleyBasedEra era
  -> Maybe NetworkId
  -> L.TxBody (ShelleyLedgerEra era)
  -> ShelleyBootstrapWitnessSigningKeyData
  -> Either BootstrapWitnessError (KeyWitness era)
mkShelleyBootstrapWitness :: forall era.
ShelleyBasedEra era
-> Maybe NetworkId
-> TxBody (ShelleyLedgerEra era)
-> ShelleyBootstrapWitnessSigningKeyData
-> Either BootstrapWitnessError (KeyWitness era)
mkShelleyBootstrapWitness ShelleyBasedEra era
_ Maybe NetworkId
Nothing TxBody (ShelleyLedgerEra era)
_ (ShelleyBootstrapWitnessSigningKeyData SigningKey ByronKey
_ Maybe (Address ByronAddr)
Nothing) =
  BootstrapWitnessError
-> Either BootstrapWitnessError (KeyWitness era)
forall a b. a -> Either a b
Left BootstrapWitnessError
MissingNetworkIdOrByronAddressError
mkShelleyBootstrapWitness ShelleyBasedEra era
sbe (Just NetworkId
nw) TxBody (ShelleyLedgerEra era)
txBody (ShelleyBootstrapWitnessSigningKeyData SigningKey ByronKey
skey Maybe (Address ByronAddr)
Nothing) =
  KeyWitness era -> Either BootstrapWitnessError (KeyWitness era)
forall a b. b -> Either a b
Right (KeyWitness era -> Either BootstrapWitnessError (KeyWitness era))
-> KeyWitness era -> Either BootstrapWitnessError (KeyWitness era)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> WitnessNetworkIdOrByronAddress
-> TxBody (ShelleyLedgerEra era)
-> SigningKey ByronKey
-> KeyWitness era
forall era.
ShelleyBasedEra era
-> WitnessNetworkIdOrByronAddress
-> TxBody (ShelleyLedgerEra era)
-> SigningKey ByronKey
-> KeyWitness era
makeShelleyBasedBootstrapWitness ShelleyBasedEra era
sbe (NetworkId -> WitnessNetworkIdOrByronAddress
Byron.WitnessNetworkId NetworkId
nw) TxBody (ShelleyLedgerEra era)
txBody SigningKey ByronKey
skey
mkShelleyBootstrapWitness ShelleyBasedEra era
sbe Maybe NetworkId
_ TxBody (ShelleyLedgerEra era)
txBody (ShelleyBootstrapWitnessSigningKeyData SigningKey ByronKey
skey (Just Address ByronAddr
addr)) =
  KeyWitness era -> Either BootstrapWitnessError (KeyWitness era)
forall a b. b -> Either a b
Right (KeyWitness era -> Either BootstrapWitnessError (KeyWitness era))
-> KeyWitness era -> Either BootstrapWitnessError (KeyWitness era)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era
-> WitnessNetworkIdOrByronAddress
-> TxBody (ShelleyLedgerEra era)
-> SigningKey ByronKey
-> KeyWitness era
forall era.
ShelleyBasedEra era
-> WitnessNetworkIdOrByronAddress
-> TxBody (ShelleyLedgerEra era)
-> SigningKey ByronKey
-> KeyWitness era
makeShelleyBasedBootstrapWitness ShelleyBasedEra era
sbe (Address ByronAddr -> WitnessNetworkIdOrByronAddress
Byron.WitnessByronAddress Address ByronAddr
addr) TxBody (ShelleyLedgerEra era)
txBody SigningKey ByronKey
skey

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

instance Error ReadWitnessSigningDataError where
  prettyError :: forall ann. ReadWitnessSigningDataError -> Doc ann
prettyError = \case
    ReadWitnessSigningDataSigningKeyDecodeError FileError InputDecodeError
fileErr ->
      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 ->
      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."

-- | 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.Type.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 DSIGN
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 DSIGN -> SigningKey PaymentKey
PaymentSigningKey SignKeyDSIGN DSIGN
sk

newtype VoteError
  = VoteErrorFile (FileError CliScriptWitnessError)

instance Show VoteError where
  show :: VoteError -> String
show = Doc Any -> String
forall a. Show a => a -> String
show (Doc Any -> String)
-> (VoteError -> Doc Any) -> VoteError -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VoteError -> Doc Any
forall e ann. Error e => e -> Doc ann
forall ann. VoteError -> Doc ann
prettyError

instance Error VoteError where
  prettyError :: forall ann. VoteError -> Doc ann
prettyError = \case
    VoteErrorFile FileError CliScriptWitnessError
e ->
      FileError CliScriptWitnessError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError CliScriptWitnessError -> Doc ann
prettyError FileError CliScriptWitnessError
e

-- 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.
readVotingProceduresFiles
  :: ConwayEraOnwards era
  -> [(VoteFile In, Maybe CliVoteScriptRequirements)]
  -> IO (Either VoteError [(VotingProcedures era, Maybe (VoteScriptWitness era))])
readVotingProceduresFiles :: forall era.
ConwayEraOnwards era
-> [(VoteFile 'In, Maybe CliVoteScriptRequirements)]
-> IO
     (Either
        VoteError [(VotingProcedures era, Maybe (VoteScriptWitness era))])
readVotingProceduresFiles ConwayEraOnwards era
w = \case
  [] -> Either
  VoteError [(VotingProcedures era, Maybe (VoteScriptWitness era))]
-> IO
     (Either
        VoteError [(VotingProcedures era, Maybe (VoteScriptWitness era))])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   VoteError [(VotingProcedures era, Maybe (VoteScriptWitness era))]
 -> IO
      (Either
         VoteError [(VotingProcedures era, Maybe (VoteScriptWitness era))]))
-> Either
     VoteError [(VotingProcedures era, Maybe (VoteScriptWitness era))]
-> IO
     (Either
        VoteError [(VotingProcedures era, Maybe (VoteScriptWitness era))])
forall a b. (a -> b) -> a -> b
$ [(VotingProcedures era, Maybe (VoteScriptWitness era))]
-> Either
     VoteError [(VotingProcedures era, Maybe (VoteScriptWitness era))]
forall a. a -> Either VoteError a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  [(VoteFile 'In, Maybe CliVoteScriptRequirements)]
files ->
    ExceptT
  VoteError
  IO
  [(VotingProcedures era, Maybe (VoteScriptWitness era))]
-> IO
     (Either
        VoteError [(VotingProcedures era, Maybe (VoteScriptWitness era))])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   VoteError
   IO
   [(VotingProcedures era, Maybe (VoteScriptWitness era))]
 -> IO
      (Either
         VoteError [(VotingProcedures era, Maybe (VoteScriptWitness era))]))
-> ExceptT
     VoteError
     IO
     [(VotingProcedures era, Maybe (VoteScriptWitness era))]
-> IO
     (Either
        VoteError [(VotingProcedures era, Maybe (VoteScriptWitness era))])
forall a b. (a -> b) -> a -> b
$ (FileError CliScriptWitnessError -> VoteError)
-> ExceptT
     (FileError CliScriptWitnessError)
     IO
     [(VotingProcedures era, Maybe (VoteScriptWitness era))]
-> ExceptT
     VoteError
     IO
     [(VotingProcedures era, Maybe (VoteScriptWitness era))]
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError CliScriptWitnessError -> VoteError
VoteErrorFile (ExceptT
   (FileError CliScriptWitnessError)
   IO
   [(VotingProcedures era, Maybe (VoteScriptWitness era))]
 -> ExceptT
      VoteError
      IO
      [(VotingProcedures era, Maybe (VoteScriptWitness era))])
-> ExceptT
     (FileError CliScriptWitnessError)
     IO
     [(VotingProcedures era, Maybe (VoteScriptWitness era))]
-> ExceptT
     VoteError
     IO
     [(VotingProcedures era, Maybe (VoteScriptWitness era))]
forall a b. (a -> b) -> a -> b
$ [(VoteFile 'In, Maybe CliVoteScriptRequirements)]
-> ((VoteFile 'In, Maybe CliVoteScriptRequirements)
    -> ExceptT
         (FileError CliScriptWitnessError)
         IO
         (VotingProcedures era, Maybe (VoteScriptWitness era)))
-> ExceptT
     (FileError CliScriptWitnessError)
     IO
     [(VotingProcedures era, Maybe (VoteScriptWitness era))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(VoteFile 'In, Maybe CliVoteScriptRequirements)]
files (ConwayEraOnwards era
-> (VoteFile 'In, Maybe CliVoteScriptRequirements)
-> ExceptT
     (FileError CliScriptWitnessError)
     IO
     (VotingProcedures era, Maybe (VoteScriptWitness era))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) era.
MonadIOTransError (FileError CliScriptWitnessError) t m =>
ConwayEraOnwards era
-> (VoteFile 'In, Maybe CliVoteScriptRequirements)
-> t m (VotingProcedures era, Maybe (VoteScriptWitness era))
readVoteScriptWitness 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))

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 CliScriptWitnessError)
  | ProposalNotSupportedInEra AnyCardanoEra
  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

instance Error ProposalError where
  prettyError :: forall ann. ProposalError -> Doc ann
prettyError = ProposalError -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow

readTxGovernanceActions
  :: ShelleyBasedEra era
  -> [(ProposalFile In, Maybe CliProposalScriptRequirements)]
  -> IO (Either ProposalError [(Proposal era, Maybe (ProposalScriptWitness era))])
readTxGovernanceActions :: forall era.
ShelleyBasedEra era
-> [(File () 'In, Maybe CliProposalScriptRequirements)]
-> IO
     (Either
        ProposalError [(Proposal era, Maybe (ProposalScriptWitness era))])
readTxGovernanceActions ShelleyBasedEra era
_ [] = Either
  ProposalError [(Proposal era, Maybe (ProposalScriptWitness era))]
-> IO
     (Either
        ProposalError [(Proposal era, Maybe (ProposalScriptWitness era))])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
   ProposalError [(Proposal era, Maybe (ProposalScriptWitness era))]
 -> IO
      (Either
         ProposalError [(Proposal era, Maybe (ProposalScriptWitness era))]))
-> Either
     ProposalError [(Proposal era, Maybe (ProposalScriptWitness era))]
-> IO
     (Either
        ProposalError [(Proposal era, Maybe (ProposalScriptWitness era))])
forall a b. (a -> b) -> a -> b
$ [(Proposal era, Maybe (ProposalScriptWitness era))]
-> Either
     ProposalError [(Proposal era, Maybe (ProposalScriptWitness era))]
forall a b. b -> Either a b
Right []
readTxGovernanceActions ShelleyBasedEra era
era [(File () 'In, Maybe CliProposalScriptRequirements)]
files = ExceptT
  ProposalError
  IO
  [(Proposal era, Maybe (ProposalScriptWitness era))]
-> IO
     (Either
        ProposalError [(Proposal era, Maybe (ProposalScriptWitness era))])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   ProposalError
   IO
   [(Proposal era, Maybe (ProposalScriptWitness era))]
 -> IO
      (Either
         ProposalError [(Proposal era, Maybe (ProposalScriptWitness era))]))
-> ExceptT
     ProposalError
     IO
     [(Proposal era, Maybe (ProposalScriptWitness era))]
-> IO
     (Either
        ProposalError [(Proposal era, Maybe (ProposalScriptWitness 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 (ProposalScriptWitness era))])
-> ExceptT
     ProposalError
     IO
     [(Proposal era, Maybe (ProposalScriptWitness era))]
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO
   (Either
      ProposalError [(Proposal era, Maybe (ProposalScriptWitness era))])
 -> ExceptT
      ProposalError
      IO
      [(Proposal era, Maybe (ProposalScriptWitness era))])
-> IO
     (Either
        ProposalError [(Proposal era, Maybe (ProposalScriptWitness era))])
-> ExceptT
     ProposalError
     IO
     [(Proposal era, Maybe (ProposalScriptWitness era))]
forall a b. (a -> b) -> a -> b
$ [Either
   ProposalError (Proposal era, Maybe (ProposalScriptWitness era))]
-> Either
     ProposalError [(Proposal era, Maybe (ProposalScriptWitness 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 (ProposalScriptWitness era))]
 -> Either
      ProposalError [(Proposal era, Maybe (ProposalScriptWitness era))])
-> IO
     [Either
        ProposalError (Proposal era, Maybe (ProposalScriptWitness era))]
-> IO
     (Either
        ProposalError [(Proposal era, Maybe (ProposalScriptWitness era))])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((File () 'In, Maybe CliProposalScriptRequirements)
 -> IO
      (Either
         ProposalError (Proposal era, Maybe (ProposalScriptWitness era))))
-> [(File () 'In, Maybe CliProposalScriptRequirements)]
-> IO
     [Either
        ProposalError (Proposal era, Maybe (ProposalScriptWitness 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 CliProposalScriptRequirements)
-> IO
     (Either
        ProposalError (Proposal era, Maybe (ProposalScriptWitness era)))
forall era.
ConwayEraOnwards era
-> (File () 'In, Maybe CliProposalScriptRequirements)
-> IO
     (Either
        ProposalError (Proposal era, Maybe (ProposalScriptWitness era)))
readProposal ConwayEraOnwards era
w) [(File () 'In, Maybe CliProposalScriptRequirements)]
files

readProposal
  :: ConwayEraOnwards era
  -> (ProposalFile In, Maybe CliProposalScriptRequirements)
  -> IO (Either ProposalError (Proposal era, Maybe (ProposalScriptWitness era)))
readProposal :: forall era.
ConwayEraOnwards era
-> (File () 'In, Maybe CliProposalScriptRequirements)
-> IO
     (Either
        ProposalError (Proposal era, Maybe (ProposalScriptWitness era)))
readProposal ConwayEraOnwards era
w (File () 'In
fp, Maybe CliProposalScriptRequirements
mScriptWit) = do
  ExceptT
  ProposalError IO (Proposal era, Maybe (ProposalScriptWitness era))
-> IO
     (Either
        ProposalError (Proposal era, Maybe (ProposalScriptWitness era)))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   ProposalError IO (Proposal era, Maybe (ProposalScriptWitness era))
 -> IO
      (Either
         ProposalError (Proposal era, Maybe (ProposalScriptWitness era))))
-> ExceptT
     ProposalError IO (Proposal era, Maybe (ProposalScriptWitness era))
-> IO
     (Either
        ProposalError (Proposal era, Maybe (ProposalScriptWitness era)))
forall a b. (a -> b) -> a -> b
$
    (FileError CliScriptWitnessError -> ProposalError)
-> ExceptT
     (FileError CliScriptWitnessError)
     IO
     (Proposal era, Maybe (ProposalScriptWitness era))
-> ExceptT
     ProposalError IO (Proposal era, Maybe (ProposalScriptWitness era))
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError CliScriptWitnessError -> ProposalError
ProposalErrorFile (ExceptT
   (FileError CliScriptWitnessError)
   IO
   (Proposal era, Maybe (ProposalScriptWitness era))
 -> ExceptT
      ProposalError IO (Proposal era, Maybe (ProposalScriptWitness era)))
-> ExceptT
     (FileError CliScriptWitnessError)
     IO
     (Proposal era, Maybe (ProposalScriptWitness era))
-> ExceptT
     ProposalError IO (Proposal era, Maybe (ProposalScriptWitness era))
forall a b. (a -> b) -> a -> b
$
      ConwayEraOnwards era
-> (File () 'In, Maybe CliProposalScriptRequirements)
-> ExceptT
     (FileError CliScriptWitnessError)
     IO
     (Proposal era, Maybe (ProposalScriptWitness era))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) era.
MonadIOTransError (FileError CliScriptWitnessError) t m =>
ConwayEraOnwards era
-> (File () 'In, Maybe CliProposalScriptRequirements)
-> t m (Proposal era, Maybe (ProposalScriptWitness era))
readProposalScriptWitness ConwayEraOnwards era
w (File () 'In
fp, Maybe CliProposalScriptRequirements
mScriptWit)

constitutionHashSourceToHash
  :: ()
  => ConstitutionHashSource
  -> ExceptT ConstitutionError IO (L.SafeHash L.AnchorData)
constitutionHashSourceToHash :: ConstitutionHashSource
-> ExceptT ConstitutionError IO (SafeHash 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 AnchorData
-> ExceptT ConstitutionError IO (SafeHash AnchorData)
forall a. a -> ExceptT ConstitutionError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SafeHash AnchorData
 -> ExceptT ConstitutionError IO (SafeHash AnchorData))
-> SafeHash AnchorData
-> ExceptT ConstitutionError IO (SafeHash AnchorData)
forall a b. (a -> b) -> a -> b
$ AnchorData -> SafeHash AnchorData
forall x i. HashAnnotated x i => x -> SafeHash i
L.hashAnnotated (AnchorData -> SafeHash AnchorData)
-> AnchorData -> SafeHash AnchorData
forall a b. (a -> b) -> a -> b
$ ByteString -> AnchorData
L.AnchorData ByteString
cBs
    ConstitutionHashSourceText Text
c -> do
      SafeHash AnchorData
-> ExceptT ConstitutionError IO (SafeHash AnchorData)
forall a. a -> ExceptT ConstitutionError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SafeHash AnchorData
 -> ExceptT ConstitutionError IO (SafeHash AnchorData))
-> SafeHash AnchorData
-> ExceptT ConstitutionError IO (SafeHash AnchorData)
forall a b. (a -> b) -> a -> b
$ AnchorData -> SafeHash AnchorData
forall x i. HashAnnotated x i => x -> SafeHash i
L.hashAnnotated (AnchorData -> SafeHash AnchorData)
-> AnchorData -> SafeHash 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 AnchorData
h ->
      SafeHash AnchorData
-> ExceptT ConstitutionError IO (SafeHash AnchorData)
forall a. a -> ExceptT ConstitutionError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SafeHash 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 :: * -> *) e a. Monad m => e -> ExceptT e 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)
getDRepCredentialFromVerKeyHashOrFile :: forall (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadIOTransError (FileError InputDecodeError) t m =>
VerificationKeyOrHashOrFile DRepKey -> t m (Credential 'DRepRole)
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 -> t m (Credential 'DRepRole)
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential 'DRepRole -> t m (Credential 'DRepRole))
-> (Hash DRepKey -> Credential 'DRepRole)
-> Hash DRepKey
-> t m (Credential 'DRepRole)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'DRepRole -> Credential 'DRepRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
L.KeyHashObj (KeyHash 'DRepRole -> Credential 'DRepRole)
-> (Hash DRepKey -> KeyHash 'DRepRole)
-> Hash DRepKey
-> Credential 'DRepRole
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash DRepKey -> KeyHash 'DRepRole
unDRepKeyHash (Hash DRepKey -> t m (Credential 'DRepRole))
-> Hash DRepKey -> t m (Credential 'DRepRole)
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 -> t m (Credential 'DRepRole)
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential 'DRepRole -> t m (Credential 'DRepRole))
-> (KeyHash 'DRepRole -> Credential 'DRepRole)
-> KeyHash 'DRepRole
-> t m (Credential 'DRepRole)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'DRepRole -> Credential 'DRepRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
L.KeyHashObj (KeyHash 'DRepRole -> t m (Credential 'DRepRole))
-> KeyHash 'DRepRole -> t m (Credential 'DRepRole)
forall a b. (a -> b) -> a -> b
$ Hash DRepKey -> KeyHash 'DRepRole
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.AnchorData)
readHexAsSafeHash :: Text -> Either ReadSafeHashError (SafeHash 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 HASH AnchorData)
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Crypto.hashFromBytes ByteString
raw of
    Just Hash HASH AnchorData
a -> SafeHash AnchorData
-> Either ReadSafeHashError (SafeHash AnchorData)
forall a b. b -> Either a b
Right (Hash HASH AnchorData -> SafeHash AnchorData
forall i. Hash HASH i -> SafeHash i
L.unsafeMakeSafeHash Hash HASH AnchorData
a)
    Maybe (Hash HASH AnchorData)
Nothing -> ReadSafeHashError -> Either ReadSafeHashError (SafeHash AnchorData)
forall a b. a -> Either a b
Left (ReadSafeHashError
 -> Either ReadSafeHashError (SafeHash AnchorData))
-> ReadSafeHashError
-> Either ReadSafeHashError (SafeHash AnchorData)
forall a b. (a -> b) -> a -> b
$ Text -> ReadSafeHashError
ReadSafeHashErrorInvalidHash Text
"Unable to read hash"

readSafeHash :: Opt.ReadM (L.SafeHash L.AnchorData)
readSafeHash :: ReadM (SafeHash AnchorData)
readSafeHash =
  (String -> Either String (SafeHash AnchorData))
-> ReadM (SafeHash AnchorData)
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader ((String -> Either String (SafeHash AnchorData))
 -> ReadM (SafeHash AnchorData))
-> (String -> Either String (SafeHash AnchorData))
-> ReadM (SafeHash AnchorData)
forall a b. (a -> b) -> a -> b
$ \String
s ->
    Text -> Either ReadSafeHashError (SafeHash AnchorData)
readHexAsSafeHash (String -> Text
Text.pack String
s)
      Either ReadSafeHashError (SafeHash AnchorData)
-> (Either ReadSafeHashError (SafeHash AnchorData)
    -> Either String (SafeHash AnchorData))
-> Either String (SafeHash AnchorData)
forall a b. a -> (a -> b) -> b
& (ReadSafeHashError -> String)
-> Either ReadSafeHashError (SafeHash AnchorData)
-> Either String (SafeHash 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
readVoteDelegationTarget :: VoteDelegationTarget -> ExceptT DelegationError IO DRep
readVoteDelegationTarget VoteDelegationTarget
voteDelegationTarget =
  case VoteDelegationTarget
voteDelegationTarget of
    VoteDelegationTargetOfDRep DRepHashSource
drepHashSource ->
      (FileError InputDecodeError -> DelegationError)
-> ExceptT (FileError InputDecodeError) IO DRep
-> ExceptT DelegationError IO DRep
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
 -> ExceptT DelegationError IO DRep)
-> ExceptT (FileError InputDecodeError) IO DRep
-> ExceptT DelegationError IO DRep
forall a b. (a -> b) -> a -> b
$
        Credential 'DRepRole -> DRep
L.DRepCredential (Credential 'DRepRole -> DRep)
-> ExceptT (FileError InputDecodeError) IO (Credential 'DRepRole)
-> ExceptT (FileError InputDecodeError) IO DRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DRepHashSource
-> ExceptT (FileError InputDecodeError) IO (Credential 'DRepRole)
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadIOTransError (FileError InputDecodeError) t m =>
DRepHashSource -> t m (Credential 'DRepRole)
readDRepCredential DRepHashSource
drepHashSource
    VoteDelegationTarget
VoteDelegationTargetOfAbstain ->
      DRep -> ExceptT DelegationError IO DRep
forall a. a -> ExceptT DelegationError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DRep
L.DRepAlwaysAbstain
    VoteDelegationTarget
VoteDelegationTargetOfNoConfidence ->
      DRep -> ExceptT DelegationError IO DRep
forall a. a -> ExceptT DelegationError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DRep
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 HASH 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 HASH ByteString -> m (Hash HASH ByteString)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Hash HASH ByteString -> m (Hash HASH ByteString))
-> Hash HASH ByteString -> m (Hash HASH ByteString)
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString) -> ByteString -> Hash HASH ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Crypto.hashWith ByteString -> ByteString
forall a. a -> a
id ByteString
content