From 56a24ebe1e9a77142b78d1657626ac6d5a057d9d Mon Sep 17 00:00:00 2001 From: Felix Lipski Date: Fri, 29 Dec 2023 12:59:52 +0100 Subject: [PATCH] use AnyShelleyBasedEra --- cardano-cli/src/Cardano/CLI/Read.hs | 1335 ++++++++++++++------------- 1 file changed, 710 insertions(+), 625 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Read.hs b/cardano-cli/src/Cardano/CLI/Read.hs index 4c1eafe2ec..f1287b197d 100644 --- a/cardano-cli/src/Cardano/CLI/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Read.hs @@ -7,108 +7,105 @@ module Cardano.CLI.Read ( -- * Metadata - MetadataError(..) - , renderMetadataError - , readFileTxMetadata - , readTxMetadata + MetadataError (..), + renderMetadataError, + readFileTxMetadata, + readTxMetadata, -- * Script - , ScriptWitnessError(..) - , renderScriptWitnessError - , readScriptDataOrFile - , readScriptWitness - , readScriptWitnessFiles - , readScriptWitnessFilesThruple - , ScriptDecodeError (..) - , deserialiseScriptInAnyLang - , readFileScriptInAnyLang - - -- * Script data (datums and redeemers) - , ScriptDataError(..) - , readScriptDatumOrFile - , readScriptRedeemerOrFile - , renderScriptDataError - - -- * Tx - , CddlError(..) - , CddlTx(..) - , IncompleteTx(..) - , readFileTx - , readFileTxBody - , readCddlTx -- For testing purposes - - -- * Tx witnesses - , ReadWitnessSigningDataError(..) - , renderReadWitnessSigningDataError - , SomeSigningWitness(..) - , ByronOrShelleyWitness(..) - , ShelleyBootstrapWitnessSigningKeyData(..) - , CddlWitnessError(..) - , readFileTxKeyWitness - , readWitnessSigningData - - -- * Required signer - , RequiredSignerError(..) - , categoriseSomeSigningWitness - , readRequiredSigner - - -- * Governance related - , ConstitutionError(..) - , ProposalError(..) - , VoteError (..) - , readTxGovernanceActions - , constitutionHashSourceToHash - , readProposal - , CostModelsError (..) - , readCostModels - - -- * FileOrPipe - , FileOrPipe - , fileOrPipe - , fileOrPipePath - , fileOrPipeCache - , readFileOrPipe - - -- * Stake credentials - , getStakeCredentialFromVerifier - , getStakeCredentialFromIdentifier - , getStakeAddressFromVerifier - - , readVotingProceduresFiles - , readVotingProceduresFile - - -- * DRep credentials - , getDRepCredentialFromVerKeyHashOrFile - - -- * Committee credentials - , getCommitteeColdCredentialFromVerKeyHashOrFile - , getCommitteeHotCredentialFromVerKeyHashOrFile - - , ReadSafeHashError(..) - , readHexAsSafeHash - , readSafeHash - - , scriptHashReader - - -- * Update proposals - , readTxUpdateProposal - - -- * Vote related - , readVoteDelegationTarget - ) where - -import Cardano.Api as Api + ScriptWitnessError (..), + renderScriptWitnessError, + readScriptDataOrFile, + readScriptWitness, + readScriptWitnessFiles, + readScriptWitnessFilesThruple, + ScriptDecodeError (..), + deserialiseScriptInAnyLang, + readFileScriptInAnyLang, + + -- * Script data (datums and redeemers) + ScriptDataError (..), + readScriptDatumOrFile, + readScriptRedeemerOrFile, + renderScriptDataError, + + -- * Tx + CddlError (..), + CddlTx (..), + IncompleteTx (..), + readFileTx, + readFileTxBody, + readCddlTx, -- For testing purposes + + -- * Tx witnesses + ReadWitnessSigningDataError (..), + renderReadWitnessSigningDataError, + SomeSigningWitness (..), + ByronOrShelleyWitness (..), + ShelleyBootstrapWitnessSigningKeyData (..), + CddlWitnessError (..), + readFileTxKeyWitness, + readWitnessSigningData, + + -- * Required signer + RequiredSignerError (..), + categoriseSomeSigningWitness, + readRequiredSigner, + + -- * Governance related + ConstitutionError (..), + ProposalError (..), + VoteError (..), + readTxGovernanceActions, + constitutionHashSourceToHash, + readProposal, + CostModelsError (..), + readCostModels, + + -- * FileOrPipe + FileOrPipe, + fileOrPipe, + fileOrPipePath, + fileOrPipeCache, + readFileOrPipe, + + -- * Stake credentials + getStakeCredentialFromVerifier, + getStakeCredentialFromIdentifier, + getStakeAddressFromVerifier, + readVotingProceduresFiles, + readVotingProceduresFile, + + -- * DRep credentials + getDRepCredentialFromVerKeyHashOrFile, + + -- * Committee credentials + getCommitteeColdCredentialFromVerKeyHashOrFile, + getCommitteeHotCredentialFromVerKeyHashOrFile, + ReadSafeHashError (..), + readHexAsSafeHash, + readSafeHash, + scriptHashReader, + + -- * Update proposals + readTxUpdateProposal, + + -- * Vote related + readVoteDelegationTarget, + ) +where + +import Cardano.Api as Api import qualified Cardano.Api.Ledger as L -import Cardano.Api.Pretty -import Cardano.Api.Shelley as Api - +import Cardano.Api.Pretty +import Cardano.Api.Shelley as Api import qualified Cardano.Binary as CBOR -import Cardano.CLI.Types.Common -import Cardano.CLI.Types.Errors.DelegationError -import Cardano.CLI.Types.Errors.ScriptDecodeError -import Cardano.CLI.Types.Errors.StakeCredentialError -import Cardano.CLI.Types.Governance -import Cardano.CLI.Types.Key +import Cardano.CLI.Types.Common +import Cardano.CLI.Types.Errors.DelegationError +import Cardano.CLI.Types.Errors.ScriptDecodeError +import Cardano.CLI.Types.Errors.StakeCredentialError +import Cardano.CLI.Types.Governance +import Cardano.CLI.Types.Key import qualified Cardano.Crypto.Hash.Class as Crypto import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo import qualified Cardano.Ledger.BaseTypes as L @@ -120,37 +117,35 @@ import qualified Cardano.Ledger.Crypto as Ledger import qualified Cardano.Ledger.Keys as Ledger import qualified Cardano.Ledger.SafeHash as L import qualified Cardano.Ledger.SafeHash as Ledger - -import Prelude - -import Control.Exception (bracket, displayException) -import Control.Monad (forM, unless, when) -import Control.Monad.IO.Class -import Control.Monad.Trans (MonadTrans (..)) -import Control.Monad.Trans.Except -import Control.Monad.Trans.Except.Extra +import Control.Exception (bracket, displayException) +import Control.Monad (forM, unless, when) +import Control.Monad.IO.Class +import Control.Monad.Trans (MonadTrans (..)) +import Control.Monad.Trans.Except +import Control.Monad.Trans.Except.Extra import qualified Data.Aeson as Aeson -import Data.Bifunctor -import Data.ByteString (ByteString) +import Data.Bifunctor +import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Builder as Builder import qualified Data.ByteString.Lazy.Char8 as LBS -import Data.Function ((&)) -import Data.IORef (IORef, newIORef, readIORef, writeIORef) +import Data.Function ((&)) +import Data.IORef (IORef, newIORef, readIORef, writeIORef) import qualified Data.List as List import qualified Data.Map.Strict as Map -import Data.String -import Data.Text (Text) +import Data.String +import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import qualified Data.Text.Encoding.Error as Text -import Data.Word -import GHC.IO.Handle (hClose, hIsSeekable) -import GHC.IO.Handle.FD (openFileBlocking) +import Data.Word +import GHC.IO.Handle (hClose, hIsSeekable) +import GHC.IO.Handle.FD (openFileBlocking) import qualified Options.Applicative as Opt -import Prettyprinter (vsep) -import System.IO (IOMode (ReadMode)) +import Prettyprinter (vsep) +import System.IO (IOMode (ReadMode)) +import Prelude -- Metadata @@ -160,61 +155,80 @@ data MetadataError | MetadataErrorConversionError !FilePath !TxMetadataJsonError | MetadataErrorValidationError !FilePath ![(Word64, TxMetadataRangeError)] | MetadataErrorDecodeError !FilePath !CBOR.DecoderError - deriving Show + deriving (Show) renderMetadataError :: MetadataError -> Doc ann renderMetadataError = \case MetadataErrorFile fileErr -> prettyError fileErr MetadataErrorJsonParseError fp jsonErr -> - "Invalid JSON format in file: " <> pshow fp <> - "\nJSON parse error: " <> pretty jsonErr + "Invalid JSON format in file: " + <> pshow fp + <> "\nJSON parse error: " + <> pretty jsonErr MetadataErrorConversionError fp metadataErr -> - "Error reading metadata at: " <> pshow fp <> - "\n" <> prettyError metadataErr + "Error reading metadata at: " + <> pshow fp + <> "\n" + <> prettyError metadataErr MetadataErrorValidationError fp errs -> mconcat - [ "Error validating transaction metadata at: " <> pretty fp <> "\n" - , mconcat $ List.intersperse "\n" - [ "key " <> pshow k <> ":" <> prettyError valErr - | (k, valErr) <- errs - ] + [ "Error validating transaction metadata at: " <> pretty fp <> "\n", + mconcat $ + List.intersperse + "\n" + [ "key " <> pshow k <> ":" <> prettyError valErr + | (k, valErr) <- errs + ] ] MetadataErrorDecodeError fp metadataErr -> - "Error decoding CBOR metadata at: " <> pshow fp <> - " Error: " <> pshow metadataErr - -readTxMetadata :: ShelleyBasedEra era - -> TxMetadataJsonSchema - -> [MetadataFile] - -> IO (Either MetadataError (TxMetadataInEra era)) + "Error decoding CBOR metadata at: " + <> pshow fp + <> " Error: " + <> pshow metadataErr + +readTxMetadata :: + ShelleyBasedEra era -> + TxMetadataJsonSchema -> + [MetadataFile] -> + IO (Either MetadataError (TxMetadataInEra era)) readTxMetadata _ _ [] = return $ Right TxMetadataNone readTxMetadata era schema files = runExceptT $ do - metadata <- mapM (readFileTxMetadata schema) files + metadata <- mapM (readFileTxMetadata schema) files pure $ TxMetadataInEra era $ mconcat metadata -readFileTxMetadata - :: TxMetadataJsonSchema - -> MetadataFile - -> ExceptT MetadataError IO TxMetadata +readFileTxMetadata :: + TxMetadataJsonSchema -> + MetadataFile -> + ExceptT MetadataError IO TxMetadata readFileTxMetadata mapping (MetadataFileJSON fp) = do - bs <- handleIOExceptT (MetadataErrorFile . FileIOError (unFile fp)) - $ LBS.readFile (unFile fp) - v <- firstExceptT (MetadataErrorJsonParseError (unFile fp)) - $ hoistEither $ Aeson.eitherDecode' bs - txMetadata' <- firstExceptT (MetadataErrorConversionError (unFile fp)) - . hoistEither $ metadataFromJson mapping v + bs <- + handleIOExceptT (MetadataErrorFile . FileIOError (unFile fp)) $ + LBS.readFile (unFile fp) + v <- + firstExceptT (MetadataErrorJsonParseError (unFile fp)) $ + hoistEither $ + Aeson.eitherDecode' bs + txMetadata' <- + firstExceptT (MetadataErrorConversionError (unFile fp)) + . hoistEither + $ metadataFromJson mapping v firstExceptT (MetadataErrorValidationError (unFile fp)) - . hoistEither $ do + . hoistEither + $ do validateTxMetadata txMetadata' return txMetadata' readFileTxMetadata _ (MetadataFileCBOR fp) = do - bs <- handleIOExceptT (MetadataErrorFile . FileIOError (unFile fp)) - $ BS.readFile (unFile fp) - txMetadata' <- firstExceptT (MetadataErrorDecodeError (unFile fp)) - . hoistEither $ deserialiseFromCBOR AsTxMetadata bs + bs <- + handleIOExceptT (MetadataErrorFile . FileIOError (unFile fp)) $ + BS.readFile (unFile fp) + txMetadata' <- + firstExceptT (MetadataErrorDecodeError (unFile fp)) + . hoistEither + $ deserialiseFromCBOR AsTxMetadata bs firstExceptT (MetadataErrorValidationError (unFile fp)) - . hoistEither $ do + . hoistEither + $ do validateTxMetadata txMetadata' return txMetadata' @@ -225,7 +239,7 @@ data ScriptWitnessError | ScriptWitnessErrorScriptLanguageNotSupportedInEra AnyScriptLanguage AnyCardanoEra | ScriptWitnessErrorExpectedSimple !FilePath !AnyScriptLanguage | ScriptWitnessErrorExpectedPlutus !FilePath !AnyScriptLanguage - | ScriptWitnessErrorReferenceScriptsNotSupportedInEra !AnyCardanoEra + | ScriptWitnessErrorReferenceScriptsNotSupportedInEra !AnyShelleyBasedEra | ScriptWitnessErrorScriptData ScriptDataError renderScriptWitnessError :: ScriptWitnessError -> Doc ann @@ -233,156 +247,197 @@ renderScriptWitnessError = \case ScriptWitnessErrorFile err -> prettyError err ScriptWitnessErrorScriptLanguageNotSupportedInEra (AnyScriptLanguage lang) anyEra -> - "The script language " <> pshow lang <> " is not supported in the " <> - pretty anyEra <> " era." + "The script language " + <> pshow lang + <> " is not supported in the " + <> pretty anyEra + <> " era." ScriptWitnessErrorExpectedSimple file (AnyScriptLanguage lang) -> - pretty file <> ": expected a script in the simple script language, " <> - "but it is actually using " <> pshow lang <> ". Alternatively, to use " <> - "a Plutus script, you must also specify the redeemer " <> - "(datum if appropriate) and script execution units." + pretty file + <> ": expected a script in the simple script language, " + <> "but it is actually using " + <> pshow lang + <> ". Alternatively, to use " + <> "a Plutus script, you must also specify the redeemer " + <> "(datum if appropriate) and script execution units." ScriptWitnessErrorExpectedPlutus file (AnyScriptLanguage lang) -> - pretty file <> ": expected a script in the Plutus script language, " <> - "but it is actually using " <> pshow lang <> "." + pretty file + <> ": expected a script in the Plutus script language, " + <> "but it is actually using " + <> pshow lang + <> "." ScriptWitnessErrorReferenceScriptsNotSupportedInEra anyEra -> - "Reference scripts not supported in era: " <> pretty anyEra + "Reference scripts not supported in era: " <> pshow anyEra ScriptWitnessErrorScriptData sDataError -> renderScriptDataError sDataError -readScriptWitnessFiles - :: ShelleyBasedEra era - -> [(a, Maybe (ScriptWitnessFiles ctx))] - -> ExceptT ScriptWitnessError IO [(a, Maybe (ScriptWitness ctx era))] +readScriptWitnessFiles :: + ShelleyBasedEra era -> + [(a, Maybe (ScriptWitnessFiles ctx))] -> + ExceptT ScriptWitnessError IO [(a, Maybe (ScriptWitness ctx era))] readScriptWitnessFiles era = mapM readSwitFile - where - readSwitFile (tIn, Just switFile) = do + where + readSwitFile (tIn, Just switFile) = do sWit <- readScriptWitness era switFile return (tIn, Just sWit) - readSwitFile (tIn, Nothing) = return (tIn, Nothing) + readSwitFile (tIn, Nothing) = return (tIn, Nothing) -readScriptWitnessFilesThruple - :: ShelleyBasedEra era - -> [(a, b, Maybe (ScriptWitnessFiles ctx))] - -> ExceptT ScriptWitnessError IO [(a, b, Maybe (ScriptWitness ctx era))] +readScriptWitnessFilesThruple :: + ShelleyBasedEra era -> + [(a, b, Maybe (ScriptWitnessFiles ctx))] -> + ExceptT ScriptWitnessError IO [(a, b, Maybe (ScriptWitness ctx era))] readScriptWitnessFilesThruple era = mapM readSwitFile - where - readSwitFile (tIn, b, Just switFile) = do + where + readSwitFile (tIn, b, Just switFile) = do sWit <- readScriptWitness era switFile return (tIn, b, Just sWit) - readSwitFile (tIn, b, Nothing) = return (tIn, b, Nothing) + readSwitFile (tIn, b, Nothing) = return (tIn, b, Nothing) -readScriptWitness - :: ShelleyBasedEra era - -> ScriptWitnessFiles witctx - -> ExceptT ScriptWitnessError IO (ScriptWitness witctx era) +readScriptWitness :: + ShelleyBasedEra era -> + ScriptWitnessFiles witctx -> + ExceptT ScriptWitnessError IO (ScriptWitness witctx era) readScriptWitness era (SimpleScriptWitnessFile (ScriptFile scriptFile)) = do - script@(ScriptInAnyLang lang _) <- firstExceptT ScriptWitnessErrorFile $ - readFileScriptInAnyLang scriptFile - ScriptInEra langInEra script' <- validateScriptSupportedInEra era script - case script' of - SimpleScript sscript -> - return . SimpleScriptWitness langInEra $ SScript sscript - - -- If the supplied cli flags were for a simple script (i.e. the user did - -- not supply the datum, redeemer or ex units), but the script file turns - -- out to be a valid plutus script, then we must fail. - PlutusScript{} -> - left $ ScriptWitnessErrorExpectedSimple - scriptFile - (AnyScriptLanguage lang) - -readScriptWitness era (PlutusScriptWitnessFiles - (ScriptFile scriptFile) - datumOrFile - redeemerOrFile - execUnits) = do - script@(ScriptInAnyLang lang _) <- firstExceptT ScriptWitnessErrorFile $ - readFileScriptInAnyLang scriptFile - ScriptInEra langInEra script' <- validateScriptSupportedInEra era script + script@(ScriptInAnyLang lang _) <- + firstExceptT ScriptWitnessErrorFile $ + readFileScriptInAnyLang scriptFile + ScriptInEra langInEra script' <- validateScriptSupportedInEra era script + case script' of + SimpleScript sscript -> + return . SimpleScriptWitness langInEra $ SScript sscript + -- If the supplied cli flags were for a simple script (i.e. the user did + -- not supply the datum, redeemer or ex units), but the script file turns + -- out to be a valid plutus script, then we must fail. + PlutusScript {} -> + left $ + ScriptWitnessErrorExpectedSimple + scriptFile + (AnyScriptLanguage lang) +readScriptWitness + era + ( PlutusScriptWitnessFiles + (ScriptFile scriptFile) + datumOrFile + redeemerOrFile + execUnits + ) = do + script@(ScriptInAnyLang lang _) <- + firstExceptT ScriptWitnessErrorFile $ + readFileScriptInAnyLang scriptFile + ScriptInEra langInEra script' <- validateScriptSupportedInEra era script case script' of PlutusScript version pscript -> do - datum <- firstExceptT ScriptWitnessErrorScriptData - $ readScriptDatumOrFile datumOrFile - redeemer <- firstExceptT ScriptWitnessErrorScriptData - $ readScriptRedeemerOrFile redeemerOrFile - return $ PlutusScriptWitness - langInEra version (PScript pscript) - datum - redeemer - execUnits + datum <- + firstExceptT ScriptWitnessErrorScriptData $ + readScriptDatumOrFile datumOrFile + redeemer <- + firstExceptT ScriptWitnessErrorScriptData $ + readScriptRedeemerOrFile redeemerOrFile + return $ + PlutusScriptWitness + langInEra + version + (PScript pscript) + datum + redeemer + execUnits -- If the supplied cli flags were for a plutus script (i.e. the user did -- supply the datum, redeemer and ex units), but the script file turns -- out to be a valid simple script, then we must fail. - SimpleScript{} -> - left $ ScriptWitnessErrorExpectedPlutus - scriptFile - (AnyScriptLanguage lang) - -readScriptWitness era (PlutusReferenceScriptWitnessFiles refTxIn - anyScrLang@(AnyScriptLanguage anyScriptLanguage) - datumOrFile redeemerOrFile execUnits mPid) = do - caseShelleyToAlonzoOrBabbageEraOnwards - ( const $ left - $ ScriptWitnessErrorReferenceScriptsNotSupportedInEra - -- TODO: Update error to use AnyShelleyBasedEra - $ cardanoEraConstraints (toCardanoEra era) (AnyCardanoEra $ toCardanoEra era) - ) - ( const $ - case scriptLanguageSupportedInEra era anyScriptLanguage of - Just sLangInEra -> - case languageOfScriptLanguageInEra sLangInEra of - SimpleScriptLanguage -> - -- TODO: We likely need another datatype eg data ReferenceScriptWitness lang - -- in order to make this branch unrepresentable. - error "readScriptWitness: Should not be possible to specify a simple script" - PlutusScriptLanguage version -> do - datum <- firstExceptT ScriptWitnessErrorScriptData - $ readScriptDatumOrFile datumOrFile - redeemer <- firstExceptT ScriptWitnessErrorScriptData - $ readScriptRedeemerOrFile redeemerOrFile - return $ PlutusScriptWitness - sLangInEra - version - (PReferenceScript refTxIn (unPolicyId <$> mPid)) - datum redeemer execUnits - Nothing -> - left $ ScriptWitnessErrorScriptLanguageNotSupportedInEra anyScrLang (anyCardanoEra $ toCardanoEra era) - ) - era -readScriptWitness era (SimpleReferenceScriptWitnessFiles refTxIn - anyScrLang@(AnyScriptLanguage anyScriptLanguage) mPid) = do - caseShelleyToAlonzoOrBabbageEraOnwards - ( const $ left - $ ScriptWitnessErrorReferenceScriptsNotSupportedInEra - $ cardanoEraConstraints (toCardanoEra era) (AnyCardanoEra $ toCardanoEra era) - ) - ( const $ - case scriptLanguageSupportedInEra era anyScriptLanguage of - Just sLangInEra -> - case languageOfScriptLanguageInEra sLangInEra of - SimpleScriptLanguage -> - return . SimpleScriptWitness sLangInEra - $ SReferenceScript refTxIn (unPolicyId <$> mPid) - PlutusScriptLanguage{} -> - error "readScriptWitness: Should not be possible to specify a plutus script" - Nothing -> - left $ ScriptWitnessErrorScriptLanguageNotSupportedInEra - anyScrLang - (anyCardanoEra $ toCardanoEra era) - ) - era - -validateScriptSupportedInEra :: ShelleyBasedEra era - -> ScriptInAnyLang - -> ExceptT ScriptWitnessError IO (ScriptInEra era) + SimpleScript {} -> + left $ + ScriptWitnessErrorExpectedPlutus + scriptFile + (AnyScriptLanguage lang) +readScriptWitness + era + ( PlutusReferenceScriptWitnessFiles + refTxIn + anyScrLang@(AnyScriptLanguage anyScriptLanguage) + datumOrFile + redeemerOrFile + execUnits + mPid + ) = do + caseShelleyToAlonzoOrBabbageEraOnwards + ( const $ + left $ + ScriptWitnessErrorReferenceScriptsNotSupportedInEra $ + cardanoEraConstraints (toCardanoEra era) (AnyShelleyBasedEra era) + ) + ( const $ + case scriptLanguageSupportedInEra era anyScriptLanguage of + Just sLangInEra -> + case languageOfScriptLanguageInEra sLangInEra of + SimpleScriptLanguage -> + -- TODO: We likely need another datatype eg data ReferenceScriptWitness lang + -- in order to make this branch unrepresentable. + error "readScriptWitness: Should not be possible to specify a simple script" + PlutusScriptLanguage version -> do + datum <- + firstExceptT ScriptWitnessErrorScriptData $ + readScriptDatumOrFile datumOrFile + redeemer <- + firstExceptT ScriptWitnessErrorScriptData $ + readScriptRedeemerOrFile redeemerOrFile + return $ + PlutusScriptWitness + sLangInEra + version + (PReferenceScript refTxIn (unPolicyId <$> mPid)) + datum + redeemer + execUnits + Nothing -> + left $ ScriptWitnessErrorScriptLanguageNotSupportedInEra anyScrLang (anyCardanoEra $ toCardanoEra era) + ) + era +readScriptWitness + era + ( SimpleReferenceScriptWitnessFiles + refTxIn + anyScrLang@(AnyScriptLanguage anyScriptLanguage) + mPid + ) = do + caseShelleyToAlonzoOrBabbageEraOnwards + ( const $ + left $ + ScriptWitnessErrorReferenceScriptsNotSupportedInEra $ + cardanoEraConstraints (toCardanoEra era) (AnyShelleyBasedEra era) + ) + ( const $ + case scriptLanguageSupportedInEra era anyScriptLanguage of + Just sLangInEra -> + case languageOfScriptLanguageInEra sLangInEra of + SimpleScriptLanguage -> + return . SimpleScriptWitness sLangInEra $ + SReferenceScript refTxIn (unPolicyId <$> mPid) + PlutusScriptLanguage {} -> + error "readScriptWitness: Should not be possible to specify a plutus script" + Nothing -> + left $ + ScriptWitnessErrorScriptLanguageNotSupportedInEra + anyScrLang + (anyCardanoEra $ toCardanoEra era) + ) + era + +validateScriptSupportedInEra :: + ShelleyBasedEra era -> + ScriptInAnyLang -> + ExceptT ScriptWitnessError IO (ScriptInEra era) validateScriptSupportedInEra era script@(ScriptInAnyLang lang _) = - case toScriptInEra era script of - Nothing -> left $ ScriptWitnessErrorScriptLanguageNotSupportedInEra - (AnyScriptLanguage lang) (anyCardanoEra $ toCardanoEra era) - Just script' -> pure script' - -data ScriptDataError = - ScriptDataErrorFile (FileError ()) + case toScriptInEra era script of + Nothing -> + left $ + ScriptWitnessErrorScriptLanguageNotSupportedInEra + (AnyScriptLanguage lang) + (anyCardanoEra $ toCardanoEra era) + Just script' -> pure script' + +data ScriptDataError + = ScriptDataErrorFile (FileError ()) | ScriptDataErrorJsonParse !FilePath !String | ScriptDataErrorConversion !FilePath !ScriptDataJsonError | ScriptDataErrorValidation !FilePath !ScriptDataRangeError @@ -393,32 +448,35 @@ renderScriptDataError :: ScriptDataError -> Doc ann renderScriptDataError = \case ScriptDataErrorFile err -> prettyError err - ScriptDataErrorJsonParse fp jsonErr-> + ScriptDataErrorJsonParse fp jsonErr -> "Invalid JSON format in file: " <> pshow fp <> "\nJSON parse error: " <> pretty jsonErr - ScriptDataErrorConversion fp sDataJsonErr-> + ScriptDataErrorConversion fp sDataJsonErr -> "Error reading metadata at: " <> pshow fp <> "\n" <> prettyError sDataJsonErr - ScriptDataErrorValidation fp sDataRangeErr-> + ScriptDataErrorValidation fp sDataRangeErr -> "Error validating script data at: " <> pshow fp <> ":\n" <> prettyError sDataRangeErr - ScriptDataErrorMetadataDecode fp decoderErr-> + ScriptDataErrorMetadataDecode fp decoderErr -> "Error decoding CBOR metadata at: " <> pshow fp <> " Error: " <> pshow decoderErr - ScriptDataErrorJsonBytes e-> + ScriptDataErrorJsonBytes e -> prettyError e - -readScriptDatumOrFile :: ScriptDatumOrFile witctx - -> ExceptT ScriptDataError IO (ScriptDatum witctx) -readScriptDatumOrFile (ScriptDatumOrFileForTxIn df) = ScriptDatumForTxIn <$> - readScriptDataOrFile df -readScriptDatumOrFile InlineDatumPresentAtTxIn = pure InlineScriptDatum -readScriptDatumOrFile NoScriptDatumOrFileForMint = pure NoScriptDatumForMint -readScriptDatumOrFile NoScriptDatumOrFileForStake = pure NoScriptDatumForStake - -readScriptRedeemerOrFile :: ScriptRedeemerOrFile - -> ExceptT ScriptDataError IO ScriptRedeemer +readScriptDatumOrFile :: + ScriptDatumOrFile witctx -> + ExceptT ScriptDataError IO (ScriptDatum witctx) +readScriptDatumOrFile (ScriptDatumOrFileForTxIn df) = + ScriptDatumForTxIn + <$> readScriptDataOrFile df +readScriptDatumOrFile InlineDatumPresentAtTxIn = pure InlineScriptDatum +readScriptDatumOrFile NoScriptDatumOrFileForMint = pure NoScriptDatumForMint +readScriptDatumOrFile NoScriptDatumOrFileForStake = pure NoScriptDatumForStake + +readScriptRedeemerOrFile :: + ScriptRedeemerOrFile -> + ExceptT ScriptDataError IO ScriptRedeemer readScriptRedeemerOrFile = readScriptDataOrFile -readScriptDataOrFile :: ScriptDataOrFile - -> ExceptT ScriptDataError IO HashableScriptData +readScriptDataOrFile :: + ScriptDataOrFile -> + ExceptT ScriptDataError IO HashableScriptData readScriptDataOrFile (ScriptDataValue d) = return d readScriptDataOrFile (ScriptDataJsonFile fp) = do sDataBs <- handleIOExceptT (ScriptDataErrorFile . FileIOError fp) $ LBS.readFile fp @@ -426,64 +484,69 @@ readScriptDataOrFile (ScriptDataJsonFile fp) = do hoistEither . first ScriptDataErrorJsonBytes $ scriptDataJsonToHashable ScriptDataJsonDetailedSchema sDataValue - readScriptDataOrFile (ScriptDataCborFile fp) = do origBs <- handleIOExceptT (ScriptDataErrorFile . FileIOError fp) (BS.readFile fp) - hSd <- firstExceptT (ScriptDataErrorMetadataDecode fp) - $ hoistEither $ deserialiseFromCBOR AsHashableScriptData origBs - firstExceptT (ScriptDataErrorValidation fp) - $ hoistEither $ validateScriptData $ getScriptData hSd + hSd <- + firstExceptT (ScriptDataErrorMetadataDecode fp) $ + hoistEither $ + deserialiseFromCBOR AsHashableScriptData origBs + firstExceptT (ScriptDataErrorValidation fp) $ + hoistEither $ + validateScriptData $ + getScriptData hSd return hSd -- | Read a script file. The file can either be in the text envelope format -- wrapping the binary representation of any of the supported script languages, -- or alternatively it can be a JSON format file for one of the simple script -- language versions. --- -readFileScriptInAnyLang :: FilePath - -> ExceptT (FileError ScriptDecodeError) IO - ScriptInAnyLang +readFileScriptInAnyLang :: + FilePath -> + ExceptT + (FileError ScriptDecodeError) + IO + ScriptInAnyLang readFileScriptInAnyLang file = do scriptBytes <- handleIOExceptT (FileIOError file) $ BS.readFile file - firstExceptT (FileError file) $ hoistEither $ - deserialiseScriptInAnyLang scriptBytes - + firstExceptT (FileError file) $ + hoistEither $ + deserialiseScriptInAnyLang scriptBytes -deserialiseScriptInAnyLang :: BS.ByteString - -> Either ScriptDecodeError ScriptInAnyLang +deserialiseScriptInAnyLang :: + BS.ByteString -> + Either ScriptDecodeError ScriptInAnyLang deserialiseScriptInAnyLang bs = - -- Accept either the text envelope format wrapping the binary serialisation, - -- or accept the simple script language in its JSON format. - -- - case deserialiseFromJSON AsTextEnvelope bs of - Left _ -> - -- In addition to the TextEnvelope format, we also try to - -- deserialize the JSON representation of SimpleScripts. - case Aeson.eitherDecodeStrict' bs of - Left err -> Left (ScriptDecodeSimpleScriptError $ JsonDecodeError err) - Right script -> Right $ ScriptInAnyLang SimpleScriptLanguage $ SimpleScript script - - Right te -> - case deserialiseFromTextEnvelopeAnyOf textEnvTypes te of - Left err -> Left (ScriptDecodeTextEnvelopeError err) - Right script -> Right script - + -- Accept either the text envelope format wrapping the binary serialisation, + -- or accept the simple script language in its JSON format. + -- + case deserialiseFromJSON AsTextEnvelope bs of + Left _ -> + -- In addition to the TextEnvelope format, we also try to + -- deserialize the JSON representation of SimpleScripts. + case Aeson.eitherDecodeStrict' bs of + Left err -> Left (ScriptDecodeSimpleScriptError $ JsonDecodeError err) + Right script -> Right $ ScriptInAnyLang SimpleScriptLanguage $ SimpleScript script + Right te -> + case deserialiseFromTextEnvelopeAnyOf textEnvTypes te of + Left err -> Left (ScriptDecodeTextEnvelopeError err) + Right script -> Right 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 (AsScript AsSimpleScript) - (ScriptInAnyLang SimpleScriptLanguage) - - , FromSomeType (AsScript AsPlutusScriptV1) - (ScriptInAnyLang (PlutusScriptLanguage PlutusScriptV1)) - - , FromSomeType (AsScript AsPlutusScriptV2) - (ScriptInAnyLang (PlutusScriptLanguage PlutusScriptV2)) - - , FromSomeType (AsScript AsPlutusScriptV3) - (ScriptInAnyLang (PlutusScriptLanguage PlutusScriptV3)) + [ FromSomeType + (AsScript AsSimpleScript) + (ScriptInAnyLang SimpleScriptLanguage), + FromSomeType + (AsScript AsPlutusScriptV1) + (ScriptInAnyLang (PlutusScriptLanguage PlutusScriptV1)), + FromSomeType + (AsScript AsPlutusScriptV2) + (ScriptInAnyLang (PlutusScriptLanguage PlutusScriptV2)), + FromSomeType + (AsScript AsPlutusScriptV3) + (ScriptInAnyLang (PlutusScriptLanguage PlutusScriptV3)) ] -- Tx & TxBody @@ -513,61 +576,67 @@ readFileTxBody file = do Left e -> fmap (IncompleteCddlFormattedTx . unCddlTx) <$> acceptTxCDDLSerialisation file e Right txBody -> return $ Right $ UnwitnessedCliFormattedTxBody txBody -data CddlError = CddlErrorTextEnv - !(FileError TextEnvelopeError) - !(FileError TextEnvelopeCddlError) - | CddlIOError (FileError TextEnvelopeError) - deriving Show +data CddlError + = CddlErrorTextEnv + !(FileError TextEnvelopeError) + !(FileError TextEnvelopeCddlError) + | CddlIOError (FileError TextEnvelopeError) + deriving (Show) instance Error CddlError where prettyError = \case CddlErrorTextEnv textEnvErr cddlErr -> - "Failed to decode neither the cli's serialisation format nor the ledger's " <> - "CDDL serialisation format. TextEnvelope error: " <> prettyError textEnvErr <> "\n" <> - "TextEnvelopeCddl error: " <> prettyError cddlErr + "Failed to decode neither the cli's serialisation format nor the ledger's " + <> "CDDL serialisation format. TextEnvelope error: " + <> prettyError textEnvErr + <> "\n" + <> "TextEnvelopeCddl error: " + <> prettyError cddlErr CddlIOError e -> prettyError e -acceptTxCDDLSerialisation - :: FileOrPipe - -> FileError TextEnvelopeError - -> IO (Either CddlError CddlTx) +acceptTxCDDLSerialisation :: + FileOrPipe -> + FileError TextEnvelopeError -> + IO (Either CddlError CddlTx) acceptTxCDDLSerialisation file err = case err of - e@(FileError _ (TextEnvelopeDecodeError _)) -> + e@(FileError _ (TextEnvelopeDecodeError _)) -> first (CddlErrorTextEnv e) <$> readCddlTx file - e@(FileError _ (TextEnvelopeAesonDecodeError _)) -> + e@(FileError _ (TextEnvelopeAesonDecodeError _)) -> first (CddlErrorTextEnv e) <$> readCddlTx file - e@(FileError _ (TextEnvelopeTypeError _ _)) -> + e@(FileError _ (TextEnvelopeTypeError _ _)) -> first (CddlErrorTextEnv e) <$> readCddlTx file - e@FileErrorTempFile{} -> return . Left $ CddlIOError e - e@FileDoesNotExistError{} -> return . Left $ CddlIOError e - e@FileIOError{} -> return . Left $ CddlIOError e + e@FileErrorTempFile {} -> return . Left $ CddlIOError e + e@FileDoesNotExistError {} -> return . Left $ CddlIOError e + e@FileIOError {} -> return . Left $ CddlIOError e readCddlTx :: FileOrPipe -> IO (Either (FileError TextEnvelopeCddlError) CddlTx) readCddlTx = readFileOrPipeTextEnvelopeCddlAnyOf teTypes - where - teTypes = [ FromCDDLTx "Witnessed Tx ShelleyEra" CddlTx - , FromCDDLTx "Witnessed Tx AllegraEra" CddlTx - , FromCDDLTx "Witnessed Tx MaryEra" CddlTx - , FromCDDLTx "Witnessed Tx AlonzoEra" CddlTx - , FromCDDLTx "Witnessed Tx BabbageEra" CddlTx - , FromCDDLTx "Witnessed Tx ConwayEra" CddlTx - , FromCDDLTx "Unwitnessed Tx ByronEra" CddlTx - , FromCDDLTx "Unwitnessed Tx ShelleyEra" CddlTx - , FromCDDLTx "Unwitnessed Tx AllegraEra" CddlTx - , FromCDDLTx "Unwitnessed Tx MaryEra" CddlTx - , FromCDDLTx "Unwitnessed Tx AlonzoEra" CddlTx - , FromCDDLTx "Unwitnessed Tx BabbageEra" CddlTx - , FromCDDLTx "Unwitnessed Tx ConwayEra" CddlTx - ] + where + teTypes = + [ FromCDDLTx "Witnessed Tx ShelleyEra" CddlTx, + FromCDDLTx "Witnessed Tx AllegraEra" CddlTx, + FromCDDLTx "Witnessed Tx MaryEra" CddlTx, + FromCDDLTx "Witnessed Tx AlonzoEra" CddlTx, + FromCDDLTx "Witnessed Tx BabbageEra" CddlTx, + FromCDDLTx "Witnessed Tx ConwayEra" CddlTx, + FromCDDLTx "Unwitnessed Tx ByronEra" CddlTx, + FromCDDLTx "Unwitnessed Tx ShelleyEra" CddlTx, + FromCDDLTx "Unwitnessed Tx AllegraEra" CddlTx, + FromCDDLTx "Unwitnessed Tx MaryEra" CddlTx, + FromCDDLTx "Unwitnessed Tx AlonzoEra" CddlTx, + FromCDDLTx "Unwitnessed Tx BabbageEra" CddlTx, + FromCDDLTx "Unwitnessed Tx ConwayEra" CddlTx + ] -- Tx witnesses -newtype CddlWitness = CddlWitness { unCddlWitness :: InAnyShelleyBasedEra KeyWitness} +newtype CddlWitness = CddlWitness {unCddlWitness :: InAnyShelleyBasedEra KeyWitness} -readFileTxKeyWitness :: FilePath - -> IO (Either CddlWitnessError (InAnyShelleyBasedEra KeyWitness)) +readFileTxKeyWitness :: + FilePath -> + IO (Either CddlWitnessError (InAnyShelleyBasedEra KeyWitness)) readFileTxKeyWitness fp = do file <- fileOrPipe fp eWitness <- readFileInAnyShelleyBasedEra AsKeyWitness file @@ -580,24 +649,26 @@ data CddlWitnessError (FileError TextEnvelopeError) (FileError TextEnvelopeCddlError) | CddlWitnessIOError (FileError TextEnvelopeError) - deriving Show + deriving (Show) instance Error CddlWitnessError where prettyError = \case CddlWitnessErrorTextEnv teErr cddlErr -> "Failed to decode neither the cli's serialisation format nor the ledger's \ - \CDDL serialisation format. TextEnvelope error: " <> prettyError teErr <> "\n" <> - "TextEnvelopeCddl error: " <> prettyError cddlErr + \CDDL serialisation format. TextEnvelope error: " + <> prettyError teErr + <> "\n" + <> "TextEnvelopeCddl error: " + <> prettyError cddlErr CddlWitnessIOError fileE -> prettyError fileE - -- TODO: This is a stop gap to avoid modifying the TextEnvelope -- related functions. We intend to remove this after fully deprecating -- the cli's serialisation format -acceptKeyWitnessCDDLSerialisation - :: FileError TextEnvelopeError - -> IO (Either CddlWitnessError CddlWitness) +acceptKeyWitnessCDDLSerialisation :: + FileError TextEnvelopeError -> + IO (Either CddlWitnessError CddlWitness) acceptKeyWitnessCDDLSerialisation err = case err of e@(FileError fp (TextEnvelopeDecodeError _)) -> @@ -606,54 +677,54 @@ acceptKeyWitnessCDDLSerialisation err = first (CddlWitnessErrorTextEnv e) <$> readCddlWitness fp e@(FileError fp (TextEnvelopeTypeError _ _)) -> first (CddlWitnessErrorTextEnv e) <$> readCddlWitness fp - e@FileErrorTempFile{} -> return . Left $ CddlWitnessIOError e - e@FileDoesNotExistError{} -> return . Left $ CddlWitnessIOError e - e@FileIOError{} -> return . Left $ CddlWitnessIOError e + e@FileErrorTempFile {} -> return . Left $ CddlWitnessIOError e + e@FileDoesNotExistError {} -> return . Left $ CddlWitnessIOError e + e@FileIOError {} -> return . Left $ CddlWitnessIOError e -readCddlWitness - :: FilePath - -> IO (Either (FileError TextEnvelopeCddlError) CddlWitness) +readCddlWitness :: + FilePath -> + IO (Either (FileError TextEnvelopeCddlError) CddlWitness) readCddlWitness fp = do readFileTextEnvelopeCddlAnyOf teTypes fp - where - teTypes = [ FromCDDLWitness "TxWitness ShelleyEra" CddlWitness - , FromCDDLWitness "TxWitness AllegraEra" CddlWitness - , FromCDDLWitness "TxWitness MaryEra" CddlWitness - , FromCDDLWitness "TxWitness AlonzoEra" CddlWitness - , FromCDDLWitness "TxWitness BabbageEra" CddlWitness - , FromCDDLWitness "TxWitness ConwayEra" CddlWitness - ] + where + teTypes = + [ FromCDDLWitness "TxWitness ShelleyEra" CddlWitness, + FromCDDLWitness "TxWitness AllegraEra" CddlWitness, + FromCDDLWitness "TxWitness MaryEra" CddlWitness, + FromCDDLWitness "TxWitness AlonzoEra" CddlWitness, + FromCDDLWitness "TxWitness BabbageEra" CddlWitness, + FromCDDLWitness "TxWitness ConwayEra" CddlWitness + ] -- Witness handling data SomeSigningWitness - = AByronSigningWitness (SigningKey ByronKey) (Maybe (Address ByronAddr)) - | APaymentSigningWitness (SigningKey PaymentKey) - | APaymentExtendedSigningWitness (SigningKey PaymentExtendedKey) - | AStakeSigningWitness (SigningKey StakeKey) - | AStakeExtendedSigningWitness (SigningKey StakeExtendedKey) - | AStakePoolSigningWitness (SigningKey StakePoolKey) - | AGenesisSigningWitness (SigningKey GenesisKey) - | AGenesisExtendedSigningWitness (SigningKey GenesisExtendedKey) - | AGenesisDelegateSigningWitness (SigningKey GenesisDelegateKey) - | AGenesisDelegateExtendedSigningWitness (SigningKey GenesisDelegateExtendedKey) - | AGenesisUTxOSigningWitness (SigningKey GenesisUTxOKey) - | ADRepSigningWitness (SigningKey DRepKey) - | ACommitteeColdSigningWitness (SigningKey CommitteeColdKey) - | ACommitteeHotSigningWitness (SigningKey CommitteeHotKey) - deriving Show - + = AByronSigningWitness (SigningKey ByronKey) (Maybe (Address ByronAddr)) + | APaymentSigningWitness (SigningKey PaymentKey) + | APaymentExtendedSigningWitness (SigningKey PaymentExtendedKey) + | AStakeSigningWitness (SigningKey StakeKey) + | AStakeExtendedSigningWitness (SigningKey StakeExtendedKey) + | AStakePoolSigningWitness (SigningKey StakePoolKey) + | AGenesisSigningWitness (SigningKey GenesisKey) + | AGenesisExtendedSigningWitness (SigningKey GenesisExtendedKey) + | AGenesisDelegateSigningWitness (SigningKey GenesisDelegateKey) + | AGenesisDelegateExtendedSigningWitness (SigningKey GenesisDelegateExtendedKey) + | AGenesisUTxOSigningWitness (SigningKey GenesisUTxOKey) + | ADRepSigningWitness (SigningKey DRepKey) + | ACommitteeColdSigningWitness (SigningKey CommitteeColdKey) + | ACommitteeHotSigningWitness (SigningKey CommitteeHotKey) + deriving (Show) -- | Data required for constructing a Shelley bootstrap witness. data ShelleyBootstrapWitnessSigningKeyData = ShelleyBootstrapWitnessSigningKeyData + -- | Byron signing key. !(SigningKey ByronKey) - -- ^ Byron signing key. - !(Maybe (Address ByronAddr)) - -- ^ An optionally specified Byron address. + -- | 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. + !(Maybe (Address ByronAddr)) -- | Some kind of Byron or Shelley witness. data ByronOrShelleyWitness @@ -663,20 +734,20 @@ data ByronOrShelleyWitness categoriseSomeSigningWitness :: SomeSigningWitness -> ByronOrShelleyWitness categoriseSomeSigningWitness swsk = case swsk of - AByronSigningWitness sk addr -> AByronWitness (ShelleyBootstrapWitnessSigningKeyData sk addr) - APaymentSigningWitness sk -> AShelleyKeyWitness (WitnessPaymentKey sk) - APaymentExtendedSigningWitness sk -> AShelleyKeyWitness (WitnessPaymentExtendedKey sk) - AStakeSigningWitness sk -> AShelleyKeyWitness (WitnessStakeKey sk) - AStakeExtendedSigningWitness sk -> AShelleyKeyWitness (WitnessStakeExtendedKey sk) - AStakePoolSigningWitness sk -> AShelleyKeyWitness (WitnessStakePoolKey sk) - AGenesisSigningWitness sk -> AShelleyKeyWitness (WitnessGenesisKey sk) - AGenesisExtendedSigningWitness sk -> AShelleyKeyWitness (WitnessGenesisExtendedKey sk) - AGenesisDelegateSigningWitness sk -> AShelleyKeyWitness (WitnessGenesisDelegateKey sk) - AGenesisDelegateExtendedSigningWitness sk -> AShelleyKeyWitness (WitnessGenesisDelegateExtendedKey sk) - AGenesisUTxOSigningWitness sk -> AShelleyKeyWitness (WitnessGenesisUTxOKey sk) - ADRepSigningWitness sk -> AShelleyKeyWitness (WitnessPaymentKey $ castDrep sk) - ACommitteeColdSigningWitness sk -> AShelleyKeyWitness (WitnessCommitteeColdKey sk) - ACommitteeHotSigningWitness sk -> AShelleyKeyWitness (WitnessCommitteeHotKey sk) + AByronSigningWitness sk addr -> AByronWitness (ShelleyBootstrapWitnessSigningKeyData sk addr) + APaymentSigningWitness sk -> AShelleyKeyWitness (WitnessPaymentKey sk) + APaymentExtendedSigningWitness sk -> AShelleyKeyWitness (WitnessPaymentExtendedKey sk) + AStakeSigningWitness sk -> AShelleyKeyWitness (WitnessStakeKey sk) + AStakeExtendedSigningWitness sk -> AShelleyKeyWitness (WitnessStakeExtendedKey sk) + AStakePoolSigningWitness sk -> AShelleyKeyWitness (WitnessStakePoolKey sk) + AGenesisSigningWitness sk -> AShelleyKeyWitness (WitnessGenesisKey sk) + AGenesisExtendedSigningWitness sk -> AShelleyKeyWitness (WitnessGenesisExtendedKey sk) + AGenesisDelegateSigningWitness sk -> AShelleyKeyWitness (WitnessGenesisDelegateKey sk) + AGenesisDelegateExtendedSigningWitness sk -> AShelleyKeyWitness (WitnessGenesisDelegateExtendedKey sk) + AGenesisUTxOSigningWitness sk -> AShelleyKeyWitness (WitnessGenesisUTxOKey sk) + ADRepSigningWitness sk -> AShelleyKeyWitness (WitnessPaymentKey $ castDrep sk) + ACommitteeColdSigningWitness sk -> AShelleyKeyWitness (WitnessCommitteeColdKey sk) + ACommitteeHotSigningWitness sk -> AShelleyKeyWitness (WitnessCommitteeHotKey sk) -- TODO: Conway era - Add constrctor for SigningKey DrepKey to ShelleyWitnessSigningKey castDrep :: SigningKey DRepKey -> SigningKey PaymentKey @@ -685,9 +756,9 @@ castDrep (DRepSigningKey sk) = PaymentSigningKey sk data ReadWitnessSigningDataError = ReadWitnessSigningDataSigningKeyDecodeError !(FileError InputDecodeError) | ReadWitnessSigningDataScriptError !(FileError JsonDecodeError) - | ReadWitnessSigningDataSigningKeyAndAddressMismatch - -- ^ A Byron address was specified alongside a non-Byron signing key. - deriving Show + | -- | A Byron address was specified alongside a non-Byron signing key. + ReadWitnessSigningDataSigningKeyAndAddressMismatch + deriving (Show) -- | Render an error message for a 'ReadWitnessSigningDataError'. renderReadWitnessSigningDataError :: ReadWitnessSigningDataError -> Doc ann @@ -699,45 +770,46 @@ renderReadWitnessSigningDataError = \case ReadWitnessSigningDataSigningKeyAndAddressMismatch -> "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 skFile mbByronAddr) = do - eRes <- first ReadWitnessSigningDataSigningKeyDecodeError - <$> readKeyFileAnyOf bech32FileTypes textEnvFileTypes skFile - return $ do - res <- eRes - case (res, mbByronAddr) of - (AByronSigningWitness _ _, Just _) -> pure res - (AByronSigningWitness _ _, Nothing) -> pure res - (_, Nothing) -> pure res - (_, Just _) -> - -- A Byron address should only be specified along with a Byron signing key. - Left ReadWitnessSigningDataSigningKeyAndAddressMismatch + eRes <- + first ReadWitnessSigningDataSigningKeyDecodeError + <$> readKeyFileAnyOf bech32FileTypes textEnvFileTypes skFile + return $ do + res <- eRes + case (res, mbByronAddr) of + (AByronSigningWitness _ _, Just _) -> pure res + (AByronSigningWitness _ _, Nothing) -> pure res + (_, Nothing) -> pure res + (_, Just _) -> + -- A Byron address should only be specified along with a Byron signing key. + Left ReadWitnessSigningDataSigningKeyAndAddressMismatch where textEnvFileTypes = - [ FromSomeType (AsSigningKey AsByronKey ) (`AByronSigningWitness` mbByronAddr) - , FromSomeType (AsSigningKey AsPaymentKey ) APaymentSigningWitness - , FromSomeType (AsSigningKey AsPaymentExtendedKey ) APaymentExtendedSigningWitness - , FromSomeType (AsSigningKey AsStakeKey ) AStakeSigningWitness - , FromSomeType (AsSigningKey AsStakeExtendedKey ) AStakeExtendedSigningWitness - , FromSomeType (AsSigningKey AsStakePoolKey ) AStakePoolSigningWitness - , FromSomeType (AsSigningKey AsGenesisKey ) AGenesisSigningWitness - , FromSomeType (AsSigningKey AsGenesisExtendedKey ) AGenesisExtendedSigningWitness - , FromSomeType (AsSigningKey AsGenesisDelegateKey ) AGenesisDelegateSigningWitness - , FromSomeType (AsSigningKey AsGenesisDelegateExtendedKey ) AGenesisDelegateExtendedSigningWitness - , FromSomeType (AsSigningKey AsGenesisUTxOKey ) AGenesisUTxOSigningWitness - , FromSomeType (AsSigningKey AsDRepKey ) ADRepSigningWitness - , FromSomeType (AsSigningKey AsCommitteeColdKey ) ACommitteeColdSigningWitness - , FromSomeType (AsSigningKey AsCommitteeHotKey ) ACommitteeHotSigningWitness + [ FromSomeType (AsSigningKey AsByronKey) (`AByronSigningWitness` mbByronAddr), + FromSomeType (AsSigningKey AsPaymentKey) APaymentSigningWitness, + FromSomeType (AsSigningKey AsPaymentExtendedKey) APaymentExtendedSigningWitness, + FromSomeType (AsSigningKey AsStakeKey) AStakeSigningWitness, + FromSomeType (AsSigningKey AsStakeExtendedKey) AStakeExtendedSigningWitness, + FromSomeType (AsSigningKey AsStakePoolKey) AStakePoolSigningWitness, + FromSomeType (AsSigningKey AsGenesisKey) AGenesisSigningWitness, + FromSomeType (AsSigningKey AsGenesisExtendedKey) AGenesisExtendedSigningWitness, + FromSomeType (AsSigningKey AsGenesisDelegateKey) AGenesisDelegateSigningWitness, + FromSomeType (AsSigningKey AsGenesisDelegateExtendedKey) AGenesisDelegateExtendedSigningWitness, + FromSomeType (AsSigningKey AsGenesisUTxOKey) AGenesisUTxOSigningWitness, + FromSomeType (AsSigningKey AsDRepKey) ADRepSigningWitness, + FromSomeType (AsSigningKey AsCommitteeColdKey) ACommitteeColdSigningWitness, + FromSomeType (AsSigningKey AsCommitteeHotKey) ACommitteeHotSigningWitness ] bech32FileTypes = - [ FromSomeType (AsSigningKey AsPaymentKey ) APaymentSigningWitness - , FromSomeType (AsSigningKey AsPaymentExtendedKey ) APaymentExtendedSigningWitness - , FromSomeType (AsSigningKey AsStakeKey ) AStakeSigningWitness - , FromSomeType (AsSigningKey AsStakeExtendedKey ) AStakeExtendedSigningWitness - , FromSomeType (AsSigningKey AsStakePoolKey ) AStakePoolSigningWitness + [ FromSomeType (AsSigningKey AsPaymentKey) APaymentSigningWitness, + FromSomeType (AsSigningKey AsPaymentExtendedKey) APaymentExtendedSigningWitness, + FromSomeType (AsSigningKey AsStakeKey) AStakeSigningWitness, + FromSomeType (AsSigningKey AsStakeExtendedKey) AStakeExtendedSigningWitness, + FromSomeType (AsSigningKey AsStakePoolKey) AStakePoolSigningWitness ] -- Required signers @@ -745,7 +817,7 @@ readWitnessSigningData (KeyWitnessSigningData skFile mbByronAddr) = do data RequiredSignerError = RequiredSignerErrorFile (FileError InputDecodeError) | RequiredSignerErrorByronKey (SigningKeyFile In) - deriving Show + deriving (Show) instance Error RequiredSignerError where prettyError = \case @@ -765,27 +837,27 @@ readRequiredSigner (RequiredSignerSkeyFile skFile) = do Left $ RequiredSignerErrorByronKey skFile AShelleyKeyWitness skey -> return . getHash $ toShelleySigningKey skey - where - textEnvFileTypes = - [ FromSomeType (AsSigningKey AsPaymentKey ) APaymentSigningWitness - , FromSomeType (AsSigningKey AsPaymentExtendedKey) APaymentExtendedSigningWitness - , FromSomeType (AsSigningKey AsStakePoolKey ) AStakePoolSigningWitness - , FromSomeType (AsSigningKey AsGenesisDelegateKey) AGenesisDelegateSigningWitness - ] - bech32FileTypes = [] - - getHash :: ShelleySigningKey -> Hash PaymentKey - getHash (ShelleyExtendedSigningKey sk) = - let extSKey = PaymentExtendedSigningKey sk - payVKey = castVerificationKey $ getVerificationKey extSKey - in verificationKeyHash payVKey - getHash (ShelleyNormalSigningKey sk) = - verificationKeyHash . getVerificationKey $ PaymentSigningKey sk + where + textEnvFileTypes = + [ FromSomeType (AsSigningKey AsPaymentKey) APaymentSigningWitness, + FromSomeType (AsSigningKey AsPaymentExtendedKey) APaymentExtendedSigningWitness, + FromSomeType (AsSigningKey AsStakePoolKey) AStakePoolSigningWitness, + FromSomeType (AsSigningKey AsGenesisDelegateKey) AGenesisDelegateSigningWitness + ] + bech32FileTypes = [] + + getHash :: ShelleySigningKey -> Hash PaymentKey + getHash (ShelleyExtendedSigningKey sk) = + let extSKey = PaymentExtendedSigningKey sk + payVKey = castVerificationKey $ getVerificationKey extSKey + in verificationKeyHash payVKey + getHash (ShelleyNormalSigningKey sk) = + verificationKeyHash . getVerificationKey $ PaymentSigningKey sk data VoteError = VoteErrorFile (FileError TextEnvelopeError) | VoteErrorTextNotUnicode Text.UnicodeException - deriving Show + deriving (Show) instance Error VoteError where prettyError = \case @@ -794,10 +866,11 @@ instance Error VoteError where VoteErrorTextNotUnicode e -> "Vote text file not UTF8-encoded: " <> pretty (displayException e) -readVotingProceduresFiles :: () - => ConwayEraOnwards era - -> [VoteFile In] - -> IO (Either VoteError (VotingProcedures era)) +readVotingProceduresFiles :: + () => + ConwayEraOnwards era -> + [VoteFile In] -> + IO (Either VoteError (VotingProcedures era)) readVotingProceduresFiles w = \case [] -> return $ Right $ VotingProcedures $ Ledger.VotingProcedures Map.empty files -> runExceptT $ do @@ -805,63 +878,65 @@ readVotingProceduresFiles w = \case pure $ foldl unsafeMergeVotingProcedures emptyVotingProcedures vpss -readTxUpdateProposal :: () - => ShelleyToBabbageEra era - -> UpdateProposalFile - -> ExceptT (FileError TextEnvelopeError) IO (TxUpdateProposal era) +readTxUpdateProposal :: + () => + ShelleyToBabbageEra era -> + UpdateProposalFile -> + ExceptT (FileError TextEnvelopeError) IO (TxUpdateProposal era) readTxUpdateProposal w (UpdateProposalFile upFp) = do TxUpdateProposal w <$> newExceptT (readFileTextEnvelope AsUpdateProposal (File upFp)) -readVotingProceduresFile :: () - => ConwayEraOnwards era - -> VoteFile In - -> IO (Either VoteError (VotingProcedures era)) +readVotingProceduresFile :: + () => + ConwayEraOnwards era -> + VoteFile In -> + IO (Either VoteError (VotingProcedures era)) readVotingProceduresFile w fp = - conwayEraOnwardsConstraints w - $ first VoteErrorFile <$> readFileTextEnvelope AsVotingProcedures fp + conwayEraOnwardsConstraints w $ + first VoteErrorFile <$> readFileTextEnvelope AsVotingProcedures fp data ConstitutionError = ConstitutionErrorFile (FileError TextEnvelopeError) | ConstitutionNotSupportedInEra AnyCardanoEra | ConstitutionNotUnicodeError Text.UnicodeException - deriving Show + deriving (Show) data ProposalError = ProposalErrorFile (FileError TextEnvelopeError) | ProposalNotSupportedInEra AnyCardanoEra | ProposalNotUnicodeError Text.UnicodeException - deriving Show + deriving (Show) -readTxGovernanceActions - :: ShelleyBasedEra era - -> [ProposalFile In] - -> IO (Either ConstitutionError [Proposal era]) +readTxGovernanceActions :: + ShelleyBasedEra era -> + [ProposalFile In] -> + IO (Either ConstitutionError [Proposal era]) readTxGovernanceActions _ [] = return $ Right [] readTxGovernanceActions era files = runExceptT $ do - w <- forShelleyBasedEraMaybeEon era - & hoistMaybe (ConstitutionNotSupportedInEra $ cardanoEraConstraints (toCardanoEra era) $ AnyCardanoEra (toCardanoEra era)) + w <- + forShelleyBasedEraMaybeEon era + & hoistMaybe (ConstitutionNotSupportedInEra $ cardanoEraConstraints (toCardanoEra era) $ AnyCardanoEra (toCardanoEra era)) newExceptT $ sequence <$> mapM (fmap (first ConstitutionErrorFile) . readProposal w) files -readProposal - :: ConwayEraOnwards era - -> ProposalFile In - -> IO (Either (FileError TextEnvelopeError) (Proposal era)) +readProposal :: + ConwayEraOnwards era -> + ProposalFile In -> + IO (Either (FileError TextEnvelopeError) (Proposal era)) readProposal w fp = - conwayEraOnwardsConstraints w (readFileTextEnvelope AsProposal fp) + conwayEraOnwardsConstraints w (readFileTextEnvelope AsProposal fp) -constitutionHashSourceToHash :: () - => ConstitutionHashSource - -> ExceptT ConstitutionError IO (Ledger.SafeHash Ledger.StandardCrypto Ledger.AnchorData) +constitutionHashSourceToHash :: + () => + ConstitutionHashSource -> + ExceptT ConstitutionError IO (Ledger.SafeHash Ledger.StandardCrypto Ledger.AnchorData) constitutionHashSourceToHash constitutionHashSource = do case constitutionHashSource of - ConstitutionHashSourceFile fp -> do + ConstitutionHashSourceFile fp -> do cBs <- liftIO $ BS.readFile $ unFile fp _utf8EncodedText <- firstExceptT ConstitutionNotUnicodeError . hoistEither $ Text.decodeUtf8' cBs pure $ Ledger.hashAnchorData $ Ledger.AnchorData cBs - ConstitutionHashSourceText c -> do pure $ Ledger.hashAnchorData $ Ledger.AnchorData $ Text.encodeUtf8 c - ConstitutionHashSourceHash h -> pure h @@ -869,7 +944,7 @@ data CostModelsError = CostModelsErrorReadFile (FileError ()) | CostModelsErrorJSONDecode FilePath String | CostModelsErrorEmpty FilePath - deriving Show + deriving (Show) instance Error CostModelsError where prettyError = \case @@ -881,25 +956,25 @@ instance Error CostModelsError where "The decoded cost model was empty at: " <> pshow fp <> formatExplanation where formatExplanation = - vsep [ "" - , "The expected format of the cost models file is " - , "{" - , " \"PlutusV1\" : ," - , " \"PlutusV2\" : ," - , " \"PlutusV3\" : ," - , "}" - , "where each of the three entries may be ommited, and a is either an ordered list of parameter values like" - , "[205665, 812, 1, ...]" - , "or a map like" - , "{ \"addInteger-cpu-arguments-intercept\": 205665, \"addInteger-cpu-arguments-slope\": 812, \"addInteger-memory-arguments-intercept\": 1, ... }" - , "In both cases, the cost model must be complete, i.e. it must specify all parameters that are needed for the specific Plutus version." - , "It's not specified what will happen if you provide more parameters than necessary." - ] - - -readCostModels - :: File Alonzo.CostModels In - -> ExceptT CostModelsError IO Alonzo.CostModels + vsep + [ "", + "The expected format of the cost models file is ", + "{", + " \"PlutusV1\" : ,", + " \"PlutusV2\" : ,", + " \"PlutusV3\" : ,", + "}", + "where each of the three entries may be ommited, and a is either an ordered list of parameter values like", + "[205665, 812, 1, ...]", + "or a map like", + "{ \"addInteger-cpu-arguments-intercept\": 205665, \"addInteger-cpu-arguments-slope\": 812, \"addInteger-memory-arguments-intercept\": 1, ... }", + "In both cases, the cost model must be complete, i.e. it must specify all parameters that are needed for the specific Plutus version.", + "It's not specified what will happen if you provide more parameters than necessary." + ] + +readCostModels :: + File Alonzo.CostModels In -> + ExceptT CostModelsError IO Alonzo.CostModels readCostModels (File fp) = do bytes <- handleIOExceptT (CostModelsErrorReadFile . FileIOError fp) $ LBS.readFile fp costModels <- firstExceptT (CostModelsErrorJSONDecode fp) . except $ Aeson.eitherDecode bytes @@ -910,26 +985,26 @@ readCostModels (File fp) = do -- readFileInByronEra = undefined -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 :: + ( 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 asThing = - readFileOrPipeTextEnvelopeAnyOf - [ FromSomeType (asThing AsShelleyEra) (InAnyShelleyBasedEra ShelleyBasedEraShelley) - , FromSomeType (asThing AsAllegraEra) (InAnyShelleyBasedEra ShelleyBasedEraAllegra) - , FromSomeType (asThing AsMaryEra) (InAnyShelleyBasedEra ShelleyBasedEraMary) - , FromSomeType (asThing AsAlonzoEra) (InAnyShelleyBasedEra ShelleyBasedEraAlonzo) - , FromSomeType (asThing AsBabbageEra) (InAnyShelleyBasedEra ShelleyBasedEraBabbage) - , FromSomeType (asThing AsConwayEra) (InAnyShelleyBasedEra ShelleyBasedEraConway) - ] + readFileOrPipeTextEnvelopeAnyOf + [ FromSomeType (asThing AsShelleyEra) (InAnyShelleyBasedEra ShelleyBasedEraShelley), + FromSomeType (asThing AsAllegraEra) (InAnyShelleyBasedEra ShelleyBasedEraAllegra), + FromSomeType (asThing AsMaryEra) (InAnyShelleyBasedEra ShelleyBasedEraMary), + FromSomeType (asThing AsAlonzoEra) (InAnyShelleyBasedEra ShelleyBasedEraAlonzo), + FromSomeType (asThing AsBabbageEra) (InAnyShelleyBasedEra ShelleyBasedEraBabbage), + FromSomeType (asThing AsConwayEra) (InAnyShelleyBasedEra 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 @@ -940,9 +1015,8 @@ readFileInAnyShelleyBasedEra asThing = -- from pipes, but at present that's not an issue. data FileOrPipe = FileOrPipe FilePath (IORef (Maybe LBS.ByteString)) - instance Show FileOrPipe where - show (FileOrPipe fp _) = show fp + show (FileOrPipe fp _) = show fp fileOrPipe :: FilePath -> IO FileOrPipe fileOrPipe fp = FileOrPipe fp <$> newIORef Nothing @@ -960,44 +1034,46 @@ fileOrPipeCache (FileOrPipe _ c) = readIORef c -- contents of the file or pipe, and is blocking. readFileOrPipe :: FileOrPipe -> IO LBS.ByteString readFileOrPipe (FileOrPipe fp cacheRef) = do - cached <- readIORef cacheRef - case cached of - Just dat -> pure dat - Nothing -> bracket + cached <- readIORef cacheRef + case cached of + Just dat -> pure dat + Nothing -> + bracket (openFileBlocking fp ReadMode) hClose - (\handle -> do - -- An arbitrary block size. - let blockSize = 4096 - let go acc = do - next <- BS.hGet handle blockSize - if BS.null next - then pure acc - else go (acc <> Builder.byteString next) - contents <- go mempty - let dat = Builder.toLazyByteString contents - -- If our file is not seekable, it's likely a pipe, so we need to - -- save the result for subsequent calls - seekable <- hIsSeekable handle - unless seekable (writeIORef cacheRef (Just dat)) - pure dat) - -readFileOrPipeTextEnvelopeAnyOf - :: [FromSomeType HasTextEnvelope b] - -> FileOrPipe - -> IO (Either (FileError TextEnvelopeError) b) + ( \handle -> do + -- An arbitrary block size. + let blockSize = 4096 + let go acc = do + next <- BS.hGet handle blockSize + if BS.null next + then pure acc + else go (acc <> Builder.byteString next) + contents <- go mempty + let dat = Builder.toLazyByteString contents + -- If our file is not seekable, it's likely a pipe, so we need to + -- save the result for subsequent calls + seekable <- hIsSeekable handle + unless seekable (writeIORef cacheRef (Just dat)) + pure dat + ) + +readFileOrPipeTextEnvelopeAnyOf :: + [FromSomeType HasTextEnvelope b] -> + FileOrPipe -> + IO (Either (FileError TextEnvelopeError) b) readFileOrPipeTextEnvelopeAnyOf types file = do - let path = fileOrPipePath file - runExceptT $ do - content <- handleIOExceptT (FileIOError path) $ readFileOrPipe file - firstExceptT (FileError path) $ hoistEither $ do - te <- first TextEnvelopeAesonDecodeError $ Aeson.eitherDecode' content - deserialiseFromTextEnvelopeAnyOf types te - -readFileOrPipeTextEnvelopeCddlAnyOf - :: [FromSomeTypeCDDL TextEnvelopeCddl b] - -> FileOrPipe - -> IO (Either (FileError TextEnvelopeCddlError) b) + let path = fileOrPipePath file + runExceptT $ do + content <- handleIOExceptT (FileIOError path) $ readFileOrPipe file + firstExceptT (FileError path) $ hoistEither $ do + te <- first TextEnvelopeAesonDecodeError $ Aeson.eitherDecode' content + deserialiseFromTextEnvelopeAnyOf types te + +readFileOrPipeTextEnvelopeCddlAnyOf :: + [FromSomeTypeCDDL TextEnvelopeCddl b] -> + FileOrPipe -> + IO (Either (FileError TextEnvelopeCddlError) b) readFileOrPipeTextEnvelopeCddlAnyOf types file = do let path = fileOrPipePath file runExceptT $ do @@ -1005,52 +1081,57 @@ readFileOrPipeTextEnvelopeCddlAnyOf types file = do firstExceptT (FileError path) $ hoistEither $ do deserialiseFromTextEnvelopeCddlAnyOf types te -readTextEnvelopeCddlFromFileOrPipe - :: FileOrPipe - -> IO (Either (FileError TextEnvelopeCddlError) TextEnvelopeCddl) +readTextEnvelopeCddlFromFileOrPipe :: + FileOrPipe -> + IO (Either (FileError TextEnvelopeCddlError) TextEnvelopeCddl) readTextEnvelopeCddlFromFileOrPipe file = do let path = fileOrPipePath file runExceptT $ do - bs <- handleIOExceptT (FileIOError path) $ - readFileOrPipe file + bs <- + handleIOExceptT (FileIOError path) $ + readFileOrPipe file firstExceptT (FileError path . TextEnvelopeCddlAesonDecodeError path) - . hoistEither $ Aeson.eitherDecode' bs + . hoistEither + $ Aeson.eitherDecode' bs ---------------------------------------------------------------------------------------------------- -getStakeCredentialFromVerifier :: () - => StakeVerifier - -> ExceptT StakeCredentialError IO StakeCredential +getStakeCredentialFromVerifier :: + () => + StakeVerifier -> + ExceptT StakeCredentialError IO StakeCredential getStakeCredentialFromVerifier = \case StakeVerifierScriptFile (ScriptFile sFile) -> do ScriptInAnyLang _ script <- readFileScriptInAnyLang sFile & firstExceptT StakeCredentialScriptDecodeError pure $ StakeCredentialByScript $ hashScript script - StakeVerifierKey stakeVerKeyOrFile -> do stakeVerKey <- ExceptT (readVerificationKeyOrFile AsStakeKey stakeVerKeyOrFile) & firstExceptT StakeCredentialInputDecodeError pure $ StakeCredentialByKey $ verificationKeyHash stakeVerKey -getStakeCredentialFromIdentifier :: () - => StakeIdentifier - -> ExceptT StakeCredentialError IO StakeCredential +getStakeCredentialFromIdentifier :: + () => + StakeIdentifier -> + ExceptT StakeCredentialError IO StakeCredential getStakeCredentialFromIdentifier = \case StakeIdentifierAddress stakeAddr -> pure $ stakeAddressCredential stakeAddr StakeIdentifierVerifier stakeVerifier -> getStakeCredentialFromVerifier stakeVerifier -getStakeAddressFromVerifier :: () - => NetworkId - -> StakeVerifier - -> ExceptT StakeCredentialError IO StakeAddress +getStakeAddressFromVerifier :: + () => + NetworkId -> + StakeVerifier -> + ExceptT StakeCredentialError IO StakeAddress getStakeAddressFromVerifier networkId stakeVerifier = makeStakeAddress networkId <$> getStakeCredentialFromVerifier stakeVerifier -getDRepCredentialFromVerKeyHashOrFile :: () - => VerificationKeyOrHashOrFile DRepKey - -> ExceptT (FileError InputDecodeError) IO (Ledger.Credential Ledger.DRepRole Ledger.StandardCrypto) +getDRepCredentialFromVerKeyHashOrFile :: + () => + VerificationKeyOrHashOrFile DRepKey -> + ExceptT (FileError InputDecodeError) IO (Ledger.Credential Ledger.DRepRole Ledger.StandardCrypto) getDRepCredentialFromVerKeyHashOrFile = \case VerificationKeyOrFile verKeyOrFile -> do drepVerKey <- @@ -1058,9 +1139,10 @@ getDRepCredentialFromVerKeyHashOrFile = \case pure . Ledger.KeyHashObj . unDRepKeyHash $ verificationKeyHash drepVerKey VerificationKeyHash kh -> pure . Ledger.KeyHashObj $ unDRepKeyHash kh -getCommitteeColdCredentialFromVerKeyHashOrFile :: () - => VerificationKeyOrHashOrFile CommitteeColdKey - -> ExceptT (FileError InputDecodeError) IO (Ledger.Credential Ledger.ColdCommitteeRole Ledger.StandardCrypto) +getCommitteeColdCredentialFromVerKeyHashOrFile :: + () => + VerificationKeyOrHashOrFile CommitteeColdKey -> + ExceptT (FileError InputDecodeError) IO (Ledger.Credential Ledger.ColdCommitteeRole Ledger.StandardCrypto) getCommitteeColdCredentialFromVerKeyHashOrFile = \case VerificationKeyOrFile verKeyOrFile -> do commmitteeColdVerKey <- @@ -1069,9 +1151,10 @@ getCommitteeColdCredentialFromVerKeyHashOrFile = \case pure $ Ledger.KeyHashObj kh VerificationKeyHash (CommitteeColdKeyHash kh) -> pure $ Ledger.KeyHashObj kh -getCommitteeHotCredentialFromVerKeyHashOrFile :: () - => VerificationKeyOrHashOrFile CommitteeHotKey - -> ExceptT (FileError InputDecodeError) IO (Ledger.Credential Ledger.HotCommitteeRole Ledger.StandardCrypto) +getCommitteeHotCredentialFromVerKeyHashOrFile :: + () => + VerificationKeyOrHashOrFile CommitteeHotKey -> + ExceptT (FileError InputDecodeError) IO (Ledger.Credential Ledger.HotCommitteeRole Ledger.StandardCrypto) getCommitteeHotCredentialFromVerKeyHashOrFile = \case VerificationKeyOrFile verKeyOrFile -> do commmitteeHotVerKey <- @@ -1091,9 +1174,10 @@ renderReadSafeHashError = \case ReadSafeHashErrorInvalidHash err -> "Error reading anchor data hash: " <> err -readHexAsSafeHash :: () - => Text - -> Either ReadSafeHashError (L.SafeHash Crypto.StandardCrypto L.AnchorData) +readHexAsSafeHash :: + () => + Text -> + Either ReadSafeHashError (L.SafeHash Crypto.StandardCrypto L.AnchorData) readHexAsSafeHash hex = do let bs = Text.encodeUtf8 hex @@ -1112,9 +1196,10 @@ readSafeHash = scriptHashReader :: Opt.ReadM ScriptHash scriptHashReader = Opt.eitherReader $ Right . fromString -readVoteDelegationTarget :: () - => VoteDelegationTarget - -> ExceptT DelegationError IO (L.DRep Ledger.StandardCrypto) +readVoteDelegationTarget :: + () => + VoteDelegationTarget -> + ExceptT DelegationError IO (L.DRep Ledger.StandardCrypto) readVoteDelegationTarget voteDelegationTarget = case voteDelegationTarget of VoteDelegationTargetOfDRep drepHashSource -> do