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

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

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

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

    -- * Tx
  , IncompleteTxBody (..)
  , readFileTx
  , readFileTxBody
  , readTx -- For testing purposes

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

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

    -- * Governance related
  , ConstitutionError (..)
  , VoteError (..)
  , CostModelsError (..)
  , readCostModels

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

    -- * Stake credentials
  , getStakeCredentialFromVerifier
  , getStakeCredentialFromIdentifier
  , getStakeAddressFromVerifier

    -- * Stake pool credentials
  , getHashFromStakePoolKeyHashSource
  , getVerificationKeyFromStakePoolVerificationKeySource

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

    -- * Update proposals
  , readTxUpdateProposal

    -- * Vote related
  , readVoteDelegationTarget
  , readVerificationKeySource

    -- * Genesis hashes
  , readShelleyOnwardsGenesisAndHash
  , readFileCli

    -- * Plutus
  , readFilePlutusScript

    -- * utilities
  , readerFromParsecParser
  )
where

import Cardano.Api as Api
import Cardano.Api.Byron (ByronKey)
import Cardano.Api.Byron qualified as Byron
import Cardano.Api.Experimental qualified as Exp
import Cardano.Api.Ledger qualified as L
import Cardano.Api.Parser.Text qualified as P

import Cardano.CLI.Compatible.Exception
import Cardano.CLI.EraBased.Script.Type
import Cardano.CLI.Type.Common
import Cardano.CLI.Type.Error.BootstrapWitnessError
import Cardano.CLI.Type.Error.PlutusScriptDecodeError
import Cardano.CLI.Type.Error.ScriptDataError
import Cardano.CLI.Type.Error.ScriptDecodeError
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 RIO (readFileBinary)
import Prelude

import Control.Exception (bracket)
import Control.Monad (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.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 GHC.IO.Handle (hClose, hIsSeekable)
import GHC.IO.Handle.FD (openFileBlocking)
import GHC.Stack
import Options.Applicative qualified as Opt
import System.IO (IOMode (ReadMode))

-- Metadata

readTxMetadata
  :: Exp.Era era
  -> TxMetadataJsonSchema
  -> [MetadataFile]
  -> CIO e (TxMetadataInEra era)
readTxMetadata :: forall era e.
Era era
-> TxMetadataJsonSchema
-> [MetadataFile]
-> CIO e (TxMetadataInEra era)
readTxMetadata Era era
_ TxMetadataJsonSchema
_ [] = TxMetadataInEra era -> RIO e (TxMetadataInEra era)
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return TxMetadataInEra era
forall era. TxMetadataInEra era
TxMetadataNone
readTxMetadata Era era
era TxMetadataJsonSchema
schema [MetadataFile]
files = do
  [TxMetadata]
metadata <- (MetadataFile -> RIO e TxMetadata)
-> [MetadataFile] -> RIO e [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 -> CIO e TxMetadata
forall e. TxMetadataJsonSchema -> MetadataFile -> CIO e TxMetadata
readFileTxMetadata TxMetadataJsonSchema
schema) [MetadataFile]
files
  TxMetadataInEra era -> RIO e (TxMetadataInEra era)
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxMetadataInEra era -> RIO e (TxMetadataInEra era))
-> TxMetadataInEra era -> RIO e (TxMetadataInEra era)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra era -> TxMetadata -> TxMetadataInEra era
forall era.
ShelleyBasedEra era -> TxMetadata -> TxMetadataInEra era
TxMetadataInEra (Era era -> ShelleyBasedEra era
forall era. Era era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era 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
  -> CIO e TxMetadata
readFileTxMetadata :: forall e. TxMetadataJsonSchema -> MetadataFile -> CIO e TxMetadata
readFileTxMetadata TxMetadataJsonSchema
mapping (MetadataFileJSON File () 'In
fp) = do
  ByteString
bs <- String -> RIO e ByteString
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
String -> m ByteString
readFileCli (File () 'In -> String
forall content (direction :: FileDirection).
File content direction -> String
unFile File () 'In
fp)
  Value
v <-
    Either String Value -> RIO e Value
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli (Either String Value -> RIO e Value)
-> Either String Value -> RIO e Value
forall a b. (a -> b) -> a -> b
$
      ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode' (ByteString -> Either String Value)
-> ByteString -> Either String Value
forall a b. (a -> b) -> a -> b
$
        ByteString -> ByteString
LBS.fromStrict ByteString
bs
  TxMetadata
txMetadata' <-
    Either TxMetadataJsonError TxMetadata -> RIO e TxMetadata
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli (Either TxMetadataJsonError TxMetadata -> RIO e TxMetadata)
-> Either TxMetadataJsonError TxMetadata -> RIO e TxMetadata
forall a b. (a -> b) -> a -> b
$
      TxMetadataJsonSchema
-> Value -> Either TxMetadataJsonError TxMetadata
metadataFromJson TxMetadataJsonSchema
mapping Value
v

  Either [(Word64, TxMetadataRangeError)] () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli (Either [(Word64, TxMetadataRangeError)] () -> RIO e ())
-> Either [(Word64, TxMetadataRangeError)] () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ TxMetadata -> Either [(Word64, TxMetadataRangeError)] ()
validateTxMetadata TxMetadata
txMetadata'

  TxMetadata -> RIO e TxMetadata
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return TxMetadata
txMetadata'
readFileTxMetadata TxMetadataJsonSchema
_ (MetadataFileCBOR File () 'In
fp) = do
  ByteString
bs <- String -> RIO e ByteString
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
String -> m ByteString
readFileCli (File () 'In -> String
forall content (direction :: FileDirection).
File content direction -> String
unFile File () 'In
fp)
  TxMetadata
txMetadata' <-
    Either DecoderError TxMetadata -> RIO e TxMetadata
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli (Either DecoderError TxMetadata -> RIO e TxMetadata)
-> Either DecoderError TxMetadata -> RIO e 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
  Either [(Word64, TxMetadataRangeError)] TxMetadata
-> RIO e TxMetadata
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli (Either [(Word64, TxMetadataRangeError)] TxMetadata
 -> RIO e TxMetadata)
-> Either [(Word64, TxMetadataRangeError)] TxMetadata
-> RIO e 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

readVerificationKeySource
  :: Key keyrole
  => (Hash keyrole -> L.KeyHash kr)
  -> VerificationKeySource keyrole
  -> CIO e (L.Credential kr)
readVerificationKeySource :: forall keyrole (kr :: KeyRole) e.
Key keyrole =>
(Hash keyrole -> KeyHash kr)
-> VerificationKeySource keyrole -> CIO e (Credential kr)
readVerificationKeySource Hash keyrole -> KeyHash kr
extractHash = \case
  VksScriptHash (ScriptHash ScriptHash
scriptHash) ->
    Credential kr -> RIO e (Credential kr)
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential kr -> RIO e (Credential kr))
-> Credential kr -> RIO e (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 <-
      String -> RIO e ScriptInAnyLang
forall (m :: * -> *). MonadIO m => String -> m ScriptInAnyLang
readFileScriptInAnyLang String
fp
    Credential kr -> RIO e (Credential kr)
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential kr -> RIO e (Credential kr))
-> (ScriptHash -> Credential kr)
-> ScriptHash
-> RIO e (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 -> RIO e (Credential kr))
-> ScriptHash -> RIO e (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 ->
    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 (Hash keyrole -> Credential kr)
-> RIO e (Hash keyrole) -> RIO e (Credential kr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VerificationKeyOrHashOrFile keyrole -> CIO e (Hash keyrole)
forall keyrole e.
Key keyrole =>
VerificationKeyOrHashOrFile keyrole -> CIO e (Hash keyrole)
readVerificationKeyOrHashOrTextEnvFile 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
  :: MonadIO m
  => FilePath
  -> m ScriptInAnyLang
readFileScriptInAnyLang :: forall (m :: * -> *). MonadIO m => String -> m ScriptInAnyLang
readFileScriptInAnyLang String
file = do
  ByteString
scriptBytes <-
    String -> m ByteString
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
String -> m ByteString
readFileCli
      String
file
  Either ScriptDecodeError ScriptInAnyLang -> m ScriptInAnyLang
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli (Either ScriptDecodeError ScriptInAnyLang -> m ScriptInAnyLang)
-> Either ScriptDecodeError ScriptInAnyLang -> 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 ByteString -> Either JsonDecodeError TextEnvelope
forall a. FromJSON a => ByteString -> Either JsonDecodeError a
deserialiseFromJSON 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

readFileTx :: FileOrPipe -> IO (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
readFileTx :: FileOrPipe
-> IO
     (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
readFileTx FileOrPipe
file = do
  Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx)
cddlTxOrErr <- FileOrPipe
-> IO
     (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
readTx FileOrPipe
file
  case Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx)
cddlTxOrErr of
    Left FileError TextEnvelopeError
e -> Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx)
-> IO
     (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx)
 -> IO
      (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx)))
-> Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx)
-> IO
     (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
forall a b. (a -> b) -> a -> b
$ FileError TextEnvelopeError
-> Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx)
forall a b. a -> Either a b
Left FileError TextEnvelopeError
e
    Right InAnyShelleyBasedEra Tx
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
cddlTx
      Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx)
-> IO
     (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx)
 -> IO
      (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx)))
-> Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx)
-> IO
     (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
forall a b. (a -> b) -> a -> b
$ InAnyShelleyBasedEra Tx
-> Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx)
forall a b. b -> Either a b
Right (InAnyShelleyBasedEra Tx
 -> Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
-> InAnyShelleyBasedEra Tx
-> Either (FileError TextEnvelopeError) (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 IncompleteTxBody
  = IncompleteTxBody {IncompleteTxBody -> InAnyShelleyBasedEra TxBody
unIncompleteTxBody :: InAnyShelleyBasedEra TxBody}

readFileTxBody :: FileOrPipe -> IO (Either (FileError TextEnvelopeError) IncompleteTxBody)
readFileTxBody :: FileOrPipe
-> IO (Either (FileError TextEnvelopeError) IncompleteTxBody)
readFileTxBody FileOrPipe
file = do
  Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx)
cddlTxOrErr <- FileOrPipe
-> IO
     (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
readTx FileOrPipe
file
  case Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx)
cddlTxOrErr of
    Left FileError TextEnvelopeError
e -> Either (FileError TextEnvelopeError) IncompleteTxBody
-> IO (Either (FileError TextEnvelopeError) IncompleteTxBody)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (FileError TextEnvelopeError) IncompleteTxBody
 -> IO (Either (FileError TextEnvelopeError) IncompleteTxBody))
-> Either (FileError TextEnvelopeError) IncompleteTxBody
-> IO (Either (FileError TextEnvelopeError) IncompleteTxBody)
forall a b. (a -> b) -> a -> b
$ FileError TextEnvelopeError
-> Either (FileError TextEnvelopeError) IncompleteTxBody
forall a b. a -> Either a b
Left FileError TextEnvelopeError
e
    Right InAnyShelleyBasedEra Tx
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
cddlTx
      Either (FileError TextEnvelopeError) IncompleteTxBody
-> IO (Either (FileError TextEnvelopeError) IncompleteTxBody)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (FileError TextEnvelopeError) IncompleteTxBody
 -> IO (Either (FileError TextEnvelopeError) IncompleteTxBody))
-> Either (FileError TextEnvelopeError) IncompleteTxBody
-> IO (Either (FileError TextEnvelopeError) IncompleteTxBody)
forall a b. (a -> b) -> a -> b
$ IncompleteTxBody
-> Either (FileError TextEnvelopeError) IncompleteTxBody
forall a b. b -> Either a b
Right (IncompleteTxBody
 -> Either (FileError TextEnvelopeError) IncompleteTxBody)
-> IncompleteTxBody
-> Either (FileError TextEnvelopeError) IncompleteTxBody
forall a b. (a -> b) -> a -> b
$ InAnyShelleyBasedEra TxBody -> IncompleteTxBody
IncompleteTxBody (InAnyShelleyBasedEra TxBody -> IncompleteTxBody)
-> InAnyShelleyBasedEra TxBody -> IncompleteTxBody
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

readTx :: FileOrPipe -> IO (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
readTx :: FileOrPipe
-> IO
     (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
readTx =
  [FromSomeType HasTextEnvelope (InAnyShelleyBasedEra Tx)]
-> FileOrPipe
-> IO
     (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra Tx))
forall b.
[FromSomeType HasTextEnvelope b]
-> FileOrPipe -> IO (Either (FileError TextEnvelopeError) b)
readFileOrPipeTextEnvelopeAnyOf [FromSomeType HasTextEnvelope (InAnyShelleyBasedEra Tx)]
fromSomeShelleyTx

fromSomeShelleyTx :: [FromSomeType HasTextEnvelope (InAnyShelleyBasedEra Tx)]
fromSomeShelleyTx :: [FromSomeType HasTextEnvelope (InAnyShelleyBasedEra Tx)]
fromSomeShelleyTx =
  [ ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    FromSomeType HasTextEnvelope (InAnyShelleyBasedEra Tx))
-> FromSomeType HasTextEnvelope (InAnyShelleyBasedEra Tx)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era =>
  FromSomeType HasTextEnvelope (InAnyShelleyBasedEra Tx))
 -> FromSomeType HasTextEnvelope (InAnyShelleyBasedEra Tx))
-> (ShelleyBasedEraConstraints era =>
    FromSomeType HasTextEnvelope (InAnyShelleyBasedEra Tx))
-> FromSomeType HasTextEnvelope (InAnyShelleyBasedEra Tx)
forall a b. (a -> b) -> a -> b
$ AsType (Tx era)
-> (Tx era -> InAnyShelleyBasedEra Tx)
-> FromSomeType HasTextEnvelope (InAnyShelleyBasedEra Tx)
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (ShelleyBasedEra era -> AsType (Tx era)
forall era.
HasTypeProxy era =>
ShelleyBasedEra era -> AsType (Tx era)
makeTxProxy ShelleyBasedEra era
sbe) (ShelleyBasedEra era -> Tx era -> InAnyShelleyBasedEra Tx
forall era (thing :: * -> *).
Typeable era =>
ShelleyBasedEra era -> thing era -> InAnyShelleyBasedEra thing
InAnyShelleyBasedEra ShelleyBasedEra era
sbe)
  | AnyShelleyBasedEra ShelleyBasedEra era
sbe <- [AnyShelleyBasedEra
forall a. Bounded a => a
minBound .. AnyShelleyBasedEra
forall a. Bounded a => a
maxBound]
  ]
 where
  makeTxProxy :: HasTypeProxy era => ShelleyBasedEra era -> AsType (Tx era)
  makeTxProxy :: forall era.
HasTypeProxy era =>
ShelleyBasedEra era -> AsType (Tx era)
makeTxProxy ShelleyBasedEra era
_ = AsType era -> AsType (Tx era)
forall era. AsType era -> AsType (Tx era)
AsTx (Proxy era -> AsType era
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType (Proxy era
forall {lang}. Proxy lang
forall {k} (t :: k). Proxy t
Proxy :: Proxy era))

-- Tx witnesses

readFileTxKeyWitness
  :: FilePath
  -> IO (Either (FileError TextEnvelopeError) (InAnyShelleyBasedEra KeyWitness))
readFileTxKeyWitness :: String
-> IO
     (Either
        (FileError TextEnvelopeError) (InAnyShelleyBasedEra KeyWitness))
readFileTxKeyWitness String
fp = do
  FileOrPipe
file <- String -> IO FileOrPipe
fileOrPipe String
fp
  (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

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)
  | AStakePoolExtendedSigningWitness (SigningKey StakePoolExtendedKey)
  | 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)
    AStakePoolExtendedSigningWitness SigningKey StakePoolExtendedKey
sk -> ShelleyWitnessSigningKey -> ByronOrShelleyWitness
AShelleyKeyWitness (SigningKey StakePoolExtendedKey -> ShelleyWitnessSigningKey
WitnessStakePoolExtendedKey SigningKey StakePoolExtendedKey
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)
readFormattedFileAnyOf [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 StakePoolExtendedKey)
-> (SigningKey StakePoolExtendedKey -> SomeSigningWitness)
-> FromSomeType HasTextEnvelope SomeSigningWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType StakePoolExtendedKey
-> AsType (SigningKey StakePoolExtendedKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakePoolExtendedKey
AsStakePoolExtendedKey) SigningKey StakePoolExtendedKey -> SomeSigningWitness
AStakePoolExtendedSigningWitness
    , 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
    , AsType (SigningKey StakePoolExtendedKey)
-> (SigningKey StakePoolExtendedKey -> SomeSigningWitness)
-> FromSomeType SerialiseAsBech32 SomeSigningWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType StakePoolExtendedKey
-> AsType (SigningKey StakePoolExtendedKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakePoolExtendedKey
AsStakePoolExtendedKey) SigningKey StakePoolExtendedKey -> SomeSigningWitness
AStakePoolExtendedSigningWitness
    ]

-- 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)
readFormattedFileAnyOf [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 StakePoolExtendedKey)
-> (SigningKey StakePoolExtendedKey -> SomeSigningWitness)
-> FromSomeType HasTextEnvelope SomeSigningWitness
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType StakePoolExtendedKey
-> AsType (SigningKey StakePoolExtendedKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType StakePoolExtendedKey
AsStakePoolExtendedKey) SigningKey StakePoolExtendedKey -> SomeSigningWitness
AStakePoolExtendedSigningWitness
    , 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

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 (File Any 'In
-> IO (Either (FileError TextEnvelopeError) UpdateProposal)
forall a content.
HasTextEnvelope a =>
File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (String -> File Any 'In
forall content (direction :: FileDirection).
String -> File content direction
File String
upFp))

newtype ConstitutionError
  = 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 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 :: * -> *) e a. Monad m => Either e a -> ExceptT e 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 :: * -> *) e a. Monad m => Either e a -> ExceptT e 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

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

getStakeCredentialFromVerifier
  :: ()
  => StakeVerifier
  -> CIO e StakeCredential
getStakeCredentialFromVerifier :: forall e. StakeVerifier -> CIO e StakeCredential
getStakeCredentialFromVerifier = \case
  StakeVerifierScriptFile (File String
sFile) -> do
    ScriptInAnyLang ScriptLanguage lang
_ Script lang
script <-
      String -> RIO e ScriptInAnyLang
forall (m :: * -> *). MonadIO m => String -> m ScriptInAnyLang
readFileScriptInAnyLang String
sFile
    StakeCredential -> RIO e StakeCredential
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StakeCredential -> RIO e StakeCredential)
-> StakeCredential -> RIO e 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 <-
      VerificationKeyOrHashOrFile StakeKey -> CIO e (Hash StakeKey)
forall keyrole e.
(Key keyrole, SerialiseAsBech32 (VerificationKey keyrole)) =>
VerificationKeyOrHashOrFile keyrole -> CIO e (Hash keyrole)
readVerificationKeyOrHashOrFile VerificationKeyOrHashOrFile StakeKey
stakeVerKeyOrFile
    StakeCredential -> RIO e StakeCredential
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StakeCredential -> RIO e StakeCredential)
-> StakeCredential -> RIO e StakeCredential
forall a b. (a -> b) -> a -> b
$ Hash StakeKey -> StakeCredential
StakeCredentialByKey Hash StakeKey
stakeVerKeyHash

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

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

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 = Parser ScriptHash -> ReadM ScriptHash
forall a. Parser a -> ReadM a
readerFromParsecParser Parser ScriptHash
parseScriptHash

readVoteDelegationTarget
  :: ()
  => VoteDelegationTarget
  -> CIO e L.DRep
readVoteDelegationTarget :: forall e. VoteDelegationTarget -> CIO e DRep
readVoteDelegationTarget VoteDelegationTarget
voteDelegationTarget =
  case VoteDelegationTarget
voteDelegationTarget of
    VoteDelegationTargetOfDRep DRepHashSource
drepHashSource ->
      Credential 'DRepRole -> DRep
L.DRepCredential (Credential 'DRepRole -> DRep)
-> RIO e (Credential 'DRepRole) -> RIO e DRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DRepHashSource -> CIO e (Credential 'DRepRole)
forall e. DRepHashSource -> CIO e (Credential 'DRepRole)
readDRepCredential DRepHashSource
drepHashSource
    VoteDelegationTarget
VoteDelegationTargetOfAbstain ->
      DRep -> RIO e DRep
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DRep
L.DRepAlwaysAbstain
    VoteDelegationTarget
VoteDelegationTargetOfNoConfidence ->
      DRep -> RIO e DRep
forall a. a -> RIO e 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

-- | Get the hash from a stake pool key hash source
getHashFromStakePoolKeyHashSource
  :: MonadIO m => StakePoolKeyHashSource -> m (Hash StakePoolKey)
getHashFromStakePoolKeyHashSource :: forall (m :: * -> *).
MonadIO m =>
StakePoolKeyHashSource -> m (Hash StakePoolKey)
getHashFromStakePoolKeyHashSource StakePoolKeyHashSource
hashSource =
  case StakePoolKeyHashSource
hashSource of
    StakePoolKeyHashSource StakePoolVerificationKeySource
vkeySource ->
      AnyStakePoolVerificationKey -> Hash StakePoolKey
anyStakePoolVerificationKeyHash (AnyStakePoolVerificationKey -> Hash StakePoolKey)
-> m AnyStakePoolVerificationKey -> m (Hash StakePoolKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StakePoolVerificationKeySource -> m AnyStakePoolVerificationKey
forall (m :: * -> *).
MonadIO m =>
StakePoolVerificationKeySource -> m AnyStakePoolVerificationKey
getVerificationKeyFromStakePoolVerificationKeySource StakePoolVerificationKeySource
vkeySource
    StakePoolKeyHashLiteral Hash StakePoolKey
hash -> Hash StakePoolKey -> m (Hash StakePoolKey)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Hash StakePoolKey
hash

-- | Get the verification key from a stake pool verification key source
getVerificationKeyFromStakePoolVerificationKeySource
  :: MonadIO m => StakePoolVerificationKeySource -> m AnyStakePoolVerificationKey
getVerificationKeyFromStakePoolVerificationKeySource :: forall (m :: * -> *).
MonadIO m =>
StakePoolVerificationKeySource -> m AnyStakePoolVerificationKey
getVerificationKeyFromStakePoolVerificationKeySource = \case
  StakePoolVerificationKeyFromFile (File String
file) -> do
    FileOrPipe
f <- IO FileOrPipe -> m FileOrPipe
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileOrPipe -> m FileOrPipe) -> IO FileOrPipe -> m FileOrPipe
forall a b. (a -> b) -> a -> b
$ String -> IO FileOrPipe
fileOrPipe String
file
    IO
  (Either (FileError TextEnvelopeError) AnyStakePoolVerificationKey)
-> m AnyStakePoolVerificationKey
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO
   (Either (FileError TextEnvelopeError) AnyStakePoolVerificationKey)
 -> m AnyStakePoolVerificationKey)
-> IO
     (Either (FileError TextEnvelopeError) AnyStakePoolVerificationKey)
-> m AnyStakePoolVerificationKey
forall a b. (a -> b) -> a -> b
$ FileOrPipe
-> IO
     (Either (FileError TextEnvelopeError) AnyStakePoolVerificationKey)
readStakePoolVerificationKeyFile FileOrPipe
f
  StakePoolVerificationKeyFromLiteral AnyStakePoolVerificationKey
keyLiteral -> AnyStakePoolVerificationKey -> m AnyStakePoolVerificationKey
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AnyStakePoolVerificationKey
keyLiteral
 where
  readStakePoolVerificationKeyFile
    :: FileOrPipe -> IO (Either (FileError TextEnvelopeError) AnyStakePoolVerificationKey)
  readStakePoolVerificationKeyFile :: FileOrPipe
-> IO
     (Either (FileError TextEnvelopeError) AnyStakePoolVerificationKey)
readStakePoolVerificationKeyFile = [FromSomeType HasTextEnvelope AnyStakePoolVerificationKey]
-> FileOrPipe
-> IO
     (Either (FileError TextEnvelopeError) AnyStakePoolVerificationKey)
forall b.
[FromSomeType HasTextEnvelope b]
-> FileOrPipe -> IO (Either (FileError TextEnvelopeError) b)
readFileOrPipeTextEnvelopeAnyOf [FromSomeType HasTextEnvelope AnyStakePoolVerificationKey]
types
   where
    types :: [FromSomeType HasTextEnvelope AnyStakePoolVerificationKey]
types =
      [ AsType (VerificationKey StakePoolKey)
-> (VerificationKey StakePoolKey -> AnyStakePoolVerificationKey)
-> FromSomeType HasTextEnvelope AnyStakePoolVerificationKey
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType StakePoolKey -> AsType (VerificationKey StakePoolKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType StakePoolKey
AsStakePoolKey) VerificationKey StakePoolKey -> AnyStakePoolVerificationKey
AnyStakePoolNormalVerificationKey
      , AsType (VerificationKey StakePoolExtendedKey)
-> (VerificationKey StakePoolExtendedKey
    -> AnyStakePoolVerificationKey)
-> FromSomeType HasTextEnvelope AnyStakePoolVerificationKey
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType StakePoolExtendedKey
-> AsType (VerificationKey StakePoolExtendedKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType StakePoolExtendedKey
AsStakePoolExtendedKey) VerificationKey StakePoolExtendedKey -> AnyStakePoolVerificationKey
AnyStakePoolExtendedVerificationKey
      ]

readFileCli :: (HasCallStack, MonadIO m) => FilePath -> m ByteString
readFileCli :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
String -> m ByteString
readFileCli = m ByteString -> m ByteString
(HasCallStack => m ByteString) -> m ByteString
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (m ByteString -> m ByteString)
-> (String -> m ByteString) -> String -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m ByteString
forall (m :: * -> *). MonadIO m => String -> m ByteString
readFileBinary

readerFromParsecParser :: P.Parser a -> Opt.ReadM a
readerFromParsecParser :: forall a. Parser a -> ReadM a
readerFromParsecParser Parser a
p = (String -> Either String a) -> ReadM a
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader (Parser a -> Text -> Either String a
forall a. Parser a -> Text -> Either String a
P.runParser Parser a
p (Text -> Either String a)
-> (String -> Text) -> String -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack)

readFilePlutusScript
  :: FilePath
  -> CIO e AnyPlutusScript
readFilePlutusScript :: forall e. String -> CIO e AnyPlutusScript
readFilePlutusScript String
plutusScriptFp = do
  ByteString
bs <-
    String -> RIO e ByteString
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
String -> m ByteString
readFileCli String
plutusScriptFp
  Either PlutusScriptDecodeError AnyPlutusScript
-> RIO e AnyPlutusScript
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
Either e a -> m a
fromEitherCli (Either PlutusScriptDecodeError AnyPlutusScript
 -> RIO e AnyPlutusScript)
-> Either PlutusScriptDecodeError AnyPlutusScript
-> RIO e AnyPlutusScript
forall a b. (a -> b) -> a -> b
$ ByteString -> Either PlutusScriptDecodeError AnyPlutusScript
deserialisePlutusScript ByteString
bs

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

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