diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 5ab6e1e3b5..c975288ade 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -142,33 +142,33 @@ library Cardano.CLI.Run.Ping Cardano.CLI.TopHandler Cardano.CLI.Types.Common + Cardano.CLI.Types.Errors.AddressCmdError + Cardano.CLI.Types.Errors.AddressInfoError + Cardano.CLI.Types.Errors.BootstrapWitnessError Cardano.CLI.Types.Errors.CardanoAddressSigningKeyConversionError Cardano.CLI.Types.Errors.CmdError Cardano.CLI.Types.Errors.DelegationError + Cardano.CLI.Types.Errors.GenesisCmdError Cardano.CLI.Types.Errors.GovernanceActionsError Cardano.CLI.Types.Errors.GovernanceCmdError Cardano.CLI.Types.Errors.GovernanceCommitteeError Cardano.CLI.Types.Errors.GovernanceQueryError Cardano.CLI.Types.Errors.GovernanceVoteCmdError Cardano.CLI.Types.Errors.ItnKeyConversionError + Cardano.CLI.Types.Errors.KeyCmdError + Cardano.CLI.Types.Errors.NodeCmdError Cardano.CLI.Types.Errors.ProtocolParamsError + Cardano.CLI.Types.Errors.QueryCmdError + Cardano.CLI.Types.Errors.QueryCmdLocalStateQueryError Cardano.CLI.Types.Errors.RegistrationError Cardano.CLI.Types.Errors.ScriptDecodeError - Cardano.CLI.Types.Errors.ShelleyAddressCmdError - Cardano.CLI.Types.Errors.ShelleyAddressInfoError - Cardano.CLI.Types.Errors.ShelleyBootstrapWitnessError - Cardano.CLI.Types.Errors.ShelleyGenesisCmdError - Cardano.CLI.Types.Errors.ShelleyKeyCmdError - Cardano.CLI.Types.Errors.ShelleyNodeCmdError - Cardano.CLI.Types.Errors.ShelleyQueryCmdError - Cardano.CLI.Types.Errors.ShelleyQueryCmdLocalStateQueryError - Cardano.CLI.Types.Errors.ShelleyStakeAddressCmdError - Cardano.CLI.Types.Errors.ShelleyTextViewFileError - Cardano.CLI.Types.Errors.ShelleyTxCmdError + Cardano.CLI.Types.Errors.StakeAddressCmdError Cardano.CLI.Types.Errors.StakeAddressDelegationError Cardano.CLI.Types.Errors.StakeAddressRegistrationError Cardano.CLI.Types.Errors.StakeCredentialError Cardano.CLI.Types.Errors.StakePoolCmdError + Cardano.CLI.Types.Errors.TextViewFileError + Cardano.CLI.Types.Errors.TxCmdError Cardano.CLI.Types.Errors.TxValidationError Cardano.CLI.Types.Governance Cardano.CLI.Types.Key diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Address.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Address.hs index e29ec12084..36bce94e65 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Address.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Address.hs @@ -20,7 +20,7 @@ import Cardano.CLI.EraBased.Commands.Address import Cardano.CLI.EraBased.Run.Address.Info import Cardano.CLI.Read import Cardano.CLI.Types.Common -import Cardano.CLI.Types.Errors.ShelleyAddressCmdError +import Cardano.CLI.Types.Errors.AddressCmdError import Cardano.CLI.Types.Key (PaymentVerifier (..), StakeIdentifier (..), StakeVerifier (..), VerificationKeyTextOrFile, generateKeyPair, readVerificationKeyOrFile, readVerificationKeyTextOrFileAnyOf) @@ -34,7 +34,7 @@ import qualified Data.Text.IO as Text runAddressCmds :: () => AddressCmds era - -> ExceptT ShelleyAddressCmdError IO () + -> ExceptT AddressCmdError IO () runAddressCmds = \case AddressKeyGen fmt kt vkf skf -> runAddressKeyGenCmd fmt kt vkf skf @@ -43,14 +43,14 @@ runAddressCmds = \case AddressBuild paymentVerifier mbStakeVerifier nw mOutFp -> runAddressBuildCmd paymentVerifier mbStakeVerifier nw mOutFp AddressInfo txt mOFp -> - runAddressInfoCmd txt mOFp & firstExceptT ShelleyAddressCmdAddressInfoError + runAddressInfoCmd txt mOFp & firstExceptT AddressCmdAddressInfoError runAddressKeyGenCmd :: KeyOutputFormat -> AddressKeyType -> VerificationKeyFile Out -> SigningKeyFile Out - -> ExceptT ShelleyAddressCmdError IO () + -> ExceptT AddressCmdError IO () runAddressKeyGenCmd fmt kt vkf skf = case kt of AddressKeyShelley -> generateAndWriteKeyFiles fmt AsPaymentKey vkf skf AddressKeyShelleyExtended -> generateAndWriteKeyFiles fmt AsPaymentExtendedKey vkf skf @@ -62,7 +62,7 @@ generateAndWriteByronKeyFiles :: () => AsType keyrole -> VerificationKeyFile Out -> SigningKeyFile Out - -> ExceptT ShelleyAddressCmdError IO () + -> ExceptT AddressCmdError IO () generateAndWriteByronKeyFiles asType vkf skf = do uncurry (writeByronPaymentKeyFiles vkf skf) =<< liftIO (generateKeyPair asType) @@ -75,7 +75,7 @@ generateAndWriteKeyFiles :: () -> AsType keyrole -> VerificationKeyFile Out -> SigningKeyFile Out - -> ExceptT ShelleyAddressCmdError IO () + -> ExceptT AddressCmdError IO () generateAndWriteKeyFiles fmt asType vkf skf = do uncurry (writePaymentKeyFiles fmt vkf skf) =<< liftIO (generateKeyPair asType) @@ -88,9 +88,9 @@ writePaymentKeyFiles -> SigningKeyFile Out -> VerificationKey keyrole -> SigningKey keyrole - -> ExceptT ShelleyAddressCmdError IO () + -> ExceptT AddressCmdError IO () writePaymentKeyFiles fmt vkeyPath skeyPath vkey skey = do - firstExceptT ShelleyAddressCmdWriteFileError $ do + firstExceptT AddressCmdWriteFileError $ do case fmt of KeyOutputFormatTextEnvelope -> newExceptT @@ -122,9 +122,9 @@ writeByronPaymentKeyFiles -> SigningKeyFile Out -> VerificationKey keyrole -> SigningKey keyrole - -> ExceptT ShelleyAddressCmdError IO () + -> ExceptT AddressCmdError IO () writeByronPaymentKeyFiles vkeyPath skeyPath vkey skey = do - firstExceptT ShelleyAddressCmdWriteFileError $ do + firstExceptT AddressCmdWriteFileError $ do -- No bech32 encoding for Byron keys newExceptT $ writeLazyByteStringFile skeyPath $ textEnvelopeToJSON (Just skeyDesc) skey newExceptT $ writeLazyByteStringFile vkeyPath $ textEnvelopeToJSON (Just vkeyDesc) vkey @@ -135,9 +135,9 @@ writeByronPaymentKeyFiles vkeyPath skeyPath vkey skey = do runAddressKeyHashCmd :: VerificationKeyTextOrFile -> Maybe (File () Out) - -> ExceptT ShelleyAddressCmdError IO () + -> ExceptT AddressCmdError IO () runAddressKeyHashCmd vkeyTextOrFile mOutputFp = do - vkey <- firstExceptT ShelleyAddressCmdVerificationKeyTextOrFileError $ + vkey <- firstExceptT AddressCmdVerificationKeyTextOrFileError $ newExceptT $ readVerificationKeyTextOrFileAnyOf vkeyTextOrFile let hexKeyHash = foldSomeAddressVerificationKey @@ -152,11 +152,11 @@ runAddressBuildCmd :: PaymentVerifier -> Maybe StakeIdentifier -> NetworkId -> Maybe (File () Out) - -> ExceptT ShelleyAddressCmdError IO () + -> ExceptT AddressCmdError IO () runAddressBuildCmd paymentVerifier mbStakeVerifier nw mOutFp = do outText <- case paymentVerifier of PaymentVerifierKey payVkeyTextOrFile -> do - payVKey <- firstExceptT ShelleyAddressCmdVerificationKeyTextOrFileError $ + payVKey <- firstExceptT AddressCmdVerificationKeyTextOrFileError $ newExceptT $ readVerificationKeyTextOrFileAnyOf payVkeyTextOrFile addr <- case payVKey of @@ -172,12 +172,12 @@ runAddressBuildCmd paymentVerifier mbStakeVerifier nw mOutFp = do AGenesisUTxOVerificationKey vk -> AddressShelley <$> buildShelleyAddress (castVerificationKey vk) mbStakeVerifier nw nonPaymentKey -> - left $ ShelleyAddressCmdExpectedPaymentVerificationKey nonPaymentKey + left $ AddressCmdExpectedPaymentVerificationKey nonPaymentKey return $ serialiseAddress (addr :: AddressAny) PaymentVerifierScriptFile (ScriptFile fp) -> do ScriptInAnyLang _lang script <- - firstExceptT ShelleyAddressCmdReadScriptFileError $ + firstExceptT AddressCmdReadScriptFileError $ readFileScriptInAnyLang fp let payCred = PaymentCredentialByScript (hashScript script) @@ -192,20 +192,20 @@ runAddressBuildCmd paymentVerifier mbStakeVerifier nw mOutFp = do makeStakeAddressRef :: StakeIdentifier - -> ExceptT ShelleyAddressCmdError IO StakeAddressReference + -> ExceptT AddressCmdError IO StakeAddressReference makeStakeAddressRef stakeIdentifier = case stakeIdentifier of StakeIdentifierVerifier stakeVerifier -> case stakeVerifier of StakeVerifierKey stkVkeyOrFile -> do - stakeVKey <- firstExceptT ShelleyAddressCmdReadKeyFileError $ + stakeVKey <- firstExceptT AddressCmdReadKeyFileError $ newExceptT $ readVerificationKeyOrFile AsStakeKey stkVkeyOrFile return . StakeAddressByValue . StakeCredentialByKey . verificationKeyHash $ stakeVKey StakeVerifierScriptFile (ScriptFile fp) -> do ScriptInAnyLang _lang script <- - firstExceptT ShelleyAddressCmdReadScriptFileError $ + firstExceptT AddressCmdReadScriptFileError $ readFileScriptInAnyLang fp let stakeCred = StakeCredentialByScript (hashScript script) @@ -217,7 +217,7 @@ buildShelleyAddress :: VerificationKey PaymentKey -> Maybe StakeIdentifier -> NetworkId - -> ExceptT ShelleyAddressCmdError IO (Address ShelleyAddr) + -> ExceptT AddressCmdError IO (Address ShelleyAddr) buildShelleyAddress vkey mbStakeVerifier nw = makeShelleyAddress nw (PaymentCredentialByKey (verificationKeyHash vkey)) <$> maybe (return NoStakeAddress) makeStakeAddressRef mbStakeVerifier diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Address/Info.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Address/Info.hs index be31af6b9b..7ce5e5d1c6 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Address/Info.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Address/Info.hs @@ -7,7 +7,7 @@ module Cardano.CLI.EraBased.Run.Address.Info import Cardano.Api -import Cardano.CLI.Types.Errors.ShelleyAddressInfoError +import Cardano.CLI.Types.Errors.AddressInfoError import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Trans.Except (ExceptT) @@ -36,7 +36,7 @@ instance ToJSON AddressInfo where , "base16" .= aiBase16 addrInfo ] -runAddressInfoCmd :: Text -> Maybe (File () Out) -> ExceptT ShelleyAddressInfoError IO () +runAddressInfoCmd :: Text -> Maybe (File () Out) -> ExceptT AddressInfoError IO () runAddressInfoCmd addrTxt mOutputFp = do addrInfo <- case (Left <$> deserialiseAddress AsAddressAny addrTxt) <|> (Right <$> deserialiseAddress AsStakeAddress addrTxt) of diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs index 2e0f2c7cda..77d7422921 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs @@ -58,8 +58,8 @@ import qualified Cardano.CLI.IO.Lazy as Lazy import Cardano.CLI.Orphans () import Cardano.CLI.Types.Common import Cardano.CLI.Types.Errors.ProtocolParamsError -import Cardano.CLI.Types.Errors.ShelleyGenesisCmdError -import Cardano.CLI.Types.Errors.ShelleyNodeCmdError +import Cardano.CLI.Types.Errors.GenesisCmdError +import Cardano.CLI.Types.Errors.NodeCmdError import Cardano.CLI.Types.Errors.StakePoolCmdError import Cardano.CLI.Types.Key import qualified Cardano.Crypto as CC @@ -139,15 +139,15 @@ import Crypto.Random as Crypto runGenesisKeyGenGenesisCmd :: VerificationKeyFile Out -> SigningKeyFile Out - -> ExceptT ShelleyGenesisCmdError IO () + -> ExceptT GenesisCmdError IO () runGenesisKeyGenGenesisCmd vkeyPath skeyPath = do skey <- liftIO $ generateSigningKey AsGenesisKey let vkey = getVerificationKey skey - firstExceptT ShelleyGenesisCmdGenesisFileError + firstExceptT GenesisCmdGenesisFileError . newExceptT $ writeLazyByteStringFile skeyPath $ textEnvelopeToJSON (Just skeyDesc) skey - firstExceptT ShelleyGenesisCmdGenesisFileError + firstExceptT GenesisCmdGenesisFileError . newExceptT $ writeLazyByteStringFile vkeyPath $ textEnvelopeToJSON (Just vkeyDesc) vkey @@ -161,19 +161,19 @@ runGenesisKeyGenDelegateCmd :: VerificationKeyFile Out -> SigningKeyFile Out -> OpCertCounterFile Out - -> ExceptT ShelleyGenesisCmdError IO () + -> ExceptT GenesisCmdError IO () runGenesisKeyGenDelegateCmd vkeyPath skeyPath ocertCtrPath = do skey <- liftIO $ generateSigningKey AsGenesisDelegateKey let vkey = getVerificationKey skey - firstExceptT ShelleyGenesisCmdGenesisFileError + firstExceptT GenesisCmdGenesisFileError . newExceptT $ writeLazyByteStringFile skeyPath $ textEnvelopeToJSON (Just skeyDesc) skey - firstExceptT ShelleyGenesisCmdGenesisFileError + firstExceptT GenesisCmdGenesisFileError . newExceptT $ writeLazyByteStringFile vkeyPath $ textEnvelopeToJSON (Just vkeyDesc) vkey - firstExceptT ShelleyGenesisCmdGenesisFileError + firstExceptT GenesisCmdGenesisFileError . newExceptT $ writeLazyByteStringFile ocertCtrPath $ textEnvelopeToJSON (Just certCtrDesc) @@ -194,15 +194,15 @@ runGenesisKeyGenDelegateCmd vkeyPath skeyPath ocertCtrPath = do runGenesisKeyGenDelegateVRF :: VerificationKeyFile Out -> SigningKeyFile Out - -> ExceptT ShelleyGenesisCmdError IO () + -> ExceptT GenesisCmdError IO () runGenesisKeyGenDelegateVRF vkeyPath skeyPath = do skey <- liftIO $ generateSigningKey AsVrfKey let vkey = getVerificationKey skey - firstExceptT ShelleyGenesisCmdGenesisFileError + firstExceptT GenesisCmdGenesisFileError . newExceptT $ writeLazyByteStringFile skeyPath $ textEnvelopeToJSON (Just skeyDesc) skey - firstExceptT ShelleyGenesisCmdGenesisFileError + firstExceptT GenesisCmdGenesisFileError . newExceptT $ writeLazyByteStringFile vkeyPath $ textEnvelopeToJSON (Just vkeyDesc) vkey @@ -215,15 +215,15 @@ runGenesisKeyGenDelegateVRF vkeyPath skeyPath = do runGenesisKeyGenUTxOCmd :: VerificationKeyFile Out -> SigningKeyFile Out - -> ExceptT ShelleyGenesisCmdError IO () + -> ExceptT GenesisCmdError IO () runGenesisKeyGenUTxOCmd vkeyPath skeyPath = do skey <- liftIO $ generateSigningKey AsGenesisUTxOKey let vkey = getVerificationKey skey - firstExceptT ShelleyGenesisCmdGenesisFileError + firstExceptT GenesisCmdGenesisFileError . newExceptT $ writeLazyByteStringFile skeyPath $ textEnvelopeToJSON (Just skeyDesc) skey - firstExceptT ShelleyGenesisCmdGenesisFileError + firstExceptT GenesisCmdGenesisFileError . newExceptT $ writeLazyByteStringFile vkeyPath $ textEnvelopeToJSON (Just vkeyDesc) vkey @@ -233,9 +233,9 @@ runGenesisKeyGenUTxOCmd vkeyPath skeyPath = do vkeyDesc = "Genesis Initial UTxO Verification Key" -runGenesisKeyHashCmd :: VerificationKeyFile In -> ExceptT ShelleyGenesisCmdError IO () +runGenesisKeyHashCmd :: VerificationKeyFile In -> ExceptT GenesisCmdError IO () runGenesisKeyHashCmd vkeyPath = do - vkey <- firstExceptT ShelleyGenesisCmdTextEnvReadFileError . newExceptT $ + vkey <- firstExceptT GenesisCmdTextEnvReadFileError . newExceptT $ readFileTextEnvelopeAnyOf [ FromSomeType (AsVerificationKey AsGenesisKey) AGenesisKey @@ -260,9 +260,9 @@ runGenesisKeyHashCmd vkeyPath = do runGenesisVerKeyCmd :: VerificationKeyFile Out -> SigningKeyFile In - -> ExceptT ShelleyGenesisCmdError IO () + -> ExceptT GenesisCmdError IO () runGenesisVerKeyCmd vkeyPath skeyPath = do - skey <- firstExceptT ShelleyGenesisCmdTextEnvReadFileError . newExceptT $ + skey <- firstExceptT GenesisCmdTextEnvReadFileError . newExceptT $ readFileTextEnvelopeAnyOf [ FromSomeType (AsSigningKey AsGenesisKey) AGenesisKey @@ -279,7 +279,7 @@ runGenesisVerKeyCmd vkeyPath skeyPath = do AGenesisDelegateKey sk -> AGenesisDelegateKey (getVerificationKey sk) AGenesisUTxOKey sk -> AGenesisUTxOKey (getVerificationKey sk) - firstExceptT ShelleyGenesisCmdGenesisFileError . newExceptT . liftIO $ + firstExceptT GenesisCmdGenesisFileError . newExceptT . liftIO $ case vkey of AGenesisKey vk -> writeLazyByteStringFile vkeyPath $ textEnvelopeToJSON Nothing vk AGenesisDelegateKey vk -> writeLazyByteStringFile vkeyPath $ textEnvelopeToJSON Nothing vk @@ -295,9 +295,9 @@ runGenesisTxInCmd :: VerificationKeyFile In -> NetworkId -> Maybe (File () Out) - -> ExceptT ShelleyGenesisCmdError IO () + -> ExceptT GenesisCmdError IO () runGenesisTxInCmd vkeyPath network mOutFile = do - vkey <- firstExceptT ShelleyGenesisCmdTextEnvReadFileError . newExceptT $ + vkey <- firstExceptT GenesisCmdTextEnvReadFileError . newExceptT $ readFileTextEnvelope (AsVerificationKey AsGenesisUTxOKey) vkeyPath let txin = genesisUTxOPseudoTxIn network (verificationKeyHash vkey) liftIO $ writeOutput mOutFile (renderTxIn txin) @@ -307,9 +307,9 @@ runGenesisAddrCmd :: VerificationKeyFile In -> NetworkId -> Maybe (File () Out) - -> ExceptT ShelleyGenesisCmdError IO () + -> ExceptT GenesisCmdError IO () runGenesisAddrCmd vkeyPath network mOutFile = do - vkey <- firstExceptT ShelleyGenesisCmdTextEnvReadFileError . newExceptT $ + vkey <- firstExceptT GenesisCmdTextEnvReadFileError . newExceptT $ readFileTextEnvelope (AsVerificationKey AsGenesisUTxOKey) vkeyPath let vkh = verificationKeyHash (castVerificationKey vkey) addr = makeShelleyAddress network (PaymentCredentialByKey vkh) @@ -333,7 +333,7 @@ runGenesisCreateCmd -> Maybe SystemStart -> Maybe Lovelace -> NetworkId - -> ExceptT ShelleyGenesisCmdError IO () + -> ExceptT GenesisCmdError IO () runGenesisCreateCmd fmt (GenesisDir rootdir) genNumGenesisKeys genNumUTxOKeys @@ -457,7 +457,7 @@ runGenesisCreateCardanoCmd :: GenesisDir -> FilePath -- ^ Alonzo Genesis -> FilePath -- ^ Conway Genesis -> Maybe FilePath - -> ExceptT ShelleyGenesisCmdError IO () + -> ExceptT GenesisCmdError IO () runGenesisCreateCardanoCmd (GenesisDir rootdir) genNumGenesisKeys genNumUTxOKeys mStart mAmount mSecurity slotLength mSlotCoeff @@ -561,7 +561,7 @@ runGenesisCreateCardanoCmd (GenesisDir rootdir) encodeFile (rootdir "node-config.json") newConfig where - convertToShelleyError = withExceptT ShelleyGenesisCmdByronError + convertToShelleyError = withExceptT GenesisCmdByronError convertGenesisKey :: Byron.SigningKey -> SigningKey GenesisExtendedKey convertGenesisKey (Byron.SigningKey xsk) = GenesisExtendedSigningKey xsk @@ -620,7 +620,7 @@ runGenesisCreateStakedCmd -> Word -- ^ pool credentials per bulk file -> Word -- ^ num stuffed UTxO entries -> Maybe FilePath -- ^ Specified stake pool relays - -> ExceptT ShelleyGenesisCmdError IO () + -> ExceptT GenesisCmdError IO () runGenesisCreateStakedCmd fmt (GenesisDir rootdir) genNumGenesisKeys genNumUTxOKeys genNumPools genNumStDelegs @@ -650,8 +650,8 @@ runGenesisCreateStakedCmd <- forM sPoolRelayFp $ \fp -> do relaySpecJsonBs <- - handleIOExceptT (ShelleyGenesisStakePoolRelayFileError fp) (LBS.readFile fp) - firstExceptT (ShelleyGenesisStakePoolRelayJsonDecodeError fp) + handleIOExceptT (GenesisCmdStakePoolRelayFileError fp) (LBS.readFile fp) + firstExceptT (GenesisCmdStakePoolRelayJsonDecodeError fp) . hoistEither $ Aeson.eitherDecode relaySpecJsonBs poolParams <- forM [ 1 .. genNumPools ] $ \index -> do @@ -659,7 +659,7 @@ runGenesisCreateStakedCmd buildPoolParams network pooldir index (fromMaybe mempty mayStakePoolRelays) when (numBulkPoolCredFiles * bulkPoolsPerFile > genNumPools) $ - left $ ShelleyGenesisCmdTooFewPoolsForBulkCreds genNumPools numBulkPoolCredFiles bulkPoolsPerFile + left $ GenesisCmdTooFewPoolsForBulkCreds genNumPools numBulkPoolCredFiles bulkPoolsPerFile -- We generate the bulk files for the last pool indices, -- so that all the non-bulk pools have stable indices at beginning: let bulkOffset = fromIntegral $ genNumPools - numBulkPoolCredFiles * bulkPoolsPerFile @@ -752,7 +752,7 @@ runGenesisCreateStakedCmd -- ------------------------------------------------------------------------------------------------- -createDelegateKeys :: KeyOutputFormat -> FilePath -> Word -> ExceptT ShelleyGenesisCmdError IO () +createDelegateKeys :: KeyOutputFormat -> FilePath -> Word -> ExceptT GenesisCmdError IO () createDelegateKeys fmt dir index = do liftIO $ createDirectoryIfMissing False dir runGenesisKeyGenDelegateCmd @@ -762,7 +762,7 @@ createDelegateKeys fmt dir index = do runGenesisKeyGenDelegateVRF (File @(VerificationKey ()) $ dir "delegate" ++ strIndex ++ ".vrf.vkey") (File @(SigningKey ()) $ dir "delegate" ++ strIndex ++ ".vrf.skey") - firstExceptT ShelleyGenesisCmdNodeCmdError $ do + firstExceptT GenesisCmdNodeCmdError $ do runNodeKeyGenKesCmd fmt (onlyOut kesVK) @@ -779,7 +779,7 @@ createDelegateKeys fmt dir index = do coldSK = File @(SigningKey ()) $ dir "delegate" ++ strIndex ++ ".skey" opCertCtr = File $ dir "delegate" ++ strIndex ++ ".counter" -createGenesisKeys :: FilePath -> Word -> ExceptT ShelleyGenesisCmdError IO () +createGenesisKeys :: FilePath -> Word -> ExceptT GenesisCmdError IO () createGenesisKeys dir index = do liftIO $ createDirectoryIfMissing False dir let strIndex = show index @@ -788,7 +788,7 @@ createGenesisKeys dir index = do (File @(SigningKey ()) $ dir "genesis" ++ strIndex ++ ".skey") -createUtxoKeys :: FilePath -> Word -> ExceptT ShelleyGenesisCmdError IO () +createUtxoKeys :: FilePath -> Word -> ExceptT GenesisCmdError IO () createUtxoKeys dir index = do liftIO $ createDirectoryIfMissing False dir let strIndex = show index @@ -796,10 +796,10 @@ createUtxoKeys dir index = do (File @(VerificationKey ()) $ dir "utxo" ++ strIndex ++ ".vkey") (File @(SigningKey ()) $ dir "utxo" ++ strIndex ++ ".skey") -createPoolCredentials :: KeyOutputFormat -> FilePath -> Word -> ExceptT ShelleyGenesisCmdError IO () +createPoolCredentials :: KeyOutputFormat -> FilePath -> Word -> ExceptT GenesisCmdError IO () createPoolCredentials fmt dir index = do liftIO $ createDirectoryIfMissing False dir - firstExceptT ShelleyGenesisCmdNodeCmdError $ do + firstExceptT GenesisCmdNodeCmdError $ do runNodeKeyGenKesCmd fmt (onlyOut kesVK) @@ -819,7 +819,7 @@ createPoolCredentials fmt dir index = do opCertCtr (KESPeriod 0) (File $ dir "opcert" ++ strIndex ++ ".cert") - firstExceptT ShelleyGenesisCmdStakeAddressCmdError $ + firstExceptT GenesisCmdStakeAddressCmdError $ runStakeAddressKeyGenCmd fmt (File @(VerificationKey ()) $ dir "staking-reward" ++ strIndex ++ ".vkey") @@ -842,17 +842,17 @@ buildPoolParams -> FilePath -- ^ File directory where the necessary pool credentials were created -> Word -> Map Word [Ledger.StakePoolRelay] -- ^ User submitted stake pool relay map - -> ExceptT ShelleyGenesisCmdError IO (Ledger.PoolParams StandardCrypto) + -> ExceptT GenesisCmdError IO (Ledger.PoolParams StandardCrypto) buildPoolParams nw dir index specifiedRelays = do StakePoolVerificationKey poolColdVK - <- firstExceptT (ShelleyGenesisCmdStakePoolCmdError . StakePoolCmdReadFileError) + <- firstExceptT (GenesisCmdStakePoolCmdError . StakePoolCmdReadFileError) . newExceptT $ readFileTextEnvelope (AsVerificationKey AsStakePoolKey) poolColdVKF VrfVerificationKey poolVrfVK - <- firstExceptT (ShelleyGenesisCmdNodeCmdError . ShelleyNodeCmdReadFileError) + <- firstExceptT (GenesisCmdNodeCmdError . NodeCmdReadFileError) . newExceptT $ readFileTextEnvelope (AsVerificationKey AsVrfKey) poolVrfVKF rewardsSVK - <- firstExceptT ShelleyGenesisCmdTextEnvReadFileError + <- firstExceptT GenesisCmdTextEnvReadFileError . newExceptT $ readFileTextEnvelope (AsVerificationKey AsStakeKey) poolRewardVKF pure Ledger.PoolParams @@ -877,15 +877,15 @@ buildPoolParams nw dir index specifiedRelays = do poolVrfVKF = File $ dir "vrf" ++ strIndex ++ ".vkey" poolRewardVKF = File $ dir "staking-reward" ++ strIndex ++ ".vkey" -writeBulkPoolCredentials :: FilePath -> Word -> [Word] -> ExceptT ShelleyGenesisCmdError IO () +writeBulkPoolCredentials :: FilePath -> Word -> [Word] -> ExceptT GenesisCmdError IO () writeBulkPoolCredentials dir bulkIx poolIxs = do creds <- mapM readPoolCreds poolIxs - handleIOExceptT (ShelleyGenesisCmdFileError . FileIOError bulkFile) $ + handleIOExceptT (GenesisCmdFileError . FileIOError bulkFile) $ LBS.writeFile bulkFile $ Aeson.encode creds where bulkFile = dir "bulk" ++ show bulkIx ++ ".creds" - readPoolCreds :: Word -> ExceptT ShelleyGenesisCmdError IO + readPoolCreds :: Word -> ExceptT GenesisCmdError IO (TextEnvelope, TextEnvelope, TextEnvelope) readPoolCreds ix = do (,,) <$> readEnvelope poolOpCert @@ -896,11 +896,11 @@ writeBulkPoolCredentials dir bulkIx poolIxs = do poolOpCert = dir "opcert" ++ strIndex ++ ".cert" poolVrfSKF = dir "vrf" ++ strIndex ++ ".skey" poolKesSKF = dir "kes" ++ strIndex ++ ".skey" - readEnvelope :: FilePath -> ExceptT ShelleyGenesisCmdError IO TextEnvelope + readEnvelope :: FilePath -> ExceptT GenesisCmdError IO TextEnvelope readEnvelope fp = do - content <- handleIOExceptT (ShelleyGenesisCmdFileError . FileIOError fp) $ + content <- handleIOExceptT (GenesisCmdFileError . FileIOError fp) $ BS.readFile fp - firstExceptT (ShelleyGenesisCmdAesonDecodeError fp . Text.pack) . hoistEither $ + firstExceptT (GenesisCmdAesonDecodeError fp . Text.pack) . hoistEither $ Aeson.eitherDecodeStrict' content -- | This function should only be used for testing purposes. @@ -938,12 +938,12 @@ getCurrentTimePlus30 = readShelleyGenesisWithDefault :: FilePath -> (ShelleyGenesis StandardCrypto -> ShelleyGenesis StandardCrypto) - -> ExceptT ShelleyGenesisCmdError IO (ShelleyGenesis StandardCrypto) + -> ExceptT GenesisCmdError IO (ShelleyGenesis StandardCrypto) readShelleyGenesisWithDefault fpath adjustDefaults = do newExceptT (readAndDecodeShelleyGenesis fpath) `catchError` \err -> case err of - ShelleyGenesisCmdGenesisFileReadError (FileIOError _ ioe) + GenesisCmdGenesisFileReadError (FileIOError _ ioe) | isDoesNotExistError ioe -> writeDefault _ -> left err where @@ -951,16 +951,16 @@ readShelleyGenesisWithDefault fpath adjustDefaults = do defaults = adjustDefaults shelleyGenesisDefaults writeDefault = do - handleIOExceptT (ShelleyGenesisCmdGenesisFileError . FileIOError fpath) $ + handleIOExceptT (GenesisCmdGenesisFileError . FileIOError fpath) $ LBS.writeFile fpath (encode defaults) return defaults readAndDecodeShelleyGenesis :: FilePath - -> IO (Either ShelleyGenesisCmdError (ShelleyGenesis StandardCrypto)) + -> IO (Either GenesisCmdError (ShelleyGenesis StandardCrypto)) readAndDecodeShelleyGenesis fpath = runExceptT $ do - lbs <- handleIOExceptT (ShelleyGenesisCmdGenesisFileReadError . FileIOError fpath) $ LBS.readFile fpath - firstExceptT (ShelleyGenesisCmdGenesisFileDecodeError fpath . Text.pack) + lbs <- handleIOExceptT (GenesisCmdGenesisFileReadError . FileIOError fpath) $ LBS.readFile fpath + firstExceptT (GenesisCmdGenesisFileDecodeError fpath . Text.pack) . hoistEither $ Aeson.eitherDecode' lbs updateTemplate @@ -1114,9 +1114,9 @@ updateCreateStakedOutputTemplate writeFileGenesis :: FilePath -> WriteFileGenesis - -> ExceptT ShelleyGenesisCmdError IO (Crypto.Hash Crypto.Blake2b_256 ByteString) + -> ExceptT GenesisCmdError IO (Crypto.Hash Crypto.Blake2b_256 ByteString) writeFileGenesis fpath genesis = do - handleIOExceptT (ShelleyGenesisCmdGenesisFileError . FileIOError fpath) $ + handleIOExceptT (GenesisCmdGenesisFileError . FileIOError fpath) $ BS.writeFile fpath content return $ Crypto.hashWith id content where @@ -1135,7 +1135,7 @@ data WriteFileGenesis where -- ---------------------------------------------------------------------------- readGenDelegsMap :: FilePath -> FilePath - -> ExceptT ShelleyGenesisCmdError IO + -> ExceptT GenesisCmdError IO (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)) readGenDelegsMap gendir deldir = do @@ -1157,7 +1157,7 @@ readGenDelegsMap gendir deldir = do dkmExtra = dkm Map.\\ combinedMap vkmExtra = vkm Map.\\ combinedMap unless (Map.null gkmExtra && Map.null dkmExtra && Map.null vkmExtra) $ - throwError $ ShelleyGenesisCmdMismatchedGenesisKeyFiles + throwError $ GenesisCmdMismatchedGenesisKeyFiles (Map.keys gkm) (Map.keys dkm) (Map.keys vkm) let delegsMap :: Map (Hash GenesisKey) @@ -1173,14 +1173,14 @@ readGenDelegsMap gendir deldir = do pure delegsMap -readGenesisKeys :: FilePath -> ExceptT ShelleyGenesisCmdError IO +readGenesisKeys :: FilePath -> ExceptT GenesisCmdError IO (Map Int (VerificationKey GenesisKey)) readGenesisKeys gendir = do files <- liftIO (listDirectory gendir) fileIxs <- extractFileNameIndexes [ gendir file | file <- files , takeExtension file == ".vkey" ] - firstExceptT ShelleyGenesisCmdTextEnvReadFileError $ + firstExceptT GenesisCmdTextEnvReadFileError $ Map.fromList <$> sequence [ (,) ix <$> readKey (File file) @@ -1190,14 +1190,14 @@ readGenesisKeys gendir = do . readFileTextEnvelope (AsVerificationKey AsGenesisKey) readDelegateKeys :: FilePath - -> ExceptT ShelleyGenesisCmdError IO + -> ExceptT GenesisCmdError IO (Map Int (VerificationKey GenesisDelegateKey)) readDelegateKeys deldir = do files <- liftIO (listDirectory deldir) fileIxs <- extractFileNameIndexes [ deldir file | file <- files , takeExtensions file == ".vkey" ] - firstExceptT ShelleyGenesisCmdTextEnvReadFileError $ + firstExceptT GenesisCmdTextEnvReadFileError $ Map.fromList <$> sequence [ (,) ix <$> readKey (File file) @@ -1206,14 +1206,14 @@ readDelegateKeys deldir = do readKey = newExceptT . readFileTextEnvelope (AsVerificationKey AsGenesisDelegateKey) -readDelegateVrfKeys :: FilePath -> ExceptT ShelleyGenesisCmdError IO +readDelegateVrfKeys :: FilePath -> ExceptT GenesisCmdError IO (Map Int (VerificationKey VrfKey)) readDelegateVrfKeys deldir = do files <- liftIO (listDirectory deldir) fileIxs <- extractFileNameIndexes [ deldir file | file <- files , takeExtensions file == ".vrf.vkey" ] - firstExceptT ShelleyGenesisCmdTextEnvReadFileError $ + firstExceptT GenesisCmdTextEnvReadFileError $ Map.fromList <$> sequence [ (,) ix <$> readKey (File file) @@ -1233,27 +1233,27 @@ extractFileNameIndex fp = xs -> readMaybe xs extractFileNameIndexes :: [FilePath] - -> ExceptT ShelleyGenesisCmdError IO [(FilePath, Int)] + -> ExceptT GenesisCmdError IO [(FilePath, Int)] extractFileNameIndexes files = do case [ file | (file, Nothing) <- filesIxs ] of [] -> return () - files' -> throwError (ShelleyGenesisCmdFilesNoIndex files') + files' -> throwError (GenesisCmdFilesNoIndex files') case filter (\g -> length g > 1) . List.groupBy ((==) `on` snd) . List.sortBy (compare `on` snd) $ [ (file, ix) | (file, Just ix) <- filesIxs ] of [] -> return () - (g:_) -> throwError (ShelleyGenesisCmdFilesDupIndex (map fst g)) + (g:_) -> throwError (GenesisCmdFilesDupIndex (map fst g)) return [ (file, ix) | (file, Just ix) <- filesIxs ] where filesIxs = [ (file, extractFileNameIndex file) | file <- files ] readInitialFundAddresses :: FilePath -> NetworkId - -> ExceptT ShelleyGenesisCmdError IO [AddressInEra ShelleyEra] + -> ExceptT GenesisCmdError IO [AddressInEra ShelleyEra] readInitialFundAddresses utxodir nw = do files <- liftIO (listDirectory utxodir) - vkeys <- firstExceptT ShelleyGenesisCmdTextEnvReadFileError $ + vkeys <- firstExceptT GenesisCmdTextEnvReadFileError $ sequence [ newExceptT $ readFileTextEnvelope (AsVerificationKey AsGenesisUTxOKey) @@ -1268,9 +1268,9 @@ readInitialFundAddresses utxodir nw = do -- | Hash a genesis file -runGenesisHashFileCmd :: GenesisFile -> ExceptT ShelleyGenesisCmdError IO () +runGenesisHashFileCmd :: GenesisFile -> ExceptT GenesisCmdError IO () runGenesisHashFileCmd (GenesisFile fpath) = do - content <- handleIOExceptT (ShelleyGenesisCmdGenesisFileError . FileIOError fpath) $ + content <- handleIOExceptT (GenesisCmdGenesisFileError . FileIOError fpath) $ BS.readFile fpath let gh :: Crypto.Hash Crypto.Blake2b_256 ByteString gh = Crypto.hashWith id content @@ -1278,18 +1278,18 @@ runGenesisHashFileCmd (GenesisFile fpath) = do readAlonzoGenesis :: FilePath - -> ExceptT ShelleyGenesisCmdError IO Alonzo.AlonzoGenesis + -> ExceptT GenesisCmdError IO Alonzo.AlonzoGenesis readAlonzoGenesis fpath = do - lbs <- handleIOExceptT (ShelleyGenesisCmdGenesisFileError . FileIOError fpath) $ LBS.readFile fpath - firstExceptT (ShelleyGenesisCmdAesonDecodeError fpath . Text.pack) + lbs <- handleIOExceptT (GenesisCmdGenesisFileError . FileIOError fpath) $ LBS.readFile fpath + firstExceptT (GenesisCmdAesonDecodeError fpath . Text.pack) . hoistEither $ Aeson.eitherDecode' lbs readConwayGenesis :: FilePath - -> ExceptT ShelleyGenesisCmdError IO (Conway.ConwayGenesis StandardCrypto) + -> ExceptT GenesisCmdError IO (Conway.ConwayGenesis StandardCrypto) readConwayGenesis fpath = do - lbs <- handleIOExceptT (ShelleyGenesisCmdGenesisFileError . FileIOError fpath) $ LBS.readFile fpath - firstExceptT (ShelleyGenesisCmdAesonDecodeError fpath . Text.pack) + lbs <- handleIOExceptT (GenesisCmdGenesisFileError . FileIOError fpath) $ LBS.readFile fpath + firstExceptT (GenesisCmdAesonDecodeError fpath . Text.pack) . hoistEither $ Aeson.eitherDecode' lbs -- Protocol Parameters @@ -1302,4 +1302,3 @@ readProtocolParameters (ProtocolParamsFile fpath) = do pparams <- handleIOExceptT (ProtocolParamsErrorFile . FileIOError fpath) $ LBS.readFile fpath firstExceptT (ProtocolParamsErrorJSON fpath . Text.pack) . hoistEither $ Aeson.eitherDecode' pparams - diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Key.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Key.hs index d6415f0590..6fd36a2495 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Key.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Key.hs @@ -26,7 +26,7 @@ import qualified Cardano.CLI.Byron.Key as Byron import Cardano.CLI.Types.Common import Cardano.CLI.Types.Errors.CardanoAddressSigningKeyConversionError import Cardano.CLI.Types.Errors.ItnKeyConversionError -import Cardano.CLI.Types.Errors.ShelleyKeyCmdError +import Cardano.CLI.Types.Errors.KeyCmdError import Cardano.CLI.Types.Key import qualified Cardano.Crypto.DSIGN as DSIGN import qualified Cardano.Crypto.Signing as Byron @@ -50,13 +50,13 @@ import System.Exit (exitFailure) runGetVerificationKeyCmd :: SigningKeyFile In -> VerificationKeyFile Out - -> ExceptT ShelleyKeyCmdError IO () + -> ExceptT KeyCmdError IO () runGetVerificationKeyCmd skf vkf = do - ssk <- firstExceptT ShelleyKeyCmdReadKeyFileError $ + ssk <- firstExceptT KeyCmdReadKeyFileError $ readSigningKeyFile skf withSomeSigningKey ssk $ \sk -> let vk = getVerificationKey sk in - firstExceptT ShelleyKeyCmdWriteFileError . newExceptT $ + firstExceptT KeyCmdWriteFileError . newExceptT $ writeLazyByteStringFile vkf $ textEnvelopeToJSON Nothing vk @@ -154,7 +154,7 @@ readSigningKeyFile skFile = runConvertToNonExtendedKeyCmd :: VerificationKeyFile In -> VerificationKeyFile Out - -> ExceptT ShelleyKeyCmdError IO () + -> ExceptT KeyCmdError IO () runConvertToNonExtendedKeyCmd evkf vkf = writeVerificationKey =<< readExtendedVerificationKeyFile evkf where @@ -165,7 +165,7 @@ runConvertToNonExtendedKeyCmd evkf vkf = writeVerificationKey :: SomeAddressVerificationKey - -> ExceptT ShelleyKeyCmdError IO () + -> ExceptT KeyCmdError IO () writeVerificationKey ssk = case ssk of APaymentExtendedVerificationKey vk -> @@ -176,24 +176,24 @@ runConvertToNonExtendedKeyCmd evkf vkf = writeToDisk vkf (castVerificationKey vk :: VerificationKey GenesisKey) AGenesisDelegateExtendedVerificationKey vk -> writeToDisk vkf (castVerificationKey vk :: VerificationKey GenesisDelegateKey) - nonExtendedKey -> left $ ShelleyKeyCmdExpectedExtendedVerificationKey nonExtendedKey + nonExtendedKey -> left $ KeyCmdExpectedExtendedVerificationKey nonExtendedKey writeToDisk :: Key keyrole => File content Out -> VerificationKey keyrole - -> ExceptT ShelleyKeyCmdError IO () + -> ExceptT KeyCmdError IO () writeToDisk vkf' vk = - firstExceptT ShelleyKeyCmdWriteFileError . newExceptT + firstExceptT KeyCmdWriteFileError . newExceptT $ writeLazyByteStringFile vkf' $ textEnvelopeToJSON Nothing vk readExtendedVerificationKeyFile :: VerificationKeyFile In - -> ExceptT ShelleyKeyCmdError IO SomeAddressVerificationKey + -> ExceptT KeyCmdError IO SomeAddressVerificationKey readExtendedVerificationKeyFile evkfile = do - vKey <- firstExceptT ShelleyKeyCmdVerificationKeyReadError + vKey <- firstExceptT KeyCmdVerificationKeyReadError . newExceptT $ readVerificationKeyTextOrFileAnyOf $ VktofVerificationKeyFile evkfile case vKey of @@ -202,7 +202,7 @@ readExtendedVerificationKeyFile evkfile = do k@AGenesisExtendedVerificationKey{} -> return k k@AGenesisDelegateExtendedVerificationKey{} -> return k nonExtendedKey -> - left $ ShelleyKeyCmdExpectedExtendedVerificationKey nonExtendedKey + left $ KeyCmdExpectedExtendedVerificationKey nonExtendedKey runConvertByronKeyCmd @@ -210,7 +210,7 @@ runConvertByronKeyCmd -> ByronKeyType -> SomeKeyFile In -- ^ Input file: old format -> File () Out -- ^ Output file: new format - -> ExceptT ShelleyKeyCmdError IO () + -> ExceptT KeyCmdError IO () runConvertByronKeyCmd mPwd (ByronPaymentKey format) (ASigningKeyFile skeyPathOld) = convertByronSigningKey mPwd format convert skeyPathOld where @@ -281,9 +281,9 @@ convertByronSigningKey -> (Byron.SigningKey -> SigningKey keyrole) -> SigningKeyFile In -- ^ Input file: old format -> File () Out -- ^ Output file: new format - -> ExceptT ShelleyKeyCmdError IO () + -> ExceptT KeyCmdError IO () convertByronSigningKey mPwd byronFormat convert skeyPathOld skeyPathNew = do - sKey <- firstExceptT ShelleyKeyCmdByronKeyFailure + sKey <- firstExceptT KeyCmdByronKeyFailure $ Byron.readByronSigningKey byronFormat skeyPathOld -- Account for password protected legacy Byron keys @@ -300,7 +300,7 @@ convertByronSigningKey mPwd byronFormat convert skeyPathOld skeyPathNew = do let sk' :: SigningKey keyrole sk' = convert unprotectedSk - firstExceptT ShelleyKeyCmdWriteFileError . newExceptT $ + firstExceptT KeyCmdWriteFileError . newExceptT $ writeLazyByteStringFile skeyPathNew $ textEnvelopeToJSON Nothing sk' convertByronVerificationKey @@ -309,26 +309,26 @@ convertByronVerificationKey => (Byron.VerificationKey -> VerificationKey keyrole) -> VerificationKeyFile In -- ^ Input file: old format -> File () Out -- ^ Output file: new format - -> ExceptT ShelleyKeyCmdError IO () + -> ExceptT KeyCmdError IO () convertByronVerificationKey convert vkeyPathOld vkeyPathNew = do - vk <- firstExceptT ShelleyKeyCmdByronKeyFailure $ + vk <- firstExceptT KeyCmdByronKeyFailure $ Byron.readPaymentVerificationKey vkeyPathOld let vk' :: VerificationKey keyrole vk' = convert vk - firstExceptT ShelleyKeyCmdWriteFileError . newExceptT $ + firstExceptT KeyCmdWriteFileError . newExceptT $ writeLazyByteStringFile vkeyPathNew $ textEnvelopeToJSON Nothing vk' runConvertByronGenesisVerificationKeyCmd :: VerificationKeyBase64 -- ^ Input key raw old format -> File () Out -- ^ Output file: new format - -> ExceptT ShelleyKeyCmdError IO () + -> ExceptT KeyCmdError IO () runConvertByronGenesisVerificationKeyCmd (VerificationKeyBase64 b64ByronVKey) vkeyPathNew = do - vk <- firstExceptT (ShelleyKeyCmdByronKeyParseError . textShow) + vk <- firstExceptT (KeyCmdByronKeyParseError . textShow) . hoistEither . Byron.Crypto.parseFullVerificationKey . Text.pack @@ -337,7 +337,7 @@ runConvertByronGenesisVerificationKeyCmd (VerificationKeyBase64 b64ByronVKey) vk let vk' :: VerificationKey GenesisKey vk' = convert vk - firstExceptT ShelleyKeyCmdWriteFileError . newExceptT $ + firstExceptT KeyCmdWriteFileError . newExceptT $ writeLazyByteStringFile vkeyPathNew $ textEnvelopeToJSON Nothing vk' where convert :: Byron.VerificationKey -> VerificationKey GenesisKey @@ -352,43 +352,43 @@ runConvertByronGenesisVerificationKeyCmd (VerificationKeyBase64 b64ByronVKey) vk runConvertITNStakeKeyCmd :: SomeKeyFile In -> File () Out - -> ExceptT ShelleyKeyCmdError IO () + -> ExceptT KeyCmdError IO () runConvertITNStakeKeyCmd (AVerificationKeyFile (File vk)) outFile = do - bech32publicKey <- firstExceptT ShelleyKeyCmdItnKeyConvError . newExceptT $ + bech32publicKey <- firstExceptT KeyCmdItnKeyConvError . newExceptT $ readFileITNKey vk vkey <- hoistEither - . first ShelleyKeyCmdItnKeyConvError + . first KeyCmdItnKeyConvError $ convertITNVerificationKey bech32publicKey - firstExceptT ShelleyKeyCmdWriteFileError . newExceptT $ + firstExceptT KeyCmdWriteFileError . newExceptT $ writeLazyByteStringFile outFile $ textEnvelopeToJSON Nothing vkey runConvertITNStakeKeyCmd (ASigningKeyFile (File sk)) outFile = do - bech32privateKey <- firstExceptT ShelleyKeyCmdItnKeyConvError . newExceptT $ + bech32privateKey <- firstExceptT KeyCmdItnKeyConvError . newExceptT $ readFileITNKey sk skey <- hoistEither - . first ShelleyKeyCmdItnKeyConvError + . first KeyCmdItnKeyConvError $ convertITNSigningKey bech32privateKey - firstExceptT ShelleyKeyCmdWriteFileError . newExceptT + firstExceptT KeyCmdWriteFileError . newExceptT $ writeLazyByteStringFile outFile $ textEnvelopeToJSON Nothing skey -runConvertITNExtendedToStakeKeyCmd :: SomeKeyFile In -> File () Out -> ExceptT ShelleyKeyCmdError IO () -runConvertITNExtendedToStakeKeyCmd (AVerificationKeyFile _) _ = left ShelleyKeyCmdWrongKeyTypeError +runConvertITNExtendedToStakeKeyCmd :: SomeKeyFile In -> File () Out -> ExceptT KeyCmdError IO () +runConvertITNExtendedToStakeKeyCmd (AVerificationKeyFile _) _ = left KeyCmdWrongKeyTypeError runConvertITNExtendedToStakeKeyCmd (ASigningKeyFile (File sk)) outFile = do - bech32privateKey <- firstExceptT ShelleyKeyCmdItnKeyConvError . newExceptT $ readFileITNKey sk - skey <- hoistEither . first ShelleyKeyCmdItnKeyConvError + bech32privateKey <- firstExceptT KeyCmdItnKeyConvError . newExceptT $ readFileITNKey sk + skey <- hoistEither . first KeyCmdItnKeyConvError $ convertITNExtendedSigningKey bech32privateKey - firstExceptT ShelleyKeyCmdWriteFileError . newExceptT + firstExceptT KeyCmdWriteFileError . newExceptT $ writeLazyByteStringFile outFile $ textEnvelopeToJSON Nothing skey -runConvertITNBip32ToStakeKeyCmd :: SomeKeyFile In -> File () Out -> ExceptT ShelleyKeyCmdError IO () -runConvertITNBip32ToStakeKeyCmd (AVerificationKeyFile _) _ = left ShelleyKeyCmdWrongKeyTypeError +runConvertITNBip32ToStakeKeyCmd :: SomeKeyFile In -> File () Out -> ExceptT KeyCmdError IO () +runConvertITNBip32ToStakeKeyCmd (AVerificationKeyFile _) _ = left KeyCmdWrongKeyTypeError runConvertITNBip32ToStakeKeyCmd (ASigningKeyFile (File sk)) outFile = do - bech32privateKey <- firstExceptT ShelleyKeyCmdItnKeyConvError . newExceptT $ readFileITNKey sk - skey <- hoistEither . first ShelleyKeyCmdItnKeyConvError + bech32privateKey <- firstExceptT KeyCmdItnKeyConvError . newExceptT $ readFileITNKey sk + skey <- hoistEither . first KeyCmdItnKeyConvError $ convertITNBIP32SigningKey bech32privateKey - firstExceptT ShelleyKeyCmdWriteFileError . newExceptT + firstExceptT KeyCmdWriteFileError . newExceptT $ writeLazyByteStringFile outFile $ textEnvelopeToJSON Nothing skey @@ -443,12 +443,12 @@ runConvertCardanoAddressSigningKeyCmd :: CardanoAddressKeyType -> SigningKeyFile In -> File () Out - -> ExceptT ShelleyKeyCmdError IO () + -> ExceptT KeyCmdError IO () runConvertCardanoAddressSigningKeyCmd keyType skFile outFile = do - sKey <- firstExceptT ShelleyKeyCmdCardanoAddressSigningKeyFileError + sKey <- firstExceptT KeyCmdCardanoAddressSigningKeyFileError . newExceptT $ readSomeCardanoAddressSigningKeyFile keyType skFile - firstExceptT ShelleyKeyCmdWriteFileError . newExceptT + firstExceptT KeyCmdWriteFileError . newExceptT $ writeSomeCardanoAddressSigningKeyFile outFile sKey -- | Some kind of signing key that was converted from a @cardano-address@ diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Node.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Node.hs index d41daa3db4..98ad912287 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Node.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Node.hs @@ -13,7 +13,7 @@ import Cardano.Api import Cardano.Api.Shelley import Cardano.CLI.Types.Common -import Cardano.CLI.Types.Errors.ShelleyNodeCmdError +import Cardano.CLI.Types.Errors.NodeCmdError import Cardano.CLI.Types.Key import Control.Monad.IO.Class (MonadIO (..)) @@ -30,36 +30,36 @@ runNodeKeyGenColdCmd -> VerificationKeyFile Out -> SigningKeyFile Out -> OpCertCounterFile Out - -> ExceptT ShelleyNodeCmdError IO () + -> ExceptT NodeCmdError IO () runNodeKeyGenColdCmd fmt vkeyPath skeyPath ocertCtrPath = do skey <- liftIO $ generateSigningKey AsStakePoolKey let vkey = getVerificationKey skey case fmt of KeyOutputFormatTextEnvelope -> - firstExceptT ShelleyNodeCmdWriteFileError + firstExceptT NodeCmdWriteFileError . newExceptT $ writeLazyByteStringFile skeyPath $ textEnvelopeToJSON (Just skeyDesc) skey KeyOutputFormatBech32 -> - firstExceptT ShelleyNodeCmdWriteFileError + firstExceptT NodeCmdWriteFileError . newExceptT $ writeTextFile skeyPath $ serialiseToBech32 skey case fmt of KeyOutputFormatTextEnvelope -> - firstExceptT ShelleyNodeCmdWriteFileError + firstExceptT NodeCmdWriteFileError . newExceptT $ writeLazyByteStringFile vkeyPath $ textEnvelopeToJSON (Just vkeyDesc) vkey KeyOutputFormatBech32 -> - firstExceptT ShelleyNodeCmdWriteFileError + firstExceptT NodeCmdWriteFileError . newExceptT $ writeTextFile vkeyPath $ serialiseToBech32 vkey - firstExceptT ShelleyNodeCmdWriteFileError + firstExceptT NodeCmdWriteFileError . newExceptT $ writeLazyByteStringFile ocertCtrPath $ textEnvelopeToJSON (Just ocertCtrDesc) @@ -83,7 +83,7 @@ runNodeKeyGenKesCmd :: KeyOutputFormat -> VerificationKeyFile Out -> SigningKeyFile Out - -> ExceptT ShelleyNodeCmdError IO () + -> ExceptT NodeCmdError IO () runNodeKeyGenKesCmd fmt vkeyPath skeyPath = do skey <- liftIO $ generateSigningKey AsKesKey @@ -91,24 +91,24 @@ runNodeKeyGenKesCmd fmt vkeyPath skeyPath = do case fmt of KeyOutputFormatTextEnvelope -> - firstExceptT ShelleyNodeCmdWriteFileError + firstExceptT NodeCmdWriteFileError . newExceptT $ writeLazyByteStringFileWithOwnerPermissions skeyPath $ textEnvelopeToJSON (Just skeyDesc) skey KeyOutputFormatBech32 -> - firstExceptT ShelleyNodeCmdWriteFileError + firstExceptT NodeCmdWriteFileError . newExceptT $ writeTextFile skeyPath $ serialiseToBech32 skey case fmt of KeyOutputFormatTextEnvelope -> - firstExceptT ShelleyNodeCmdWriteFileError + firstExceptT NodeCmdWriteFileError . newExceptT $ writeLazyByteStringFile vkeyPath $ textEnvelopeToJSON (Just vkeyDesc) vkey KeyOutputFormatBech32 -> - firstExceptT ShelleyNodeCmdWriteFileError + firstExceptT NodeCmdWriteFileError . newExceptT $ writeTextFile vkeyPath $ serialiseToBech32 vkey @@ -124,7 +124,7 @@ runNodeKeyGenVrfCmd :: KeyOutputFormat -> VerificationKeyFile Out -> SigningKeyFile Out - -> ExceptT ShelleyNodeCmdError IO () + -> ExceptT NodeCmdError IO () runNodeKeyGenVrfCmd fmt vkeyPath skeyPath = do skey <- liftIO $ generateSigningKey AsVrfKey @@ -132,24 +132,24 @@ runNodeKeyGenVrfCmd fmt vkeyPath skeyPath = do case fmt of KeyOutputFormatTextEnvelope -> - firstExceptT ShelleyNodeCmdWriteFileError + firstExceptT NodeCmdWriteFileError . newExceptT $ writeLazyByteStringFileWithOwnerPermissions skeyPath $ textEnvelopeToJSON (Just skeyDesc) skey KeyOutputFormatBech32 -> - firstExceptT ShelleyNodeCmdWriteFileError + firstExceptT NodeCmdWriteFileError . newExceptT $ writeTextFile skeyPath $ serialiseToBech32 skey case fmt of KeyOutputFormatTextEnvelope -> - firstExceptT ShelleyNodeCmdWriteFileError + firstExceptT NodeCmdWriteFileError . newExceptT $ writeLazyByteStringFile vkeyPath $ textEnvelopeToJSON (Just vkeyDesc) vkey KeyOutputFormatBech32 -> - firstExceptT ShelleyNodeCmdWriteFileError + firstExceptT NodeCmdWriteFileError . newExceptT $ writeTextFile vkeyPath $ serialiseToBech32 vkey @@ -160,9 +160,9 @@ runNodeKeyGenVrfCmd fmt vkeyPath skeyPath = do runNodeKeyHashVrfCmd :: VerificationKeyOrFile VrfKey -> Maybe (File () Out) - -> ExceptT ShelleyNodeCmdError IO () + -> ExceptT NodeCmdError IO () runNodeKeyHashVrfCmd verKeyOrFile mOutputFp = do - vkey <- firstExceptT ShelleyNodeCmdReadKeyFileError + vkey <- firstExceptT NodeCmdReadKeyFileError . newExceptT $ readVerificationKeyOrFile AsVrfKey verKeyOrFile @@ -176,16 +176,16 @@ runNodeKeyHashVrfCmd verKeyOrFile mOutputFp = do runNodeNewCounterCmd :: ColdVerificationKeyOrFile -> Word -> OpCertCounterFile InOut - -> ExceptT ShelleyNodeCmdError IO () + -> ExceptT NodeCmdError IO () runNodeNewCounterCmd coldVerKeyOrFile counter ocertCtrPath = do - vkey <- firstExceptT ShelleyNodeCmdReadFileError . newExceptT $ + vkey <- firstExceptT NodeCmdReadFileError . newExceptT $ readColdVerificationKeyOrFile coldVerKeyOrFile let ocertIssueCounter = OperationalCertificateIssueCounter (fromIntegral counter) vkey - firstExceptT ShelleyNodeCmdWriteFileError . newExceptT + firstExceptT NodeCmdWriteFileError . newExceptT $ writeLazyByteStringFile (onlyOut ocertCtrPath) $ textEnvelopeToJSON Nothing ocertIssueCounter @@ -200,18 +200,18 @@ runNodeIssueOpCertCmd :: VerificationKeyOrFile KesKey -> KESPeriod -- ^ Start of the validity period for this certificate. -> File () Out - -> ExceptT ShelleyNodeCmdError IO () + -> ExceptT NodeCmdError IO () runNodeIssueOpCertCmd kesVerKeyOrFile stakePoolSKeyFile ocertCtrPath kesPeriod certFile = do - ocertIssueCounter <- firstExceptT ShelleyNodeCmdReadFileError + ocertIssueCounter <- firstExceptT NodeCmdReadFileError . newExceptT $ readFileTextEnvelope AsOperationalCertificateIssueCounter (onlyIn ocertCtrPath) - verKeyKes <- firstExceptT ShelleyNodeCmdReadKeyFileError + verKeyKes <- firstExceptT NodeCmdReadKeyFileError . newExceptT $ readVerificationKeyOrFile AsKesKey kesVerKeyOrFile - signKey <- firstExceptT ShelleyNodeCmdReadKeyFileError + signKey <- firstExceptT NodeCmdReadKeyFileError . newExceptT $ readKeyFileAnyOf bech32PossibleBlockIssuers @@ -219,7 +219,7 @@ runNodeIssueOpCertCmd kesVerKeyOrFile stakePoolSKeyFile ocertCtrPath kesPeriod c stakePoolSKeyFile (ocert, nextOcertCtr) <- - firstExceptT ShelleyNodeCmdOperationalCertificateIssueError + firstExceptT NodeCmdOperationalCertificateIssueError . hoistEither $ issueOperationalCertificate verKeyKes @@ -229,12 +229,12 @@ runNodeIssueOpCertCmd kesVerKeyOrFile stakePoolSKeyFile ocertCtrPath kesPeriod c -- Write the counter first, to reduce the chance of ending up with -- a new cert but without updating the counter. - firstExceptT ShelleyNodeCmdWriteFileError + firstExceptT NodeCmdWriteFileError . newExceptT $ writeLazyByteStringFile (onlyOut ocertCtrPath) $ textEnvelopeToJSON (Just $ ocertCtrDesc $ getCounter nextOcertCtr) nextOcertCtr - firstExceptT ShelleyNodeCmdWriteFileError + firstExceptT NodeCmdWriteFileError . newExceptT $ writeLazyByteStringFile certFile $ textEnvelopeToJSON Nothing ocert diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs index 1246daf794..206254136d 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs @@ -28,7 +28,7 @@ module Cardano.CLI.EraBased.Run.Query , runQueryUTxOCmd , DelegationsAndRewards(..) - , renderShelleyQueryCmdError + , renderQueryCmdError , renderLocalStateQueryError , percentage ) where @@ -43,8 +43,8 @@ import Cardano.CLI.EraBased.Run.Genesis (readAndDecodeShelleyGenesis) import Cardano.CLI.Helpers (pPrintCBOR) import Cardano.CLI.Pretty import Cardano.CLI.Types.Common -import Cardano.CLI.Types.Errors.ShelleyQueryCmdError -import Cardano.CLI.Types.Errors.ShelleyQueryCmdLocalStateQueryError +import Cardano.CLI.Types.Errors.QueryCmdError +import Cardano.CLI.Types.Errors.QueryCmdLocalStateQueryError import Cardano.CLI.Types.Key (VerificationKeyOrHashOrFile, readVerificationKeyOrHashOrFile) import qualified Cardano.CLI.Types.Output as O @@ -108,37 +108,37 @@ runQueryConstitutionHashCmd -> AnyConsensusModeParams -> NetworkId -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () runQueryConstitutionHashCmd socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath result <- liftIO $ executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . QueryCmdUnsupportedNtcVersion) sbe <- requireShelleyBasedEra era - & onNothing (left ShelleyQueryCmdByronEra) + & onNothing (left QueryCmdByronEra) let cMode = consensusModeOnly cModeParams eInMode <- toEraInMode era cMode - & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) + & hoistMaybe (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) lift (shelleyBasedEraConstraints sbe (queryConstitutionHash eInMode sbe)) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdEraMismatch) + & onLeft (left . QueryCmdUnsupportedNtcVersion) + & onLeft (left . QueryCmdEraMismatch) - writeConstitutionHash mOutFile =<< except (join (first ShelleyQueryCmdAcquireFailure result)) + writeConstitutionHash mOutFile =<< except (join (first QueryCmdAcquireFailure result)) where writeConstitutionHash :: Maybe (File () Out) -> Maybe (SafeHash StandardCrypto L.AnchorData) - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () writeConstitutionHash mOutFile' cHash = case mOutFile' of Nothing -> liftIO $ LBS.putStrLn (encodePretty cHash) Just (File fpath) -> - handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError fpath) $ + handleIOExceptT (QueryCmdWriteFileError . FileIOError fpath) $ LBS.writeFile fpath (encodePretty cHash) runQueryProtocolParametersCmd @@ -146,19 +146,19 @@ runQueryProtocolParametersCmd -> AnyConsensusModeParams -> NetworkId -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () runQueryProtocolParametersCmd socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath - anyE@(AnyCardanoEra era) <- firstExceptT ShelleyQueryCmdAcquireFailure $ newExceptT $ determineEra cModeParams localNodeConnInfo + anyE@(AnyCardanoEra era) <- firstExceptT QueryCmdAcquireFailure $ newExceptT $ determineEra cModeParams localNodeConnInfo sbe <- case cardanoEraStyle era of - LegacyByronEra -> left ShelleyQueryCmdByronEra + LegacyByronEra -> left QueryCmdByronEra ShelleyBasedEra sbe -> return sbe let cMode = consensusModeOnly cModeParams eInMode <- toEraInMode era cMode - & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) + & hoistMaybe (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) let qInMode = QueryInEra eInMode $ QueryInShelleyBasedEra sbe Api.QueryProtocolParameters - pp <- firstExceptT ShelleyQueryCmdConvenienceError + pp <- firstExceptT QueryCmdConvenienceError . newExceptT $ executeQueryAnyMode era localNodeConnInfo qInMode writeProtocolParameters sbe mOutFile pp where @@ -167,13 +167,13 @@ runQueryProtocolParametersCmd socketPath (AnyConsensusModeParams cModeParams) ne :: ShelleyBasedEra era -> Maybe (File () Out) -> Ledger.PParams (ShelleyLedgerEra era) - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () writeProtocolParameters sbe mOutFile' pparams = let apiPParamsJSON = (encodePretty $ fromLedgerPParams sbe pparams) in case mOutFile' of Nothing -> liftIO $ LBS.putStrLn apiPParamsJSON Just (File fpath) -> - handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError fpath) $ + handleIOExceptT (QueryCmdWriteFileError . FileIOError fpath) $ LBS.writeFile fpath apiPParamsJSON -- | Calculate the percentage sync rendered as text. @@ -215,7 +215,7 @@ runQueryTipCmd -> AnyConsensusModeParams -> NetworkId -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () runQueryTipCmd socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do case consensusModeOnly cModeParams of CardanoMode -> do @@ -223,11 +223,11 @@ runQueryTipCmd socketPath (AnyConsensusModeParams cModeParams) network mOutFile eLocalState <- ExceptT $ fmap sequence $ executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do - era <- lift queryCurrentEra & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - eraHistory <- lift queryEraHistory & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - mChainBlockNo <- lift queryChainBlockNo & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) & fmap Just - mChainPoint <- lift queryChainPoint & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) & fmap Just - mSystemStart <- lift querySystemStart & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) & fmap Just + era <- lift queryCurrentEra & onLeft (left . QueryCmdUnsupportedNtcVersion) + eraHistory <- lift queryEraHistory & onLeft (left . QueryCmdUnsupportedNtcVersion) + mChainBlockNo <- lift queryChainBlockNo & onLeft (left . QueryCmdUnsupportedNtcVersion) & fmap Just + mChainPoint <- lift queryChainPoint & onLeft (left . QueryCmdUnsupportedNtcVersion) & fmap Just + mSystemStart <- lift querySystemStart & onLeft (left . QueryCmdUnsupportedNtcVersion) & fmap Just return O.QueryTipLocalState { O.era = era @@ -236,8 +236,8 @@ runQueryTipCmd socketPath (AnyConsensusModeParams cModeParams) network mOutFile , O.mChainTip = makeChainTip <$> mChainBlockNo <*> mChainPoint } - mLocalState <- hushM (first ShelleyQueryCmdAcquireFailure eLocalState) $ \e -> - liftIO . T.hPutStrLn IO.stderr $ "Warning: Local state unavailable: " <> renderShelleyQueryCmdError e + mLocalState <- hushM (first QueryCmdAcquireFailure eLocalState) $ \e -> + liftIO . T.hPutStrLn IO.stderr $ "Warning: Local state unavailable: " <> renderQueryCmdError e chainTip <- pure (mLocalState >>= O.mChainTip) -- The chain tip is unavailable via local state query because we are connecting with an older @@ -254,7 +254,7 @@ runQueryTipCmd socketPath (AnyConsensusModeParams cModeParams) network mOutFile case slotToEpoch tipSlotNo (O.eraHistory localState) of Left e -> do liftIO . T.hPutStrLn IO.stderr $ - "Warning: Epoch unavailable: " <> renderShelleyQueryCmdError (ShelleyQueryCmdPastHorizon e) + "Warning: Epoch unavailable: " <> renderQueryCmdError (QueryCmdPastHorizon e) return $ O.QueryTipLocalStateOutput { O.localStateChainTip = chainTip , O.mEra = Nothing @@ -266,16 +266,16 @@ runQueryTipCmd socketPath (AnyConsensusModeParams cModeParams) network mOutFile Right (epochNo, SlotsInEpoch slotsInEpoch, SlotsToEpochEnd slotsToEpochEnd) -> do syncProgressResult <- runExceptT $ do - systemStart <- fmap getSystemStart (O.mSystemStart localState) & hoistMaybe ShelleyQueryCmdSystemStartUnavailable + systemStart <- fmap getSystemStart (O.mSystemStart localState) & hoistMaybe QueryCmdSystemStartUnavailable nowSeconds <- toRelativeTime (SystemStart systemStart) <$> liftIO getCurrentTime - tipTimeResult <- getProgress tipSlotNo (O.eraHistory localState) & bimap ShelleyQueryCmdPastHorizon fst & except + tipTimeResult <- getProgress tipSlotNo (O.eraHistory localState) & bimap QueryCmdPastHorizon fst & except let tolerance = RelativeTime (secondsToNominalDiffTime 600) return $ flip (percentage tolerance) nowSeconds tipTimeResult mSyncProgress <- hushM syncProgressResult $ \e -> do - liftIO . T.hPutStrLn IO.stderr $ "Warning: Sync progress unavailable: " <> renderShelleyQueryCmdError e + liftIO . T.hPutStrLn IO.stderr $ "Warning: Sync progress unavailable: " <> renderQueryCmdError e return $ O.QueryTipLocalStateOutput { O.localStateChainTip = chainTip @@ -290,7 +290,7 @@ runQueryTipCmd socketPath (AnyConsensusModeParams cModeParams) network mOutFile Just (File fpath) -> liftIO $ LBS.writeFile fpath $ encodePretty localStateOutput Nothing -> liftIO $ LBS.putStrLn $ encodePretty localStateOutput - mode -> left (ShelleyQueryCmdUnsupportedMode (AnyConsensusMode mode)) + mode -> left (QueryCmdUnsupportedMode (AnyConsensusMode mode)) -- | Query the UTxO, filtered by a given set of addresses, from a Shelley node -- via the local state query protocol. @@ -300,7 +300,7 @@ runQueryUTxOCmd -> QueryUTxOFilter -> NetworkId -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () runQueryUTxOCmd socketPath (AnyConsensusModeParams cModeParams) qfilter network mOutFile = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath @@ -308,28 +308,28 @@ runQueryUTxOCmd socketPath (AnyConsensusModeParams cModeParams) join $ lift ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . QueryCmdUnsupportedNtcVersion) let cMode = consensusModeOnly cModeParams sbe <- requireShelleyBasedEra era - & onNothing (left ShelleyQueryCmdByronEra) + & onNothing (left QueryCmdByronEra) eInMode <- pure (toEraInMode era cMode) - & onNothing (left (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)) + & onNothing (left (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)) eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams requireNotByronEraInByronMode eraInMode utxo <- lift (queryUtxo eInMode sbe qfilter) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + & onLeft (left . QueryCmdUnsupportedNtcVersion) + & onLeft (left . QueryCmdLocalStateQueryError . EraMismatchError) pure $ do writeFilteredUTxOs sbe mOutFile utxo ) - & onLeft (left . ShelleyQueryCmdAcquireFailure) + & onLeft (left . QueryCmdAcquireFailure) & onLeft left runQueryKesPeriodInfoCmd @@ -338,10 +338,10 @@ runQueryKesPeriodInfoCmd -> NetworkId -> File () In -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () runQueryKesPeriodInfoCmd socketPath (AnyConsensusModeParams cModeParams) network nodeOpCertFile mOutFile = do opCert <- lift (readFileTextEnvelope AsOperationalCertificate nodeOpCertFile) - & onLeft (left . ShelleyQueryCmdOpCertCounterReadError) + & onLeft (left . QueryCmdOpCertCounterReadError) let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath @@ -352,13 +352,13 @@ runQueryKesPeriodInfoCmd socketPath (AnyConsensusModeParams cModeParams) network join $ lift ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . QueryCmdUnsupportedNtcVersion) sbe <- requireShelleyBasedEra era - & onNothing (left ShelleyQueryCmdByronEra) + & onNothing (left QueryCmdByronEra) eInMode <- toEraInMode era cMode - & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) + & hoistMaybe (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) -- We check that the KES period specified in the operational certificate is correct -- based on the KES period defined in the genesis parameters and the current slot number @@ -367,19 +367,19 @@ runQueryKesPeriodInfoCmd socketPath (AnyConsensusModeParams cModeParams) network requireNotByronEraInByronMode eraInMode gParams <- lift (queryGenesisParameters eInMode sbe) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + & onLeft (left . QueryCmdUnsupportedNtcVersion) + & onLeft (left . QueryCmdLocalStateQueryError . EraMismatchError) eraHistory <- lift queryEraHistory - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . QueryCmdUnsupportedNtcVersion) let eInfo = toTentativeEpochInfo eraHistory -- We get the operational certificate counter from the protocol state and check that -- it is equivalent to what we have on disk. ptclState <- lift (queryProtocolState eInMode sbe) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + & onLeft (left . QueryCmdUnsupportedNtcVersion) + & onLeft (left . QueryCmdLocalStateQueryError . EraMismatchError) pure $ do chainTip <- liftIO $ getLocalChainTip localNodeConnInfo @@ -402,13 +402,13 @@ runQueryKesPeriodInfoCmd socketPath (AnyConsensusModeParams cModeParams) network liftIO $ LBS.putStrLn kesPeriodInfoJSON forM_ mOutFile (\(File oFp) -> - handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError oFp) + handleIOExceptT (QueryCmdWriteFileError . FileIOError oFp) $ LBS.writeFile oFp kesPeriodInfoJSON) ) - & onLeft (left . ShelleyQueryCmdAcquireFailure) + & onLeft (left . QueryCmdAcquireFailure) & onLeft left - mode -> left . ShelleyQueryCmdUnsupportedMode $ AnyConsensusMode mode + mode -> left . QueryCmdUnsupportedMode $ AnyConsensusMode mode where currentKesPeriod :: ChainTip -> GenesisParameters era -> CurrentKesPeriod @@ -550,12 +550,12 @@ runQueryKesPeriodInfoCmd socketPath (AnyConsensusModeParams cModeParams) network => Crypto.ADDRHASH (Consensus.PraosProtocolSupportsNodeCrypto (ConsensusProtocol era)) ~ Blake2b.Blake2b_224 => ProtocolState era -> OperationalCertificate - -> ExceptT ShelleyQueryCmdError IO (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter) + -> ExceptT QueryCmdError IO (OpCertOnDiskCounter, Maybe OpCertNodeStateCounter) opCertOnDiskAndStateCounters ptclState opCert@(OperationalCertificate _ stakePoolVKey) = do let onDiskOpCertCount = fromIntegral $ getOpCertCount opCert chainDepState <- pure (decodeProtocolState ptclState) - & onLeft (left . ShelleyQueryCmdProtocolStateDecodeFailure) + & onLeft (left . QueryCmdProtocolStateDecodeFailure) -- We need the stake pool id to determine what the counter of our SPO -- should be. @@ -618,35 +618,35 @@ runQueryPoolStateCmd -> AnyConsensusModeParams -> NetworkId -> [Hash StakePoolKey] - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () runQueryPoolStateCmd socketPath (AnyConsensusModeParams cModeParams) network poolIds = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath join $ lift ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . QueryCmdUnsupportedNtcVersion) let cMode = consensusModeOnly cModeParams sbe <- requireShelleyBasedEra era - & onNothing (left ShelleyQueryCmdByronEra) + & onNothing (left QueryCmdByronEra) eInMode <- toEraInMode era cMode - & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) + & hoistMaybe (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams requireNotByronEraInByronMode eraInMode result <- lift (queryPoolState eInMode sbe $ Just $ Set.fromList poolIds) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + & onLeft (left . QueryCmdUnsupportedNtcVersion) + & onLeft (left . QueryCmdLocalStateQueryError . EraMismatchError) pure $ do shelleyBasedEraConstraints sbe writePoolState result ) - & onLeft (left . ShelleyQueryCmdAcquireFailure) + & onLeft (left . QueryCmdAcquireFailure) & onLeft left -- | Query the local mempool state @@ -656,18 +656,18 @@ runQueryTxMempoolCmd -> NetworkId -> TxMempoolQuery -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () runQueryTxMempoolCmd socketPath (AnyConsensusModeParams cModeParams) network query mOutFile = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath localQuery <- case query of TxMempoolQueryTxExists tx -> do anyE@(AnyCardanoEra era) <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing (determineEraExpr cModeParams)) - & onLeft (left . ShelleyQueryCmdAcquireFailure) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . QueryCmdAcquireFailure) + & onLeft (left . QueryCmdUnsupportedNtcVersion) let cMode = consensusModeOnly cModeParams eInMode <- toEraInMode era cMode - & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) + & hoistMaybe (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) pure $ LocalTxMonitoringQueryTx $ TxIdInMode tx eInMode TxMempoolQueryNextTx -> pure LocalTxMonitoringSendNextTx TxMempoolQueryInfo -> pure LocalTxMonitoringMempoolInformation @@ -676,7 +676,7 @@ runQueryTxMempoolCmd socketPath (AnyConsensusModeParams cModeParams) network que let renderedResult = encodePretty result case mOutFile of Nothing -> liftIO $ LBS.putStrLn renderedResult - Just (File oFp) -> handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError oFp) + Just (File oFp) -> handleIOExceptT (QueryCmdWriteFileError . FileIOError oFp) $ LBS.writeFile oFp renderedResult runQuerySlotNumberCmd @@ -684,7 +684,7 @@ runQuerySlotNumberCmd -> AnyConsensusModeParams -> NetworkId -> UTCTime - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () runQuerySlotNumberCmd sockPath aCmp network utcTime = do SlotNo slotNo <- utcTimeToSlotNo sockPath aCmp network utcTime liftIO . putStr $ show slotNo @@ -698,22 +698,22 @@ runQueryStakeSnapshotCmd -> NetworkId -> AllOrOnly [Hash StakePoolKey] -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () runQueryStakeSnapshotCmd socketPath (AnyConsensusModeParams cModeParams) network allOrOnlyPoolIds mOutFile = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath join $ lift ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . QueryCmdUnsupportedNtcVersion) let cMode = consensusModeOnly cModeParams sbe <- requireShelleyBasedEra era - & onNothing (left ShelleyQueryCmdByronEra) + & onNothing (left QueryCmdByronEra) eInMode <- toEraInMode era cMode - & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) + & hoistMaybe (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) let poolFilter = case allOrOnlyPoolIds of All -> Nothing @@ -724,13 +724,13 @@ runQueryStakeSnapshotCmd socketPath (AnyConsensusModeParams cModeParams) network requireNotByronEraInByronMode eraInMode2 result <- lift (queryStakeSnapshot eInMode sbe poolFilter) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + & onLeft (left . QueryCmdUnsupportedNtcVersion) + & onLeft (left . QueryCmdLocalStateQueryError . EraMismatchError) pure $ do shelleyBasedEraConstraints sbe (writeStakeSnapshots mOutFile) result ) - & onLeft (left . ShelleyQueryCmdAcquireFailure) + & onLeft (left . QueryCmdAcquireFailure) & onLeft left runQueryLedgerStateCmd @@ -738,35 +738,35 @@ runQueryLedgerStateCmd -> AnyConsensusModeParams -> NetworkId -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () runQueryLedgerStateCmd socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath join $ lift ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . QueryCmdUnsupportedNtcVersion) let cMode = consensusModeOnly cModeParams sbe <- requireShelleyBasedEra era - & onNothing (left ShelleyQueryCmdByronEra) + & onNothing (left QueryCmdByronEra) eInMode <- pure (toEraInMode era cMode) - & onNothing (left (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)) + & onNothing (left (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)) eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams requireNotByronEraInByronMode eraInMode result <- lift (queryDebugLedgerState eInMode sbe) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + & onLeft (left . QueryCmdUnsupportedNtcVersion) + & onLeft (left . QueryCmdLocalStateQueryError . EraMismatchError) pure $ do shelleyBasedEraConstraints sbe (writeLedgerState mOutFile) result ) - & onLeft (left . ShelleyQueryCmdAcquireFailure) + & onLeft (left . QueryCmdAcquireFailure) & onLeft left runQueryProtocolStateCmd @@ -774,37 +774,37 @@ runQueryProtocolStateCmd -> AnyConsensusModeParams -> NetworkId -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () runQueryProtocolStateCmd socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath join $ lift ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . QueryCmdUnsupportedNtcVersion) let cMode = consensusModeOnly cModeParams sbe <- requireShelleyBasedEra era - & onNothing (left ShelleyQueryCmdByronEra) + & onNothing (left QueryCmdByronEra) eInMode <- pure (toEraInMode era cMode) - & onNothing (left (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)) + & onNothing (left (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)) eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams requireNotByronEraInByronMode eraInMode result <- lift (queryProtocolState eInMode sbe) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + & onLeft (left . QueryCmdUnsupportedNtcVersion) + & onLeft (left . QueryCmdLocalStateQueryError . EraMismatchError) pure $ do case cMode of CardanoMode -> shelleyBasedEraConstraints sbe $ writeProtocolState mOutFile result - mode -> left . ShelleyQueryCmdUnsupportedMode $ AnyConsensusMode mode + mode -> left . QueryCmdUnsupportedMode $ AnyConsensusMode mode ) - & onLeft (left . ShelleyQueryCmdAcquireFailure) + & onLeft (left . QueryCmdAcquireFailure) & onLeft left -- | Query the current delegations and reward accounts, filtered by a given @@ -816,22 +816,22 @@ runQueryStakeAddressInfoCmd -> StakeAddress -> NetworkId -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () runQueryStakeAddressInfoCmd socketPath (AnyConsensusModeParams cModeParams) (StakeAddress _ addr) network mOutFile = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath join $ lift ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . QueryCmdUnsupportedNtcVersion) let cMode = consensusModeOnly cModeParams sbe <- requireShelleyBasedEra era - & onNothing (left ShelleyQueryCmdByronEra) + & onNothing (left QueryCmdByronEra) eInMode <- pure (toEraInMode era cMode) - & onNothing (left (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)) + & onNothing (left (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)) let stakeAddr = Set.singleton $ fromShelleyStakeCredential addr @@ -840,13 +840,13 @@ runQueryStakeAddressInfoCmd socketPath (AnyConsensusModeParams cModeParams) (Sta requireNotByronEraInByronMode eraInMode result <- lift (queryStakeAddresses eInMode sbe stakeAddr network) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + & onLeft (left . QueryCmdUnsupportedNtcVersion) + & onLeft (left . QueryCmdLocalStateQueryError . EraMismatchError) pure $ do writeStakeAddressInfo mOutFile $ DelegationsAndRewards result ) - & onLeft (left . ShelleyQueryCmdAcquireFailure) + & onLeft (left . QueryCmdAcquireFailure) & onLeft left -- ------------------------------------------------------------------------------------------------- @@ -854,12 +854,12 @@ runQueryStakeAddressInfoCmd socketPath (AnyConsensusModeParams cModeParams) (Sta writeStakeAddressInfo :: Maybe (File () Out) -> DelegationsAndRewards - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () writeStakeAddressInfo mOutFile delegsAndRewards = case mOutFile of Nothing -> liftIO $ LBS.putStrLn (encodePretty delegsAndRewards) Just (File fpath) -> - handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError fpath) + handleIOExceptT (QueryCmdWriteFileError . FileIOError fpath) $ LBS.writeFile fpath (encodePretty delegsAndRewards) writeLedgerState :: forall era ledgerera. @@ -868,15 +868,15 @@ writeLedgerState :: forall era ledgerera. => FromCBOR (DebugLedgerState era) => Maybe (File () Out) -> SerialisedDebugLedgerState era - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () writeLedgerState mOutFile qState@(SerialisedDebugLedgerState serLedgerState) = case mOutFile of Nothing -> case decodeDebugLedgerState qState of - Left bs -> firstExceptT ShelleyQueryCmdHelpersError $ pPrintCBOR bs + Left bs -> firstExceptT QueryCmdHelpersError $ pPrintCBOR bs Right ledgerState -> liftIO . LBS.putStrLn $ Aeson.encode ledgerState Just (File fpath) -> - handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError fpath) + handleIOExceptT (QueryCmdWriteFileError . FileIOError fpath) $ LBS.writeFile fpath $ unSerialised serLedgerState writeStakeSnapshots :: forall era ledgerera. () @@ -884,10 +884,10 @@ writeStakeSnapshots :: forall era ledgerera. () => Core.EraCrypto ledgerera ~ StandardCrypto => Maybe (File () Out) -> SerialisedStakeSnapshots era - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () writeStakeSnapshots mOutFile qState = do StakeSnapshot snapshot <- pure (decodeStakeSnapshot qState) - & onLeft (left . ShelleyQueryCmdStakeSnapshotDecodeError) + & onLeft (left . QueryCmdStakeSnapshotDecodeError) -- Calculate the three pool and active stake values for the given pool liftIO . maybe LBS.putStrLn (LBS.writeFile . unFile) mOutFile $ encodePretty snapshot @@ -899,10 +899,10 @@ writePoolState :: forall era ledgerera. () => Core.EraCrypto ledgerera ~ StandardCrypto => Core.Era ledgerera => SerialisedPoolState era - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () writePoolState serialisedCurrentEpochState = do PoolState poolState <- pure (decodePoolState serialisedCurrentEpochState) - & onLeft (left . ShelleyQueryCmdPoolStateDecodeError) + & onLeft (left . QueryCmdPoolStateDecodeError) let hks = Set.toList $ Set.fromList $ Map.keys (psStakePoolParams poolState) <> Map.keys (psFutureStakePoolParams poolState) <> Map.keys (psRetiring poolState) @@ -927,20 +927,20 @@ writeProtocolState :: ) => Maybe (File () Out) -> ProtocolState era - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () writeProtocolState mOutFile ps@(ProtocolState pstate) = case mOutFile of Nothing -> case decodeProtocolState ps of - Left (bs, _) -> firstExceptT ShelleyQueryCmdHelpersError $ pPrintCBOR bs + Left (bs, _) -> firstExceptT QueryCmdHelpersError $ pPrintCBOR bs Right chainDepstate -> liftIO . LBS.putStrLn $ encodePretty chainDepstate Just (File fpath) -> - handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError fpath) + handleIOExceptT (QueryCmdWriteFileError . FileIOError fpath) . LBS.writeFile fpath $ unSerialised pstate writeFilteredUTxOs :: Api.ShelleyBasedEra era -> Maybe (File () Out) -> UTxO era - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () writeFilteredUTxOs sbe mOutFile utxo = case mOutFile of Nothing -> liftIO $ printFilteredUTxOs sbe utxo @@ -954,7 +954,7 @@ writeFilteredUTxOs sbe mOutFile utxo = ShelleyBasedEraConway -> writeUTxo fpath utxo where writeUTxo fpath utxo' = - handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError fpath) + handleIOExceptT (QueryCmdWriteFileError . FileIOError fpath) $ LBS.writeFile fpath (encodePretty utxo') printFilteredUTxOs :: Api.ShelleyBasedEra era -> UTxO era -> IO () @@ -1051,40 +1051,40 @@ runQueryStakePoolsCmd -> AnyConsensusModeParams -> NetworkId -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () runQueryStakePoolsCmd socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath join $ lift - ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT @ShelleyQueryCmdError $ do + ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT @QueryCmdError $ do anyE@(AnyCardanoEra era) <- case consensusModeOnly cModeParams of ByronMode -> return $ AnyCardanoEra ByronEra ShelleyMode -> return $ AnyCardanoEra ShelleyEra - CardanoMode -> lift queryCurrentEra & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + CardanoMode -> lift queryCurrentEra & onLeft (left . QueryCmdUnsupportedNtcVersion) let cMode = consensusModeOnly cModeParams eInMode <- toEraInMode era cMode - & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) + & hoistMaybe (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) sbe <- requireShelleyBasedEra era - & onNothing (left ShelleyQueryCmdByronEra) + & onNothing (left QueryCmdByronEra) poolIds <- lift (queryStakePools eInMode sbe) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdEraMismatch) + & onLeft (left . QueryCmdUnsupportedNtcVersion) + & onLeft (left . QueryCmdEraMismatch) pure $ do writeStakePools mOutFile poolIds - ) & onLeft (left . ShelleyQueryCmdAcquireFailure) + ) & onLeft (left . QueryCmdAcquireFailure) & onLeft left writeStakePools :: Maybe (File () Out) -> Set PoolId - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () writeStakePools (Just (File outFile)) stakePools = - handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError outFile) $ + handleIOExceptT (QueryCmdWriteFileError . FileIOError outFile) $ LBS.writeFile outFile (encodePretty stakePools) writeStakePools Nothing stakePools = @@ -1096,43 +1096,43 @@ runQueryStakeDistributionCmd -> AnyConsensusModeParams -> NetworkId -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () runQueryStakeDistributionCmd socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath join $ lift ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . QueryCmdUnsupportedNtcVersion) let cMode = consensusModeOnly cModeParams sbe <- requireShelleyBasedEra era - & onNothing (left ShelleyQueryCmdByronEra) + & onNothing (left QueryCmdByronEra) eInMode <- pure (toEraInMode era cMode) - & onNothing (left (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)) + & onNothing (left (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)) eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams requireNotByronEraInByronMode eraInMode result <- lift (queryStakeDistribution eInMode sbe) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + & onLeft (left . QueryCmdUnsupportedNtcVersion) + & onLeft (left . QueryCmdLocalStateQueryError . EraMismatchError) pure $ do writeStakeDistribution mOutFile result ) - & onLeft (left . ShelleyQueryCmdAcquireFailure) + & onLeft (left . QueryCmdAcquireFailure) & onLeft left writeStakeDistribution :: Maybe (File () Out) -> Map PoolId Rational - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () writeStakeDistribution (Just (File outFile)) stakeDistrib = - handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError outFile) $ + handleIOExceptT (QueryCmdWriteFileError . FileIOError outFile) $ LBS.writeFile outFile (encodePretty stakeDistrib) writeStakeDistribution Nothing stakeDistrib = @@ -1227,7 +1227,7 @@ runQueryLeadershipScheduleCmd -> SigningKeyFile In -- ^ VRF signing key -> EpochLeadershipSchedule -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () runQueryLeadershipScheduleCmd socketPath (AnyConsensusModeParams cModeParams) network (GenesisFile genFile) coldVerKeyFile vrfSkeyFp @@ -1235,58 +1235,58 @@ runQueryLeadershipScheduleCmd let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath poolid <- lift (readVerificationKeyOrHashOrFile AsStakePoolKey coldVerKeyFile) - & onLeft (left . ShelleyQueryCmdTextReadError) + & onLeft (left . QueryCmdTextReadError) vrkSkey <- lift (readFileTextEnvelope (AsSigningKey AsVrfKey) vrfSkeyFp) - & onLeft (left . ShelleyQueryCmdTextEnvelopeReadError) + & onLeft (left . QueryCmdTextEnvelopeReadError) shelleyGenesis <- lift (readAndDecodeShelleyGenesis genFile) - & onLeft (left . ShelleyQueryCmdGenesisReadError) + & onLeft (left . QueryCmdGenesisReadError) join $ lift ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . QueryCmdUnsupportedNtcVersion) sbe <- requireShelleyBasedEra era - & onNothing (left ShelleyQueryCmdByronEra) + & onNothing (left QueryCmdByronEra) let cMode = consensusModeOnly cModeParams case cMode of CardanoMode -> do eInMode <- toEraInMode era cMode - & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) + & hoistMaybe (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams requireNotByronEraInByronMode eraInMode pparams <- lift (queryProtocolParameters eInMode sbe) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + & onLeft (left . QueryCmdUnsupportedNtcVersion) + & onLeft (left . QueryCmdLocalStateQueryError . EraMismatchError) ptclState <- lift (queryProtocolState eInMode sbe) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + & onLeft (left . QueryCmdUnsupportedNtcVersion) + & onLeft (left . QueryCmdLocalStateQueryError . EraMismatchError) eraHistory <- lift queryEraHistory - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . QueryCmdUnsupportedNtcVersion) let eInfo = toEpochInfo eraHistory curentEpoch <- lift (queryEpoch eInMode sbe) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + & onLeft (left . QueryCmdUnsupportedNtcVersion) + & onLeft (left . QueryCmdLocalStateQueryError . EraMismatchError) case whichSchedule of CurrentEpoch -> do serCurrentEpochState <- lift (queryPoolDistribution eInMode sbe (Just (Set.singleton poolid))) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + & onLeft (left . QueryCmdUnsupportedNtcVersion) + & onLeft (left . QueryCmdLocalStateQueryError . EraMismatchError) pure $ do - schedule <- firstExceptT ShelleyQueryCmdLeaderShipError $ hoistEither + schedule <- firstExceptT QueryCmdLeaderShipError $ hoistEither $ shelleyBasedEraConstraints sbe $ currentEpochEligibleLeadershipSlots sbe @@ -1303,13 +1303,13 @@ runQueryLeadershipScheduleCmd NextEpoch -> do serCurrentEpochState <- lift (queryCurrentEpochState eInMode sbe) - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) - & onLeft (left . ShelleyQueryCmdLocalStateQueryError . EraMismatchError) + & onLeft (left . QueryCmdUnsupportedNtcVersion) + & onLeft (left . QueryCmdLocalStateQueryError . EraMismatchError) pure $ do tip <- liftIO $ getLocalChainTip localNodeConnInfo - schedule <- firstExceptT ShelleyQueryCmdLeaderShipError $ hoistEither + schedule <- firstExceptT QueryCmdLeaderShipError $ hoistEither $ shelleyBasedEraConstraints sbe $ nextEpochEligibleLeadershipSlots sbe shelleyGenesis serCurrentEpochState ptclState poolid vrkSkey pparams @@ -1318,9 +1318,9 @@ runQueryLeadershipScheduleCmd writeSchedule mJsonOutputFile eInfo shelleyGenesis schedule mode -> pure $ do - left . ShelleyQueryCmdUnsupportedMode $ AnyConsensusMode mode + left . QueryCmdUnsupportedMode $ AnyConsensusMode mode ) - & onLeft (left . ShelleyQueryCmdAcquireFailure) + & onLeft (left . QueryCmdAcquireFailure) & onLeft left where writeSchedule mOutFile eInfo shelleyGenesis schedule = @@ -1396,17 +1396,17 @@ calcEraInMode :: () => Monad m => CardanoEra era -> ConsensusMode mode - -> ExceptT ShelleyQueryCmdError m (EraInMode era mode) + -> ExceptT QueryCmdError m (EraInMode era mode) calcEraInMode era mode = pure (toEraInMode era mode) - & onNothing (left (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode mode) (anyCardanoEra era))) + & onNothing (left (QueryCmdEraConsensusModeMismatch (AnyConsensusMode mode) (anyCardanoEra era))) requireNotByronEraInByronMode :: () => Monad m => EraInMode era mode - -> ExceptT ShelleyQueryCmdError m () + -> ExceptT QueryCmdError m () requireNotByronEraInByronMode = \case - ByronEraInByronMode -> left ShelleyQueryCmdByronEra + ByronEraInByronMode -> left QueryCmdByronEra _ -> pure () toEpochInfo :: EraHistory CardanoMode -> EpochInfo (Either Text) @@ -1437,7 +1437,7 @@ utcTimeToSlotNo -> AnyConsensusModeParams -> NetworkId -> UTCTime - -> ExceptT ShelleyQueryCmdError IO SlotNo + -> ExceptT QueryCmdError IO SlotNo utcTimeToSlotNo socketPath (AnyConsensusModeParams cModeParams) network utcTime = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath case consensusModeOnly cModeParams of @@ -1445,17 +1445,17 @@ utcTimeToSlotNo socketPath (AnyConsensusModeParams cModeParams) network utcTime lift ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do systemStart <- lift querySystemStart - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . QueryCmdUnsupportedNtcVersion) eraHistory <- lift queryEraHistory - & onLeft (left . ShelleyQueryCmdUnsupportedNtcVersion) + & onLeft (left . QueryCmdUnsupportedNtcVersion) let relTime = toRelativeTime systemStart utcTime pure (Api.getSlotForRelativeTime relTime eraHistory) - & onLeft (left . ShelleyQueryCmdPastHorizon) + & onLeft (left . QueryCmdPastHorizon) ) - & onLeft (left . ShelleyQueryCmdAcquireFailure) + & onLeft (left . QueryCmdAcquireFailure) & onLeft left - mode -> left . ShelleyQueryCmdUnsupportedMode $ AnyConsensusMode mode + mode -> left . QueryCmdUnsupportedMode $ AnyConsensusMode mode diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/StakeAddress.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/StakeAddress.hs index 269d98afb0..a258bfde51 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/StakeAddress.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/StakeAddress.hs @@ -25,7 +25,7 @@ import Cardano.Api.Shelley import Cardano.CLI.EraBased.Commands.StakeAddress import Cardano.CLI.Read import Cardano.CLI.Types.Common -import Cardano.CLI.Types.Errors.ShelleyStakeAddressCmdError +import Cardano.CLI.Types.Errors.StakeAddressCmdError import Cardano.CLI.Types.Errors.DelegationError import Cardano.CLI.Types.Errors.StakeAddressRegistrationError import Cardano.CLI.Types.Key @@ -41,7 +41,7 @@ import qualified Data.Text.IO as Text runStakeAddressCmds :: () => StakeAddressCmds era - -> ExceptT ShelleyStakeAddressCmdError IO () + -> ExceptT StakeAddressCmdError IO () runStakeAddressCmds = \case StakeAddressKeyGenCmd _ fmt vk sk -> runStakeAddressKeyGenCmd fmt vk sk @@ -62,7 +62,7 @@ runStakeAddressKeyGenCmd :: () => KeyOutputFormat -> VerificationKeyFile Out -> SigningKeyFile Out - -> ExceptT ShelleyStakeAddressCmdError IO () + -> ExceptT StakeAddressCmdError IO () runStakeAddressKeyGenCmd fmt vkFp skFp = do let skeyDesc = "Stake Signing Key" let vkeyDesc = "Stake Verification Key" @@ -71,7 +71,7 @@ runStakeAddressKeyGenCmd fmt vkFp skFp = do let vkey = getVerificationKey skey - firstExceptT ShelleyStakeAddressCmdWriteFileError $ do + firstExceptT StakeAddressCmdWriteFileError $ do case fmt of KeyOutputFormatTextEnvelope -> newExceptT $ writeLazyByteStringFile skFp $ textEnvelopeToJSON (Just skeyDesc) skey @@ -87,9 +87,9 @@ runStakeAddressKeyGenCmd fmt vkFp skFp = do runStakeAddressKeyHashCmd :: () => VerificationKeyOrFile StakeKey -> Maybe (File () Out) - -> ExceptT ShelleyStakeAddressCmdError IO () + -> ExceptT StakeAddressCmdError IO () runStakeAddressKeyHashCmd stakeVerKeyOrFile mOutputFp = do - vkey <- firstExceptT ShelleyStakeAddressCmdReadKeyFileError + vkey <- firstExceptT StakeAddressCmdReadKeyFileError . newExceptT $ readVerificationKeyOrFile AsStakeKey stakeVerKeyOrFile @@ -103,11 +103,11 @@ runStakeAddressBuildCmd :: () => StakeVerifier -> NetworkId -> Maybe (File () Out) - -> ExceptT ShelleyStakeAddressCmdError IO () + -> ExceptT StakeAddressCmdError IO () runStakeAddressBuildCmd stakeVerifier network mOutputFp = do stakeAddr <- getStakeAddressFromVerifier network stakeVerifier - & firstExceptT ShelleyStakeAddressCmdStakeCredentialError + & firstExceptT StakeAddressCmdStakeCredentialError let stakeAddrText = serialiseAddress stakeAddr liftIO $ case mOutputFp of @@ -120,18 +120,18 @@ runStakeAddressRegistrationCertificateCmd :: () -> StakeIdentifier -> Maybe Lovelace -- ^ Deposit required in conway era -> File () Out - -> ExceptT ShelleyStakeAddressCmdError IO () + -> ExceptT StakeAddressCmdError IO () runStakeAddressRegistrationCertificateCmd sbe stakeIdentifier mDeposit oFp = do stakeCred <- getStakeCredentialFromIdentifier stakeIdentifier - & firstExceptT ShelleyStakeAddressCmdStakeCredentialError + & firstExceptT StakeAddressCmdStakeCredentialError - req <- firstExceptT StakeRegistrationError + req <- firstExceptT StakeAddressCmdRegistrationError . hoistEither $ createRegistrationCertRequirements sbe stakeCred mDeposit let regCert = makeStakeAddressRegistrationCertificate req - firstExceptT ShelleyStakeAddressCmdWriteFileError + firstExceptT StakeAddressCmdWriteFileError . newExceptT $ writeLazyByteStringFile oFp $ shelleyBasedEraConstraints sbe @@ -172,20 +172,20 @@ runStakeAddressStakeDelegationCertificateCmd :: () -- ^ Delegatee stake pool verification key or verification key file or -- verification key hash. -> File () Out - -> ExceptT ShelleyStakeAddressCmdError IO () + -> ExceptT StakeAddressCmdError IO () runStakeAddressStakeDelegationCertificateCmd sbe stakeVerifier poolVKeyOrHashOrFile outFp = shelleyBasedEraConstraints sbe $ do poolStakeVKeyHash <- lift (readVerificationKeyOrHashOrFile AsStakePoolKey poolVKeyOrHashOrFile) - & onLeft (left . ShelleyStakeAddressCmdReadKeyFileError) + & onLeft (left . StakeAddressCmdReadKeyFileError) stakeCred <- getStakeCredentialFromIdentifier stakeVerifier - & firstExceptT ShelleyStakeAddressCmdStakeCredentialError + & firstExceptT StakeAddressCmdStakeCredentialError let certificate = createStakeDelegationCertificate stakeCred poolStakeVKeyHash sbe - firstExceptT ShelleyStakeAddressCmdWriteFileError + firstExceptT StakeAddressCmdWriteFileError . newExceptT $ writeLazyByteStringFile outFp $ textEnvelopeToJSON (Just @TextEnvelopeDescr "Stake Address Delegation Certificate") certificate @@ -213,20 +213,20 @@ runStakeAddressStakeAndVoteDelegationCertificateCmd :: () -> VerificationKeyOrHashOrFile DRepKey -- verification key hash. -> File () Out - -> ExceptT ShelleyStakeAddressCmdError IO () + -> ExceptT StakeAddressCmdError IO () runStakeAddressStakeAndVoteDelegationCertificateCmd w stakeVerifier poolVKeyOrHashOrFile drepVKeyOrHashOrFile outFp = conwayEraOnwardsConstraints w $ do StakePoolKeyHash poolStakeVKeyHash <- lift (readVerificationKeyOrHashOrFile AsStakePoolKey poolVKeyOrHashOrFile) - & onLeft (left . ShelleyStakeAddressCmdReadKeyFileError) + & onLeft (left . StakeAddressCmdReadKeyFileError) stakeCredential <- getStakeCredentialFromIdentifier stakeVerifier - & firstExceptT ShelleyStakeAddressCmdStakeCredentialError + & firstExceptT StakeAddressCmdStakeCredentialError DRepKeyHash drepKeyHash <- lift (readVerificationKeyOrHashOrTextEnvFile AsDRepKey drepVKeyOrHashOrFile) - & onLeft (left . StakeAddressDelegationError . DelegationDRepReadError) + & onLeft (left . StakeAddressCmdDelegationError . DelegationDRepReadError) let drepCred = Ledger.DRepCredential $ Ledger.KeyHashObj drepKeyHash @@ -239,7 +239,7 @@ runStakeAddressStakeAndVoteDelegationCertificateCmd w stakeVerifier poolVKeyOrHa ConwayCertificate w $ Ledger.mkDelegTxCert (toShelleyStakeCredential stakeCredential) delegatee - firstExceptT ShelleyStakeAddressCmdWriteFileError + firstExceptT StakeAddressCmdWriteFileError . newExceptT $ writeLazyByteStringFile outFp $ textEnvelopeToJSON (Just @TextEnvelopeDescr "Stake Address Delegation Certificate") certificate @@ -266,18 +266,18 @@ runStakeAddressDeregistrationCertificateCmd :: () -> StakeIdentifier -> Maybe Lovelace -- ^ Deposit required in conway era -> File () Out - -> ExceptT ShelleyStakeAddressCmdError IO () + -> ExceptT StakeAddressCmdError IO () runStakeAddressDeregistrationCertificateCmd sbe stakeVerifier mDeposit oFp = do stakeCred <- getStakeCredentialFromIdentifier stakeVerifier - & firstExceptT ShelleyStakeAddressCmdStakeCredentialError + & firstExceptT StakeAddressCmdStakeCredentialError - req <- firstExceptT StakeRegistrationError + req <- firstExceptT StakeAddressCmdRegistrationError . hoistEither $ createRegistrationCertRequirements sbe stakeCred mDeposit let deRegCert = makeStakeAddressUnregistrationCertificate req - firstExceptT ShelleyStakeAddressCmdWriteFileError + firstExceptT StakeAddressCmdWriteFileError . newExceptT $ writeLazyByteStringFile oFp $ shelleyBasedEraConstraints sbe diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/TextView.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/TextView.hs index 3768d44665..9e819227d2 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/TextView.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/TextView.hs @@ -7,7 +7,7 @@ module Cardano.CLI.EraBased.Run.TextView import Cardano.Api import Cardano.CLI.Helpers (pPrintCBOR) -import Cardano.CLI.Types.Errors.ShelleyTextViewFileError +import Cardano.CLI.Types.Errors.TextViewFileError import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Trans.Except (ExceptT) @@ -17,7 +17,7 @@ import qualified Data.ByteString.Lazy.Char8 as LBS runTextViewInfoCmd :: () => FilePath -> Maybe (File () Out) - -> ExceptT ShelleyTextViewFileError IO () + -> ExceptT TextViewFileError IO () runTextViewInfoCmd fpath mOutFile = do tv <- firstExceptT TextViewReadFileError $ newExceptT (readTextEnvelopeFromFile fpath) let lbCBOR = LBS.fromStrict (textEnvelopeRawCBOR tv) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index e303f57866..3045da6f3d 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -36,8 +36,8 @@ import Cardano.CLI.EraBased.Run.Genesis import Cardano.CLI.Json.Friendly (friendlyTxBS, friendlyTxBodyBS) import Cardano.CLI.Read import Cardano.CLI.Types.Common -import Cardano.CLI.Types.Errors.ShelleyBootstrapWitnessError -import Cardano.CLI.Types.Errors.ShelleyTxCmdError +import Cardano.CLI.Types.Errors.BootstrapWitnessError +import Cardano.CLI.Types.Errors.TxCmdError import Cardano.CLI.Types.Errors.TxValidationError import Cardano.CLI.Types.Governance import Cardano.CLI.Types.Output (renderScriptCosts) @@ -71,7 +71,7 @@ import Data.Type.Equality (TestEquality (..)) import Lens.Micro ((^.)) import qualified System.IO as IO -runTransactionCmds :: TransactionCmds era -> ExceptT ShelleyTxCmdError IO () +runTransactionCmds :: TransactionCmds era -> ExceptT TxCmdError IO () runTransactionCmds cmd = case cmd of TxBuild @@ -143,7 +143,7 @@ runTxBuildCmd :: () -> [VoteFile In] -> [ProposalFile In] -> TxBuildOutputOptions - -> ExceptT ShelleyTxCmdError IO () + -> ExceptT TxCmdError IO () runTxBuildCmd era socketPath consensusModeParams@(AnyConsensusModeParams cModeParams) nid mScriptValidity mOverrideWits txins readOnlyRefIns reqSigners txinsc mReturnColl mTotCollateral txouts @@ -160,8 +160,8 @@ runTxBuildCmd , localNodeSocketPath = socketPath } - inputsAndMaybeScriptWits <- firstExceptT ShelleyTxCmdScriptWitnessError $ readScriptWitnessFiles era txins - certFilesAndMaybeScriptWits <- firstExceptT ShelleyTxCmdScriptWitnessError $ readScriptWitnessFiles era certs + inputsAndMaybeScriptWits <- firstExceptT TxCmdScriptWitnessError $ readScriptWitnessFiles era txins + certFilesAndMaybeScriptWits <- firstExceptT TxCmdScriptWitnessError $ readScriptWitnessFiles era certs -- TODO: Conway Era - How can we make this more composable? certsAndMaybeScriptWits <- @@ -169,22 +169,22 @@ runTxBuildCmd LegacyByronEra -> return [] ShelleyBasedEra{} -> sequence - [ fmap (,mSwit) (firstExceptT ShelleyTxCmdReadTextViewFileError . newExceptT $ + [ fmap (,mSwit) (firstExceptT TxCmdReadTextViewFileError . newExceptT $ readFileTextEnvelope AsCertificate (File certFile)) | (CertificateFile certFile, mSwit) <- certFilesAndMaybeScriptWits ] - withdrawalsAndMaybeScriptWits <- firstExceptT ShelleyTxCmdScriptWitnessError + withdrawalsAndMaybeScriptWits <- firstExceptT TxCmdScriptWitnessError $ readScriptWitnessFilesThruple era wdrls - txMetadata <- firstExceptT ShelleyTxCmdMetadataError + txMetadata <- firstExceptT TxCmdMetadataError . newExceptT $ readTxMetadata era metadataSchema metadataFiles valuesWithScriptWits <- readValueScriptWitnesses era $ fromMaybe mempty mValue - scripts <- firstExceptT ShelleyTxCmdScriptFileError $ + scripts <- firstExceptT TxCmdScriptFileError $ mapM (readFileScriptInAnyLang . unScriptFile) scriptFiles - txAuxScripts <- hoistEither $ first ShelleyTxCmdAuxScriptsValidationError $ validateTxAuxScripts era scripts + txAuxScripts <- hoistEither $ first TxCmdAuxScriptsValidationError $ validateTxAuxScripts era scripts mProp <- forM mUpProp $ \(UpdateProposalFile upFp) -> - firstExceptT ShelleyTxCmdReadTextViewFileError (newExceptT $ readFileTextEnvelope AsUpdateProposal (File upFp)) - requiredSigners <- mapM (firstExceptT ShelleyTxCmdRequiredSignerError . newExceptT . readRequiredSigner) reqSigners + firstExceptT TxCmdReadTextViewFileError (newExceptT $ readFileTextEnvelope AsUpdateProposal (File upFp)) + requiredSigners <- mapM (firstExceptT TxCmdRequiredSignerError . newExceptT . readRequiredSigner) reqSigners mReturnCollateral <- forM mReturnColl $ toTxOutInAnyEra era txOuts <- mapM (toTxOutInAnyEra era) txouts @@ -193,10 +193,10 @@ runTxBuildCmd votes <- featureInEra (pure emptyVotingProcedures) - (\w -> firstExceptT ShelleyTxCmdVoteError $ ExceptT (readVotingProceduresFiles w conwayVotes)) + (\w -> firstExceptT TxCmdVoteError $ ExceptT (readVotingProceduresFiles w conwayVotes)) era - proposals <- newExceptT $ first ShelleyTxCmdConstitutionError + proposals <- newExceptT $ first TxCmdConstitutionError <$> readTxGovernanceActions era newProposals -- the same collateral input can be used for several plutus scripts @@ -232,46 +232,46 @@ runTxBuildCmd OutputScriptCostOnly fp -> do let BuildTxWith mTxProtocolParams = txProtocolParams txBodycontent - pparams <- pure mTxProtocolParams & onNothing (left ShelleyTxCmdProtocolParametersNotPresentInTxBody) - executionUnitPrices <- pure (getExecutionUnitPrices era pparams) & onNothing (left ShelleyTxCmdPParamExecutionUnitsNotAvailable) + pparams <- pure mTxProtocolParams & onNothing (left TxCmdProtocolParametersNotPresentInTxBody) + executionUnitPrices <- pure (getExecutionUnitPrices era pparams) & onNothing (left TxCmdPParamExecutionUnitsNotAvailable) let consensusMode = consensusModeOnly cModeParams case consensusMode of CardanoMode -> do AnyCardanoEra nodeEra <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing (determineEraExpr cModeParams)) - & onLeft (left . ShelleyTxCmdQueryConvenienceError . AcqFailure) - & onLeft (left . ShelleyTxCmdQueryConvenienceError . QceUnsupportedNtcVersion) + & onLeft (left . TxCmdQueryConvenienceError . AcqFailure) + & onLeft (left . TxCmdQueryConvenienceError . QceUnsupportedNtcVersion) (nodeEraUTxO, _, eraHistory, systemStart, _, _) <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing (queryStateForBalancedTx nodeEra allTxInputs [])) - & onLeft (left . ShelleyTxCmdQueryConvenienceError . AcqFailure) - & onLeft (left . ShelleyTxCmdQueryConvenienceError) + & onLeft (left . TxCmdQueryConvenienceError . AcqFailure) + & onLeft (left . TxCmdQueryConvenienceError) -- Why do we cast the era? The user can specify an era prior to the era that the node is currently in. -- We cannot use the user specified era to construct a query against a node because it may differ -- from the node's era and this will result in the 'QueryEraMismatch' failure. - txEraUtxo <- cardanoEraConstraints era $ pure (eraCast era nodeEraUTxO) & onLeft (left . ShelleyTxCmdTxEraCastErr) + txEraUtxo <- cardanoEraConstraints era $ pure (eraCast era nodeEraUTxO) & onLeft (left . TxCmdTxEraCastErr) scriptExecUnitsMap <- - firstExceptT ShelleyTxCmdTxExecUnitsErr $ hoistEither + firstExceptT TxCmdTxExecUnitsErr $ hoistEither $ evaluateTransactionExecutionUnits systemStart (toLedgerEpochInfo eraHistory) pparams txEraUtxo balancedTxBody scriptCostOutput <- - firstExceptT ShelleyTxCmdPlutusScriptCostErr $ hoistEither + firstExceptT TxCmdPlutusScriptCostErr $ hoistEither $ renderScriptCosts txEraUtxo executionUnitPrices mScriptWits scriptExecUnitsMap liftIO $ LBS.writeFile (unFile fp) $ encodePretty scriptCostOutput - _ -> left ShelleyTxCmdPlutusScriptsRequireCardanoMode + _ -> left TxCmdPlutusScriptsRequireCardanoMode OutputTxBodyOnly fpath -> let noWitTx = makeSignedTransaction [] balancedTxBody in lift (cardanoEraConstraints era $ writeTxFileTextEnvelopeCddl fpath noWitTx) - & onLeft (left . ShelleyTxCmdWriteFileError) + & onLeft (left . TxCmdWriteFileError) getExecutionUnitPrices :: CardanoEra era -> LedgerProtocolParameters era -> Maybe Ledger.Prices getExecutionUnitPrices cEra (LedgerProtocolParameters pp) = do @@ -306,14 +306,14 @@ runTxBuildRawCmd -> Maybe ProtocolParamsFile -> Maybe UpdateProposalFile -> TxBodyFile Out - -> ExceptT ShelleyTxCmdError IO () + -> ExceptT TxCmdError IO () runTxBuildRawCmd era mScriptValidity txins readOnlyRefIns txinsc mReturnColl mTotColl reqSigners txouts mValue mLowBound mUpperBound fee certs wdrls metadataSchema scriptFiles metadataFiles mpParamsFile mUpProp out = do - inputsAndMaybeScriptWits <- firstExceptT ShelleyTxCmdScriptWitnessError + inputsAndMaybeScriptWits <- firstExceptT TxCmdScriptWitnessError $ readScriptWitnessFiles era txins - certFilesAndMaybeScriptWits <- firstExceptT ShelleyTxCmdScriptWitnessError + certFilesAndMaybeScriptWits <- firstExceptT TxCmdScriptWitnessError $ readScriptWitnessFiles era certs -- TODO: Conway era - How can we make this more composable? @@ -322,35 +322,35 @@ runTxBuildRawCmd LegacyByronEra -> return [] ShelleyBasedEra{} -> sequence - [ fmap (,mSwit) (firstExceptT ShelleyTxCmdReadTextViewFileError . newExceptT $ + [ fmap (,mSwit) (firstExceptT TxCmdReadTextViewFileError . newExceptT $ readFileTextEnvelope AsCertificate (File certFile)) | (CertificateFile certFile, mSwit) <- certFilesAndMaybeScriptWits ] - withdrawalsAndMaybeScriptWits <- firstExceptT ShelleyTxCmdScriptWitnessError + withdrawalsAndMaybeScriptWits <- firstExceptT TxCmdScriptWitnessError $ readScriptWitnessFilesThruple era wdrls - txMetadata <- firstExceptT ShelleyTxCmdMetadataError + txMetadata <- firstExceptT TxCmdMetadataError . newExceptT $ readTxMetadata era metadataSchema metadataFiles valuesWithScriptWits <- readValueScriptWitnesses era $ fromMaybe mempty mValue - scripts <- firstExceptT ShelleyTxCmdScriptFileError $ + scripts <- firstExceptT TxCmdScriptFileError $ mapM (readFileScriptInAnyLang . unScriptFile) scriptFiles - txAuxScripts <- hoistEither $ first ShelleyTxCmdAuxScriptsValidationError $ validateTxAuxScripts era scripts + txAuxScripts <- hoistEither $ first TxCmdAuxScriptsValidationError $ validateTxAuxScripts era scripts -- TODO: Conway era - update readProtocolParameters to rely on Ledger.PParams JSON instances pparams <- forM mpParamsFile $ \ppf -> - firstExceptT ShelleyTxCmdProtocolParamsError (readProtocolParameters ppf) + firstExceptT TxCmdProtocolParamsError (readProtocolParameters ppf) mLedgerPParams <- case cardanoEraStyle era of LegacyByronEra -> return Nothing ShelleyBasedEra sbe -> forM pparams $ \pp -> - firstExceptT ShelleyTxCmdProtocolParamsConverstionError + firstExceptT TxCmdProtocolParamsConverstionError . hoistEither $ convertToLedgerProtocolParameters sbe pp mProp <- forM mUpProp $ \(UpdateProposalFile upFp) -> - firstExceptT ShelleyTxCmdReadTextViewFileError (newExceptT $ readFileTextEnvelope AsUpdateProposal (File upFp)) + firstExceptT TxCmdReadTextViewFileError (newExceptT $ readFileTextEnvelope AsUpdateProposal (File upFp)) - requiredSigners <- mapM (firstExceptT ShelleyTxCmdRequiredSignerError . newExceptT . readRequiredSigner) reqSigners + requiredSigners <- mapM (firstExceptT TxCmdRequiredSignerError . newExceptT . readRequiredSigner) reqSigners mReturnCollateral <- forM mReturnColl $ toTxOutInAnyEra era txOuts <- mapM (toTxOutInAnyEra era) txouts @@ -364,7 +364,7 @@ runTxBuildRawCmd let noWitTx = makeSignedTransaction [] txBody lift (getIsCardanoEraConstraint era $ writeTxFileTextEnvelopeCddl out noWitTx) - & onLeft (left . ShelleyTxCmdWriteFileError) + & onLeft (left . TxCmdWriteFileError) runTxBuildRaw :: () @@ -399,7 +399,7 @@ runTxBuildRaw :: () -> TxMetadataInEra era -> Maybe (LedgerProtocolParameters era) -> Maybe UpdateProposal - -> Either ShelleyTxCmdError (TxBody era) + -> Either TxCmdError (TxBody era) runTxBuildRaw era mScriptValidity inputsAndMaybeScriptWits readOnlyRefIns txinsc @@ -419,27 +419,27 @@ runTxBuildRaw era validatedCollateralTxIns <- validateTxInsCollateral era txinsc validatedRefInputs <- validateTxInsReference era allReferenceInputs validatedTotCollateral - <- first ShelleyTxCmdTotalCollateralValidationError $ validateTxTotalCollateral era mTotCollateral + <- first TxCmdTotalCollateralValidationError $ validateTxTotalCollateral era mTotCollateral validatedRetCol - <- first ShelleyTxCmdReturnCollateralValidationError $ validateTxReturnCollateral era mReturnCollateral + <- first TxCmdReturnCollateralValidationError $ validateTxReturnCollateral era mReturnCollateral validatedFee - <- first ShelleyTxCmdTxFeeValidationError $ validateTxFee era mFee - validatedBounds <- (,) <$> first ShelleyTxCmdTxValidityLowerBoundValidationError (validateTxValidityLowerBound era mLowerBound) - <*> first ShelleyTxCmdTxValidityUpperBoundValidationError (validateTxValidityUpperBound era mUpperBound) + <- first TxCmdTxFeeValidationError $ validateTxFee era mFee + validatedBounds <- (,) <$> first TxCmdTxValidityLowerBoundValidationError (validateTxValidityLowerBound era mLowerBound) + <*> first TxCmdTxValidityUpperBoundValidationError (validateTxValidityUpperBound era mUpperBound) validatedReqSigners - <- first ShelleyTxCmdRequiredSignersValidationError $ validateRequiredSigners era reqSigners + <- first TxCmdRequiredSignersValidationError $ validateRequiredSigners era reqSigners validatedPParams - <- first ShelleyTxCmdProtocolParametersValidationError $ validateProtocolParameters era mpparams + <- first TxCmdProtocolParametersValidationError $ validateProtocolParameters era mpparams validatedTxWtdrwls - <- first ShelleyTxCmdTxWithdrawalsValidationError $ validateTxWithdrawals era withdrawals + <- first TxCmdTxWithdrawalsValidationError $ validateTxWithdrawals era withdrawals validatedTxCerts - <- first ShelleyTxCmdTxCertificatesValidationError $ validateTxCertificates era certsAndMaybeSriptWits + <- first TxCmdTxCertificatesValidationError $ validateTxCertificates era certsAndMaybeSriptWits validatedTxUpProp - <- first ShelleyTxCmdTxUpdateProposalValidationError $ validateTxUpdateProposal era mUpdateProp + <- first TxCmdTxUpdateProposalValidationError $ validateTxUpdateProposal era mUpdateProp validatedMintValue <- createTxMintValue era valuesWithScriptWits validatedTxScriptValidity - <- first ShelleyTxCmdScriptValidityValidationError $ validateTxScriptValidity era mScriptValidity + <- first TxCmdScriptValidityValidationError $ validateTxScriptValidity era mScriptValidity let validatedTxProposalProcedures = Nothing -- TODO: Conwary era validatedTxVotes = Nothing -- TODO: Conwary era let txBodyContent = @@ -465,7 +465,7 @@ runTxBuildRaw era , txVotingProcedures = validatedTxVotes } - first ShelleyTxCmdTxBodyError $ + first TxCmdTxBodyError $ getIsCardanoEraConstraint era $ createAndValidateTransactionBody txBodyContent runTxBuild :: () @@ -507,7 +507,7 @@ runTxBuild :: () -> VotingProcedures era -> [Proposal era] -> TxBuildOutputOptions - -> ExceptT ShelleyTxCmdError IO (BalancedTxBody era) + -> ExceptT TxCmdError IO (BalancedTxBody era) runTxBuild era socketPath (AnyConsensusModeParams cModeParams) networkId mScriptValidity inputsAndMaybeScriptWits readOnlyRefIns txinsc mReturnCollateral mTotCollateral txouts @@ -529,23 +529,23 @@ runTxBuild validatedCollateralTxIns <- hoistEither $ validateTxInsCollateral era txinsc validatedRefInputs <- hoistEither $ validateTxInsReference era allReferenceInputs validatedTotCollateral - <- hoistEither $ first ShelleyTxCmdTotalCollateralValidationError $ validateTxTotalCollateral era mTotCollateral + <- hoistEither $ first TxCmdTotalCollateralValidationError $ validateTxTotalCollateral era mTotCollateral validatedRetCol - <- hoistEither $ first ShelleyTxCmdReturnCollateralValidationError $ validateTxReturnCollateral era mReturnCollateral - dFee <- hoistEither $ first ShelleyTxCmdTxFeeValidationError $ validateTxFee era dummyFee - validatedBounds <- (,) <$> hoistEither (first ShelleyTxCmdTxValidityLowerBoundValidationError $ validateTxValidityLowerBound era mLowerBound) - <*> hoistEither (first ShelleyTxCmdTxValidityUpperBoundValidationError $ validateTxValidityUpperBound era mUpperBound) - validatedReqSigners <- hoistEither (first ShelleyTxCmdRequiredSignersValidationError $ validateRequiredSigners era reqSigners) - validatedTxWtdrwls <- hoistEither (first ShelleyTxCmdTxWithdrawalsValidationError $ validateTxWithdrawals era withdrawals) - validatedTxCerts <- hoistEither (first ShelleyTxCmdTxCertificatesValidationError $ validateTxCertificates era certsAndMaybeScriptWits) - validatedTxUpProp <- hoistEither (first ShelleyTxCmdTxUpdateProposalValidationError $ validateTxUpdateProposal era mUpdatePropF) + <- hoistEither $ first TxCmdReturnCollateralValidationError $ validateTxReturnCollateral era mReturnCollateral + dFee <- hoistEither $ first TxCmdTxFeeValidationError $ validateTxFee era dummyFee + validatedBounds <- (,) <$> hoistEither (first TxCmdTxValidityLowerBoundValidationError $ validateTxValidityLowerBound era mLowerBound) + <*> hoistEither (first TxCmdTxValidityUpperBoundValidationError $ validateTxValidityUpperBound era mUpperBound) + validatedReqSigners <- hoistEither (first TxCmdRequiredSignersValidationError $ validateRequiredSigners era reqSigners) + validatedTxWtdrwls <- hoistEither (first TxCmdTxWithdrawalsValidationError $ validateTxWithdrawals era withdrawals) + validatedTxCerts <- hoistEither (first TxCmdTxCertificatesValidationError $ validateTxCertificates era certsAndMaybeScriptWits) + validatedTxUpProp <- hoistEither (first TxCmdTxUpdateProposalValidationError $ validateTxUpdateProposal era mUpdatePropF) validatedMintValue <- hoistEither $ createTxMintValue era valuesWithScriptWits - validatedTxScriptValidity <- hoistEither (first ShelleyTxCmdScriptValidityValidationError $ validateTxScriptValidity era mScriptValidity) + validatedTxScriptValidity <- hoistEither (first TxCmdScriptValidityValidationError $ validateTxScriptValidity era mScriptValidity) case (consensusMode, cardanoEraStyle era) of (CardanoMode, ShelleyBasedEra _) -> do _ <- toEraInMode era CardanoMode - & hoistMaybe (ShelleyTxCmdEraConsensusModeMismatchTxBalance outputOptions (AnyConsensusMode CardanoMode) (AnyCardanoEra era)) + & hoistMaybe (TxCmdEraConsensusModeMismatchTxBalance outputOptions (AnyConsensusMode CardanoMode) (AnyCardanoEra era)) let allTxInputs = inputsThatRequireWitnessing ++ allReferenceInputs ++ txinsc localNodeConnInfo = LocalNodeConnectInfo @@ -555,11 +555,11 @@ runTxBuild } AnyCardanoEra nodeEra <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing (determineEraExpr cModeParams)) - & onLeft (left . ShelleyTxCmdQueryConvenienceError . AcqFailure) - & onLeft (left . ShelleyTxCmdQueryConvenienceError . QceUnsupportedNtcVersion) + & onLeft (left . TxCmdQueryConvenienceError . AcqFailure) + & onLeft (left . TxCmdQueryConvenienceError . QceUnsupportedNtcVersion) Refl <- testEquality era nodeEra - & hoistMaybe (ShelleyTxCmdTxEraCastErr $ EraCastError ("nodeEra" :: Text) era nodeEra) + & hoistMaybe (TxCmdTxEraCastErr $ EraCastError ("nodeEra" :: Text) era nodeEra) let certs = case validatedTxCerts of @@ -568,10 +568,10 @@ runTxBuild (txEraUtxo, pparams, eraHistory, systemStart, stakePools, stakeDelegDeposits) <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing $ queryStateForBalancedTx nodeEra allTxInputs certs) - & onLeft (left . ShelleyTxCmdQueryConvenienceError . AcqFailure) - & onLeft (left . ShelleyTxCmdQueryConvenienceError) + & onLeft (left . TxCmdQueryConvenienceError . AcqFailure) + & onLeft (left . TxCmdQueryConvenienceError) - validatedPParams <- hoistEither $ first ShelleyTxCmdProtocolParametersValidationError + validatedPParams <- hoistEither $ first TxCmdProtocolParametersValidationError $ validateProtocolParameters era (Just pparams) let validatedTxProposalProcedures = proposals @@ -599,16 +599,16 @@ runTxBuild , txVotingProcedures = inEraFeatureMaybe era (`Featured` validatedTxVotes) } - firstExceptT ShelleyTxCmdTxInsDoNotExist + firstExceptT TxCmdTxInsDoNotExist . hoistEither $ txInsExistInUTxO allTxInputs txEraUtxo - firstExceptT ShelleyTxCmdQueryNotScriptLocked + firstExceptT TxCmdQueryNotScriptLocked . hoistEither $ notScriptLockedTxIns txinsc txEraUtxo cAddr <- pure (anyAddressInEra era changeAddr) & onLeft (error $ "runTxBuild: Byron address used: " <> show changeAddr) -- should this throw instead? balancedTxBody@(BalancedTxBody _ _ _ fee) <- - firstExceptT ShelleyTxCmdBalanceTxBody + firstExceptT TxCmdBalanceTxBody . hoistEither $ makeTransactionBodyAutoBalance systemStart (toLedgerEpochInfo eraHistory) pparams stakePools stakeDelegDeposits txEraUtxo @@ -618,9 +618,9 @@ runTxBuild return balancedTxBody - (CardanoMode, LegacyByronEra) -> left ShelleyTxCmdByronEra + (CardanoMode, LegacyByronEra) -> left TxCmdByronEra - (wrongMode, _) -> left (ShelleyTxCmdUnsupportedMode (AnyConsensusMode wrongMode)) + (wrongMode, _) -> left (TxCmdUnsupportedMode (AnyConsensusMode wrongMode)) -- ---------------------------------------------------------------------------- -- Transaction body validation and conversion @@ -630,15 +630,15 @@ txFeatureMismatch :: () => Monad m => CardanoEra era -> TxFeature - -> ExceptT ShelleyTxCmdError m a + -> ExceptT TxCmdError m a txFeatureMismatch era feature = - hoistEither . Left $ ShelleyTxCmdTxFeatureMismatch (anyCardanoEra era) feature + hoistEither . Left $ TxCmdTxFeatureMismatch (anyCardanoEra era) feature txFeatureMismatchPure :: CardanoEra era -> TxFeature - -> Either ShelleyTxCmdError a + -> Either TxCmdError a txFeatureMismatchPure era feature = - Left (ShelleyTxCmdTxFeatureMismatch (anyCardanoEra era) feature) + Left (TxCmdTxFeatureMismatch (anyCardanoEra era) feature) validateTxIns @@ -659,7 +659,7 @@ validateTxIns = map convert validateTxInsCollateral :: CardanoEra era -> [TxIn] - -> Either ShelleyTxCmdError (TxInsCollateral era) + -> Either TxCmdError (TxInsCollateral era) validateTxInsCollateral _ [] = return TxInsCollateralNone validateTxInsCollateral era txins = case collateralSupportedInEra era of @@ -669,7 +669,7 @@ validateTxInsCollateral era txins = validateTxInsReference :: CardanoEra era -> [TxIn] - -> Either ShelleyTxCmdError (TxInsReference BuildTx era) + -> Either TxCmdError (TxInsReference BuildTx era) validateTxInsReference _ [] = return TxInsReferenceNone validateTxInsReference era allRefIns = case refInsScriptsAndInlineDatsSupportedInEra era of @@ -709,7 +709,7 @@ getAllReferenceInputs txins mintWitnesses certFiles withdrawals readOnlyRefIns = toAddressInAnyEra :: CardanoEra era -> AddressAny - -> Either ShelleyTxCmdError (AddressInEra era) + -> Either TxCmdError (AddressInEra era) toAddressInAnyEra era addrAny = runExcept $ do case addrAny of AddressByron bAddr -> pure (AddressInEra ByronAddressInAnyEra bAddr) @@ -722,7 +722,7 @@ toAddressInAnyEra era addrAny = runExcept $ do toTxOutValueInAnyEra :: CardanoEra era -> Value - -> Either ShelleyTxCmdError (TxOutValue era) + -> Either TxCmdError (TxOutValue era) toTxOutValueInAnyEra era val = case multiAssetSupportedInEra era of Left adaOnlyInEra -> @@ -733,7 +733,7 @@ toTxOutValueInAnyEra era val = toTxOutInAnyEra :: CardanoEra era -> TxOutAnyEra - -> ExceptT ShelleyTxCmdError IO (TxOut CtxTx era) + -> ExceptT TxCmdError IO (TxOut CtxTx era) toTxOutInAnyEra era (TxOutAnyEra addr' val' mDatumHash refScriptFp) = do addr <- hoistEither $ toAddressInAnyEra era addr' val <- hoistEither $ toTxOutValueInAnyEra era val' @@ -752,18 +752,18 @@ toTxOutInAnyEra era (TxOutAnyEra addr' val' mDatumHash refScriptFp) = do getReferenceScript :: ReferenceScriptAnyEra -> ReferenceTxInsScriptsInlineDatumsSupportedInEra era - -> ExceptT ShelleyTxCmdError IO (ReferenceScript era) + -> ExceptT TxCmdError IO (ReferenceScript era) getReferenceScript ReferenceScriptAnyEraNone _ = return ReferenceScriptNone getReferenceScript (ReferenceScriptAnyEra fp) supp = do ReferenceScript supp - <$> firstExceptT ShelleyTxCmdScriptFileError (readFileScriptInAnyLang fp) + <$> firstExceptT TxCmdScriptFileError (readFileScriptInAnyLang fp) toTxDatumReferenceScriptBabbage :: ScriptDataSupportedInEra era -> ReferenceTxInsScriptsInlineDatumsSupportedInEra era -> TxOutDatumAnyEra -> ReferenceScriptAnyEra - -> ExceptT ShelleyTxCmdError IO (TxOutDatum CtxTx era, ReferenceScript era) + -> ExceptT TxCmdError IO (TxOutDatum CtxTx era, ReferenceScript era) toTxDatumReferenceScriptBabbage sDataSupp inlineRefSupp cliDatum refScriptFp' = do refScript <- getReferenceScript refScriptFp' inlineRefSupp case cliDatum of @@ -772,31 +772,31 @@ toTxOutInAnyEra era (TxOutAnyEra addr' val' mDatumHash refScriptFp) = do TxOutDatumByHashOnly dh -> do pure (TxOutDatumHash sDataSupp dh, refScript) TxOutDatumByHashOf fileOrSdata -> do - sData <- firstExceptT ShelleyTxCmdScriptDataError + sData <- firstExceptT TxCmdScriptDataError $ readScriptDataOrFile fileOrSdata pure (TxOutDatumHash sDataSupp $ hashScriptDataBytes sData, refScript) TxOutDatumByValue fileOrSdata -> do - sData <- firstExceptT ShelleyTxCmdScriptDataError + sData <- firstExceptT TxCmdScriptDataError $ readScriptDataOrFile fileOrSdata pure (TxOutDatumInTx sDataSupp sData, refScript) TxOutInlineDatumByValue fileOrSdata -> do - sData <- firstExceptT ShelleyTxCmdScriptDataError + sData <- firstExceptT TxCmdScriptDataError $ readScriptDataOrFile fileOrSdata pure (TxOutDatumInline inlineRefSupp sData, refScript) toTxAlonzoDatum :: ScriptDataSupportedInEra era -> TxOutDatumAnyEra - -> ExceptT ShelleyTxCmdError IO (TxOutDatum CtxTx era) + -> ExceptT TxCmdError IO (TxOutDatum CtxTx era) toTxAlonzoDatum supp cliDatum = case cliDatum of TxOutDatumByHashOnly h -> pure (TxOutDatumHash supp h) TxOutDatumByHashOf sDataOrFile -> do - sData <- firstExceptT ShelleyTxCmdScriptDataError + sData <- firstExceptT TxCmdScriptDataError $ readScriptDataOrFile sDataOrFile pure (TxOutDatumHash supp $ hashScriptDataBytes sData) TxOutDatumByValue sDataOrFile -> do - sData <- firstExceptT ShelleyTxCmdScriptDataError + sData <- firstExceptT TxCmdScriptDataError $ readScriptDataOrFile sDataOrFile pure (TxOutDatumInTx supp sData) TxOutInlineDatumByValue _ -> @@ -811,7 +811,7 @@ toTxOutInAnyEra era (TxOutAnyEra addr' val' mDatumHash refScriptFp) = do -- access the script (and therefore the policy id). createTxMintValue :: forall era. CardanoEra era -> (Value, [ScriptWitness WitCtxMint era]) - -> Either ShelleyTxCmdError (TxMintValue BuildTx era) + -> Either TxCmdError (TxMintValue BuildTx era) createTxMintValue era (val, scriptWitnesses) = if List.null (valueToList val) && List.null scriptWitnesses then return TxMintNone @@ -846,13 +846,13 @@ createTxMintValue era (val, scriptWitnesses) = validateAllWitnessesProvided witnessesNeeded witnessesProvided | null witnessesMissing = return () - | otherwise = Left (ShelleyTxCmdPolicyIdsMissing witnessesMissing) + | otherwise = Left (TxCmdPolicyIdsMissing witnessesMissing) where witnessesMissing = Set.elems (witnessesNeeded Set.\\ witnessesProvided) validateNoUnnecessaryWitnesses witnessesNeeded witnessesProvided | null witnessesExtra = return () - | otherwise = Left (ShelleyTxCmdPolicyIdsExcess witnessesExtra) + | otherwise = Left (TxCmdPolicyIdsExcess witnessesExtra) where witnessesExtra = Set.elems (witnessesProvided Set.\\ witnessesNeeded) @@ -870,9 +870,9 @@ scriptWitnessPolicyId (PlutusScriptWitness _ _ (PReferenceScript _ mPid) _ _ _) readValueScriptWitnesses :: CardanoEra era -> (Value, [ScriptWitnessFiles WitCtxMint]) - -> ExceptT ShelleyTxCmdError IO (Value, [ScriptWitness WitCtxMint era]) + -> ExceptT TxCmdError IO (Value, [ScriptWitness WitCtxMint era]) readValueScriptWitnesses era (v, sWitFiles) = do - sWits <- mapM (firstExceptT ShelleyTxCmdScriptWitnessError . readScriptWitness era) sWitFiles + sWits <- mapM (firstExceptT TxCmdScriptWitnessError . readScriptWitness era) sWitFiles return (v, sWits) -- ---------------------------------------------------------------------------- @@ -884,23 +884,23 @@ runTxSignCmd :: () -> [WitnessSigningData] -> Maybe NetworkId -> TxFile Out - -> ExceptT ShelleyTxCmdError IO () + -> ExceptT TxCmdError IO () runTxSignCmd txOrTxBody witSigningData mnw outTxFile = do - sks <- mapM (firstExceptT ShelleyTxCmdReadWitnessSigningDataError . newExceptT . readWitnessSigningData) witSigningData + sks <- mapM (firstExceptT TxCmdReadWitnessSigningDataError . newExceptT . readWitnessSigningData) witSigningData let (sksByron, sksShelley) = partitionSomeWitnesses $ map categoriseSomeWitness sks case txOrTxBody of InputTxFile (File inputTxFilePath) -> do inputTxFile <- liftIO $ fileOrPipe inputTxFilePath - anyTx <- lift (readFileTx inputTxFile) & onLeft (left . ShelleyTxCmdCddlError) + anyTx <- lift (readFileTx inputTxFile) & onLeft (left . TxCmdCddlError) InAnyShelleyBasedEra _era tx <- onlyInShelleyBasedEras "sign for Byron era transactions" anyTx let (txbody, existingTxKeyWits) = getTxBodyAndWitnesses tx - byronWitnesses <- firstExceptT ShelleyTxCmdBootstrapWitnessError + byronWitnesses <- firstExceptT TxCmdBootstrapWitnessError . hoistEither $ mkShelleyBootstrapWitnesses mnw txbody sksByron @@ -909,11 +909,11 @@ runTxSignCmd txOrTxBody witSigningData mnw outTxFile = do signedTx = makeSignedTransaction allKeyWits txbody lift (writeTxFileTextEnvelopeCddl outTxFile signedTx) - & onLeft (left . ShelleyTxCmdWriteFileError) + & onLeft (left . TxCmdWriteFileError) InputTxBodyFile (File txbodyFilePath) -> do txbodyFile <- liftIO $ fileOrPipe txbodyFilePath - unwitnessed <- firstExceptT ShelleyTxCmdCddlError . newExceptT + unwitnessed <- firstExceptT TxCmdCddlError . newExceptT $ readFileTxBody txbodyFile case unwitnessed of @@ -924,7 +924,7 @@ runTxSignCmd txOrTxBody witSigningData mnw outTxFile = do let txbody = getTxBody unwitTx -- Byron witnesses require the network ID. This can either be provided -- directly or derived from a provided Byron address. - byronWitnesses <- firstExceptT ShelleyTxCmdBootstrapWitnessError + byronWitnesses <- firstExceptT TxCmdBootstrapWitnessError . hoistEither $ mkShelleyBootstrapWitnesses mnw txbody sksByron @@ -932,7 +932,7 @@ runTxSignCmd txOrTxBody witSigningData mnw outTxFile = do tx = makeSignedTransaction (byronWitnesses ++ shelleyKeyWitnesses) txbody lift (writeTxFileTextEnvelopeCddl outTxFile tx) - & onLeft (left . ShelleyTxCmdWriteFileError) + & onLeft (left . TxCmdWriteFileError) UnwitnessedCliFormattedTxBody anyTxbody -> do InAnyShelleyBasedEra _era txbody <- @@ -940,14 +940,14 @@ runTxSignCmd txOrTxBody witSigningData mnw outTxFile = do onlyInShelleyBasedEras "sign for Byron era transactions" anyTxbody -- Byron witnesses require the network ID. This can either be provided -- directly or derived from a provided Byron address. - byronWitnesses <- firstExceptT ShelleyTxCmdBootstrapWitnessError + byronWitnesses <- firstExceptT TxCmdBootstrapWitnessError . hoistEither $ mkShelleyBootstrapWitnesses mnw txbody sksByron let shelleyKeyWitnesses = map (makeShelleyKeyWitness txbody) sksShelley tx = makeSignedTransaction (byronWitnesses ++ shelleyKeyWitnesses) txbody - firstExceptT ShelleyTxCmdWriteFileError . newExceptT + firstExceptT TxCmdWriteFileError . newExceptT $ writeLazyByteStringFile outTxFile $ textEnvelopeToJSON Nothing tx @@ -960,13 +960,13 @@ runTxSubmitCmd :: () -> AnyConsensusModeParams -> NetworkId -> FilePath - -> ExceptT ShelleyTxCmdError IO () + -> ExceptT TxCmdError IO () runTxSubmitCmd socketPath (AnyConsensusModeParams cModeParams) network txFilePath = do txFile <- liftIO $ fileOrPipe txFilePath - InAnyCardanoEra era tx <- lift (readFileTx txFile) & onLeft (left . ShelleyTxCmdCddlError) + InAnyCardanoEra era tx <- lift (readFileTx txFile) & onLeft (left . TxCmdCddlError) let cMode = AnyConsensusMode $ consensusModeOnly cModeParams eraInMode <- hoistMaybe - (ShelleyTxCmdEraConsensusModeMismatch (Just txFilePath) cMode (AnyCardanoEra era)) + (TxCmdEraConsensusModeMismatch (Just txFilePath) cMode (AnyCardanoEra era)) (toEraInMode era $ consensusModeOnly cModeParams) let txInMode = TxInMode tx eraInMode localNodeConnInfo = LocalNodeConnectInfo @@ -980,8 +980,8 @@ runTxSubmitCmd socketPath (AnyConsensusModeParams cModeParams) network txFilePat Net.Tx.SubmitSuccess -> liftIO $ Text.putStrLn "Transaction successfully submitted." Net.Tx.SubmitFail reason -> case reason of - TxValidationErrorInMode err _eraInMode -> left . ShelleyTxCmdTxSubmitError . Text.pack $ show err - TxValidationEraMismatch mismatchErr -> left $ ShelleyTxCmdTxSubmitErrorEraMismatch mismatchErr + TxValidationErrorInMode err _eraInMode -> left . TxCmdTxSubmitError . Text.pack $ show err + TxValidationEraMismatch mismatchErr -> left $ TxCmdTxSubmitErrorEraMismatch mismatchErr -- ---------------------------------------------------------------------------- -- Transaction fee calculation @@ -995,16 +995,16 @@ runTxCalculateMinFeeCmd :: () -> TxOutCount -> TxShelleyWitnessCount -> TxByronWitnessCount - -> ExceptT ShelleyTxCmdError IO () + -> ExceptT TxCmdError IO () runTxCalculateMinFeeCmd (File txbodyFilePath) nw pParamsFile (TxInCount nInputs) (TxOutCount nOutputs) (TxShelleyWitnessCount nShelleyKeyWitnesses) (TxByronWitnessCount nByronKeyWitnesses) = do txbodyFile <- liftIO $ fileOrPipe txbodyFilePath - unwitnessed <- firstExceptT ShelleyTxCmdCddlError . newExceptT + unwitnessed <- firstExceptT TxCmdCddlError . newExceptT $ readFileTxBody txbodyFile - pparams <- firstExceptT ShelleyTxCmdProtocolParamsError $ readProtocolParameters pParamsFile + pparams <- firstExceptT TxCmdProtocolParamsError $ readProtocolParameters pParamsFile case unwitnessed of IncompleteCddlFormattedTx anyTx -> do InAnyShelleyBasedEra _era unwitTx <- @@ -1045,22 +1045,22 @@ runTxCalculateMinRequiredUTxOCmd :: () => CardanoEra era -> ProtocolParamsFile -> TxOutAnyEra - -> ExceptT ShelleyTxCmdError IO () + -> ExceptT TxCmdError IO () runTxCalculateMinRequiredUTxOCmd era pParamsFile txOut = do - pp <- firstExceptT ShelleyTxCmdProtocolParamsError (readProtocolParameters pParamsFile) + pp <- firstExceptT TxCmdProtocolParamsError (readProtocolParameters pParamsFile) out <- toTxOutInAnyEra era txOut case cardanoEraStyle era of LegacyByronEra -> error "runTxCalculateMinRequiredUTxOCmd: Byron era not implemented yet" ShelleyBasedEra sbe -> do - firstExceptT ShelleyTxCmdPParamsErr . hoistEither + firstExceptT TxCmdPParamsErr . hoistEither $ checkProtocolParameters sbe pp - pp' <- hoistEither . first ShelleyTxCmdProtocolParamsConverstionError $ toLedgerPParams sbe pp + pp' <- hoistEither . first TxCmdProtocolParamsConverstionError $ toLedgerPParams sbe pp let minValue = calculateMinimumUTxO sbe out pp' liftIO . IO.print $ minValue -runTxCreatePolicyIdCmd :: ScriptFile -> ExceptT ShelleyTxCmdError IO () +runTxCreatePolicyIdCmd :: ScriptFile -> ExceptT TxCmdError IO () runTxCreatePolicyIdCmd (ScriptFile sFile) = do - ScriptInAnyLang _ script <- firstExceptT ShelleyTxCmdScriptFileError $ + ScriptInAnyLang _ script <- firstExceptT TxCmdScriptFileError $ readFileScriptInAnyLang sFile liftIO . Text.putStrLn . serialiseToRawBytesHexText $ hashScript script @@ -1092,7 +1092,7 @@ mkShelleyBootstrapWitness => Maybe NetworkId -> TxBody era -> ShelleyBootstrapWitnessSigningKeyData - -> Either ShelleyBootstrapWitnessError (KeyWitness era) + -> Either BootstrapWitnessError (KeyWitness era) mkShelleyBootstrapWitness Nothing _ (ShelleyBootstrapWitnessSigningKeyData _ Nothing) = Left MissingNetworkIdOrByronAddressError mkShelleyBootstrapWitness (Just nw) txBody (ShelleyBootstrapWitnessSigningKeyData skey Nothing) = @@ -1107,7 +1107,7 @@ mkShelleyBootstrapWitnesses => Maybe NetworkId -> TxBody era -> [ShelleyBootstrapWitnessSigningKeyData] - -> Either ShelleyBootstrapWitnessError [KeyWitness era] + -> Either BootstrapWitnessError [KeyWitness era] mkShelleyBootstrapWitnesses mnw txBody = mapM (mkShelleyBootstrapWitness mnw txBody) @@ -1118,20 +1118,20 @@ mkShelleyBootstrapWitnesses mnw txBody = runTxHashScriptDataCmd :: () => ScriptDataOrFile - -> ExceptT ShelleyTxCmdError IO () + -> ExceptT TxCmdError IO () runTxHashScriptDataCmd scriptDataOrFile = do - d <- firstExceptT ShelleyTxCmdScriptDataError $ readScriptDataOrFile scriptDataOrFile + d <- firstExceptT TxCmdScriptDataError $ readScriptDataOrFile scriptDataOrFile liftIO $ BS.putStrLn $ serialiseToRawBytesHex (hashScriptDataBytes d) runTxGetTxIdCmd :: () => InputTxBodyOrTxFile - -> ExceptT ShelleyTxCmdError IO () + -> ExceptT TxCmdError IO () runTxGetTxIdCmd txfile = do InAnyCardanoEra _era txbody <- case txfile of InputTxBodyFile (File txbodyFilePath) -> do txbodyFile <- liftIO $ fileOrPipe txbodyFilePath - unwitnessed <- firstExceptT ShelleyTxCmdCddlError . newExceptT + unwitnessed <- firstExceptT TxCmdCddlError . newExceptT $ readFileTxBody txbodyFile case unwitnessed of UnwitnessedCliFormattedTxBody anyTxBody -> return anyTxBody @@ -1140,18 +1140,18 @@ runTxGetTxIdCmd txfile = do InputTxFile (File txFilePath) -> do txFile <- liftIO $ fileOrPipe txFilePath - InAnyCardanoEra era tx <- lift (readFileTx txFile) & onLeft (left . ShelleyTxCmdCddlError) + InAnyCardanoEra era tx <- lift (readFileTx txFile) & onLeft (left . TxCmdCddlError) return . InAnyCardanoEra era $ getTxBody tx liftIO $ BS.putStrLn $ serialiseToRawBytesHex (getTxId txbody) runTxViewCmd :: () => InputTxBodyOrTxFile - -> ExceptT ShelleyTxCmdError IO () + -> ExceptT TxCmdError IO () runTxViewCmd = \case InputTxBodyFile (File txbodyFilePath) -> do txbodyFile <- liftIO $ fileOrPipe txbodyFilePath - unwitnessed <- firstExceptT ShelleyTxCmdCddlError . newExceptT + unwitnessed <- firstExceptT TxCmdCddlError . newExceptT $ readFileTxBody txbodyFile InAnyCardanoEra era txbody <- case unwitnessed of @@ -1164,7 +1164,7 @@ runTxViewCmd = \case liftIO $ BS.putStr $ friendlyTxBodyBS era txbody InputTxFile (File txFilePath) -> do txFile <- liftIO $ fileOrPipe txFilePath - InAnyCardanoEra era tx <- lift (readFileTx txFile) & onLeft (left . ShelleyTxCmdCddlError) + InAnyCardanoEra era tx <- lift (readFileTx txFile) & onLeft (left . TxCmdCddlError) liftIO $ BS.putStr $ friendlyTxBS era tx @@ -1177,10 +1177,10 @@ runTxCreateWitnessCmd :: () -> WitnessSigningData -> Maybe NetworkId -> File () Out - -> ExceptT ShelleyTxCmdError IO () + -> ExceptT TxCmdError IO () runTxCreateWitnessCmd (File txbodyFilePath) witSignData mbNw oFile = do txbodyFile <- liftIO $ fileOrPipe txbodyFilePath - unwitnessed <- firstExceptT ShelleyTxCmdCddlError . newExceptT + unwitnessed <- firstExceptT TxCmdCddlError . newExceptT $ readFileTxBody txbodyFile case unwitnessed of IncompleteCddlFormattedTx anyTx -> do @@ -1188,27 +1188,27 @@ runTxCreateWitnessCmd (File txbodyFilePath) witSignData mbNw oFile = do onlyInShelleyBasedEras "sign for Byron era transactions" anyTx let txbody = getTxBody cddlTx - someWit <- firstExceptT ShelleyTxCmdReadWitnessSigningDataError + someWit <- firstExceptT TxCmdReadWitnessSigningDataError . newExceptT $ readWitnessSigningData witSignData witness <- case categoriseSomeWitness someWit of -- Byron witnesses require the network ID. This can either be provided -- directly or derived from a provided Byron address. AByronWitness bootstrapWitData -> - firstExceptT ShelleyTxCmdBootstrapWitnessError + firstExceptT TxCmdBootstrapWitnessError . hoistEither $ mkShelleyBootstrapWitness mbNw txbody bootstrapWitData AShelleyKeyWitness skShelley -> pure $ makeShelleyKeyWitness txbody skShelley - firstExceptT ShelleyTxCmdWriteFileError . newExceptT + firstExceptT TxCmdWriteFileError . newExceptT $ writeTxWitnessFileTextEnvelopeCddl sbe oFile witness UnwitnessedCliFormattedTxBody anyTxbody -> do InAnyShelleyBasedEra _era txbody <- onlyInShelleyBasedEras "sign for Byron era transactions" anyTxbody - someWit <- firstExceptT ShelleyTxCmdReadWitnessSigningDataError + someWit <- firstExceptT TxCmdReadWitnessSigningDataError . newExceptT $ readWitnessSigningData witSignData witness <- @@ -1216,13 +1216,13 @@ runTxCreateWitnessCmd (File txbodyFilePath) witSignData mbNw oFile = do -- Byron witnesses require the network ID. This can either be provided -- directly or derived from a provided Byron address. AByronWitness bootstrapWitData -> - firstExceptT ShelleyTxCmdBootstrapWitnessError + firstExceptT TxCmdBootstrapWitnessError . hoistEither $ mkShelleyBootstrapWitness mbNw txbody bootstrapWitData AShelleyKeyWitness skShelley -> pure $ makeShelleyKeyWitness txbody skShelley - firstExceptT ShelleyTxCmdWriteFileError . newExceptT + firstExceptT TxCmdWriteFileError . newExceptT $ writeLazyByteStringFile oFile $ textEnvelopeToJSON Nothing witness @@ -1230,19 +1230,19 @@ runTxSignWitnessCmd :: () => TxBodyFile In -> [WitnessFile] -> File () Out - -> ExceptT ShelleyTxCmdError IO () + -> ExceptT TxCmdError IO () runTxSignWitnessCmd (File txbodyFilePath) witnessFiles oFp = do txbodyFile <- liftIO $ fileOrPipe txbodyFilePath - unwitnessed <- firstExceptT ShelleyTxCmdCddlError . newExceptT + unwitnessed <- firstExceptT TxCmdCddlError . newExceptT $ readFileTxBody txbodyFile case unwitnessed of UnwitnessedCliFormattedTxBody (InAnyCardanoEra era txbody) -> do witnesses <- sequence - [ do InAnyCardanoEra era' witness <- firstExceptT ShelleyTxCmdCddlWitnessError . newExceptT + [ do InAnyCardanoEra era' witness <- firstExceptT TxCmdCddlWitnessError . newExceptT $ readFileTxKeyWitness file case testEquality era era' of - Nothing -> left $ ShelleyTxCmdWitnessEraMismatch + Nothing -> left $ TxCmdWitnessEraMismatch (AnyCardanoEra era) (AnyCardanoEra era') witnessFile @@ -1251,7 +1251,7 @@ runTxSignWitnessCmd (File txbodyFilePath) witnessFiles oFp = do ] let tx = makeSignedTransaction witnesses txbody - firstExceptT ShelleyTxCmdWriteFileError + firstExceptT TxCmdWriteFileError . newExceptT $ writeLazyByteStringFile oFp $ textEnvelopeToJSON Nothing tx @@ -1261,10 +1261,10 @@ runTxSignWitnessCmd (File txbodyFilePath) witnessFiles oFp = do witnesses <- sequence - [ do InAnyCardanoEra era' witness <- firstExceptT ShelleyTxCmdCddlWitnessError . newExceptT + [ do InAnyCardanoEra era' witness <- firstExceptT TxCmdCddlWitnessError . newExceptT $ readFileTxKeyWitness file case testEquality era era' of - Nothing -> left $ ShelleyTxCmdWitnessEraMismatch + Nothing -> left $ TxCmdWitnessEraMismatch (AnyCardanoEra era) (AnyCardanoEra era') witnessFile @@ -1273,16 +1273,16 @@ runTxSignWitnessCmd (File txbodyFilePath) witnessFiles oFp = do let tx = makeSignedTransaction witnesses txbody - lift (writeTxFileTextEnvelopeCddl oFp tx) & onLeft (left . ShelleyTxCmdWriteFileError) + lift (writeTxFileTextEnvelopeCddl oFp tx) & onLeft (left . TxCmdWriteFileError) -- | Constrain the era to be Shelley based. Fail for the Byron era. -- onlyInShelleyBasedEras :: Text -> InAnyCardanoEra a - -> ExceptT ShelleyTxCmdError IO + -> ExceptT TxCmdError IO (InAnyShelleyBasedEra a) onlyInShelleyBasedEras notImplMsg (InAnyCardanoEra era x) = case cardanoEraStyle era of - LegacyByronEra -> left (ShelleyTxCmdNotImplemented notImplMsg) + LegacyByronEra -> left (TxCmdNotImplemented notImplMsg) ShelleyBasedEra sbe -> return (InAnyShelleyBasedEra sbe x) diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Address.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Address.hs index fd333ffabb..0aa940b4ed 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Address.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Address.hs @@ -15,8 +15,8 @@ import Cardano.CLI.EraBased.Run.Address import Cardano.CLI.EraBased.Run.Address.Info import Cardano.CLI.Legacy.Commands.Address import Cardano.CLI.Types.Common -import Cardano.CLI.Types.Errors.ShelleyAddressCmdError -import Cardano.CLI.Types.Errors.ShelleyAddressInfoError +import Cardano.CLI.Types.Errors.AddressCmdError +import Cardano.CLI.Types.Errors.AddressInfoError import Cardano.CLI.Types.Key (PaymentVerifier (..), StakeIdentifier (..), VerificationKeyTextOrFile) @@ -25,7 +25,7 @@ import Control.Monad.Trans.Except.Extra (firstExceptT) import Data.Function import Data.Text (Text) -runLegacyAddressCmds :: LegacyAddressCmds -> ExceptT ShelleyAddressCmdError IO () +runLegacyAddressCmds :: LegacyAddressCmds -> ExceptT AddressCmdError IO () runLegacyAddressCmds = \case AddressKeyGen fmt kt vkf skf -> runLegacyAddressKeyGenCmd fmt kt vkf skf @@ -34,20 +34,20 @@ runLegacyAddressCmds = \case AddressBuild paymentVerifier mbStakeVerifier nw mOutFp -> runLegacyAddressBuildCmd paymentVerifier mbStakeVerifier nw mOutFp AddressInfo txt mOFp -> - runLegacyAddressInfoCmd txt mOFp & firstExceptT ShelleyAddressCmdAddressInfoError + runLegacyAddressInfoCmd txt mOFp & firstExceptT AddressCmdAddressInfoError runLegacyAddressKeyGenCmd :: () => KeyOutputFormat -> AddressKeyType -> VerificationKeyFile Out -> SigningKeyFile Out - -> ExceptT ShelleyAddressCmdError IO () + -> ExceptT AddressCmdError IO () runLegacyAddressKeyGenCmd = runAddressKeyGenCmd runLegacyAddressKeyHashCmd :: () => VerificationKeyTextOrFile -> Maybe (File () Out) - -> ExceptT ShelleyAddressCmdError IO () + -> ExceptT AddressCmdError IO () runLegacyAddressKeyHashCmd = runAddressKeyHashCmd runLegacyAddressBuildCmd :: () @@ -55,11 +55,11 @@ runLegacyAddressBuildCmd :: () -> Maybe StakeIdentifier -> NetworkId -> Maybe (File () Out) - -> ExceptT ShelleyAddressCmdError IO () + -> ExceptT AddressCmdError IO () runLegacyAddressBuildCmd = runAddressBuildCmd runLegacyAddressInfoCmd :: () => Text -> Maybe (File () Out) - -> ExceptT ShelleyAddressInfoError IO () + -> ExceptT AddressInfoError IO () runLegacyAddressInfoCmd = runAddressInfoCmd diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs index 25cb725821..8faf4f7d5b 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs @@ -14,11 +14,11 @@ import Cardano.Chain.Common (BlockCount) import Cardano.CLI.EraBased.Run.Genesis import Cardano.CLI.Legacy.Commands.Genesis import Cardano.CLI.Types.Common -import Cardano.CLI.Types.Errors.ShelleyGenesisCmdError +import Cardano.CLI.Types.Errors.GenesisCmdError import Control.Monad.Trans.Except (ExceptT) -runLegacyGenesisCmds :: LegacyGenesisCmds -> ExceptT ShelleyGenesisCmdError IO () +runLegacyGenesisCmds :: LegacyGenesisCmds -> ExceptT GenesisCmdError IO () runLegacyGenesisCmds = \case GenesisKeyGenGenesis vk sk -> runLegacyGenesisKeyGenGenesisCmd vk sk @@ -46,43 +46,43 @@ runLegacyGenesisCmds = \case runLegacyGenesisKeyGenGenesisCmd :: () => VerificationKeyFile Out -> SigningKeyFile Out - -> ExceptT ShelleyGenesisCmdError IO () + -> ExceptT GenesisCmdError IO () runLegacyGenesisKeyGenGenesisCmd = runGenesisKeyGenGenesisCmd runLegacyGenesisKeyGenDelegateCmd :: () => VerificationKeyFile Out -> SigningKeyFile Out -> OpCertCounterFile Out - -> ExceptT ShelleyGenesisCmdError IO () + -> ExceptT GenesisCmdError IO () runLegacyGenesisKeyGenDelegateCmd = runGenesisKeyGenDelegateCmd runLegacyGenesisKeyGenUTxOCmd :: () => VerificationKeyFile Out -> SigningKeyFile Out - -> ExceptT ShelleyGenesisCmdError IO () + -> ExceptT GenesisCmdError IO () runLegacyGenesisKeyGenUTxOCmd = runGenesisKeyGenUTxOCmd -runLegacyGenesisKeyHashCmd :: VerificationKeyFile In -> ExceptT ShelleyGenesisCmdError IO () +runLegacyGenesisKeyHashCmd :: VerificationKeyFile In -> ExceptT GenesisCmdError IO () runLegacyGenesisKeyHashCmd = runGenesisKeyHashCmd runLegacyGenesisVerKeyCmd :: VerificationKeyFile Out -> SigningKeyFile In - -> ExceptT ShelleyGenesisCmdError IO () + -> ExceptT GenesisCmdError IO () runLegacyGenesisVerKeyCmd = runGenesisVerKeyCmd runLegacyGenesisTxInCmd :: () => VerificationKeyFile In -> NetworkId -> Maybe (File () Out) - -> ExceptT ShelleyGenesisCmdError IO () + -> ExceptT GenesisCmdError IO () runLegacyGenesisTxInCmd = runGenesisTxInCmd runLegacyGenesisAddrCmd :: () => VerificationKeyFile In -> NetworkId -> Maybe (File () Out) - -> ExceptT ShelleyGenesisCmdError IO () + -> ExceptT GenesisCmdError IO () runLegacyGenesisAddrCmd = runGenesisAddrCmd runLegacyGenesisCreateCmd :: () @@ -93,7 +93,7 @@ runLegacyGenesisCreateCmd :: () -> Maybe SystemStart -> Maybe Lovelace -> NetworkId - -> ExceptT ShelleyGenesisCmdError IO () + -> ExceptT GenesisCmdError IO () runLegacyGenesisCreateCmd = runGenesisCreateCmd runLegacyGenesisCreateCardanoCmd :: () @@ -111,7 +111,7 @@ runLegacyGenesisCreateCardanoCmd :: () -> FilePath -- ^ Alonzo Genesis -> FilePath -- ^ Conway Genesis -> Maybe FilePath - -> ExceptT ShelleyGenesisCmdError IO () + -> ExceptT GenesisCmdError IO () runLegacyGenesisCreateCardanoCmd = runGenesisCreateCardanoCmd runLegacyGenesisCreateStakedCmd :: () @@ -129,11 +129,11 @@ runLegacyGenesisCreateStakedCmd :: () -> Word -- ^ pool credentials per bulk file -> Word -- ^ num stuffed UTxO entries -> Maybe FilePath -- ^ Specified stake pool relays - -> ExceptT ShelleyGenesisCmdError IO () + -> ExceptT GenesisCmdError IO () runLegacyGenesisCreateStakedCmd = runGenesisCreateStakedCmd -- | Hash a genesis file runLegacyGenesisHashFileCmd :: () => GenesisFile - -> ExceptT ShelleyGenesisCmdError IO () + -> ExceptT GenesisCmdError IO () runLegacyGenesisHashFileCmd = runGenesisHashFileCmd diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Key.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Key.hs index 95585c20de..658189900e 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Key.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Key.hs @@ -10,14 +10,14 @@ import Cardano.Api import Cardano.CLI.EraBased.Run.Key import Cardano.CLI.Legacy.Commands.Key import Cardano.CLI.Types.Common -import Cardano.CLI.Types.Errors.ShelleyKeyCmdError +import Cardano.CLI.Types.Errors.KeyCmdError import Control.Monad.Trans.Except (ExceptT) import Data.Text (Text) runLegacyKeyCmds :: () => LegacyKeyCmds - -> ExceptT ShelleyKeyCmdError IO () + -> ExceptT KeyCmdError IO () runLegacyKeyCmds = \case KeyGetVerificationKey skf vkf -> runLegacyGetVerificationKeyCmd skf vkf @@ -39,13 +39,13 @@ runLegacyKeyCmds = \case runLegacyGetVerificationKeyCmd :: () => SigningKeyFile In -> VerificationKeyFile Out - -> ExceptT ShelleyKeyCmdError IO () + -> ExceptT KeyCmdError IO () runLegacyGetVerificationKeyCmd = runGetVerificationKeyCmd runLegacyConvertToNonExtendedKeyCmd :: () => VerificationKeyFile In -> VerificationKeyFile Out - -> ExceptT ShelleyKeyCmdError IO () + -> ExceptT KeyCmdError IO () runLegacyConvertToNonExtendedKeyCmd = runConvertToNonExtendedKeyCmd runLegacyConvertByronKeyCmd :: () @@ -53,13 +53,13 @@ runLegacyConvertByronKeyCmd :: () -> ByronKeyType -> SomeKeyFile In -- ^ Input file: old format -> File () Out -- ^ Output file: new format - -> ExceptT ShelleyKeyCmdError IO () + -> ExceptT KeyCmdError IO () runLegacyConvertByronKeyCmd = runConvertByronKeyCmd runLegacyConvertByronGenesisVerificationKeyCmd :: () => VerificationKeyBase64 -- ^ Input key raw old format -> File () Out -- ^ Output file: new format - -> ExceptT ShelleyKeyCmdError IO () + -> ExceptT KeyCmdError IO () runLegacyConvertByronGenesisVerificationKeyCmd = runConvertByronGenesisVerificationKeyCmd -------------------------------------------------------------------------------- @@ -69,24 +69,24 @@ runLegacyConvertByronGenesisVerificationKeyCmd = runConvertByronGenesisVerificat runLegacyConvertITNStakeKeyCmd :: () => SomeKeyFile In -> File () Out - -> ExceptT ShelleyKeyCmdError IO () + -> ExceptT KeyCmdError IO () runLegacyConvertITNStakeKeyCmd = runConvertITNStakeKeyCmd runLegacyConvertITNExtendedToStakeKeyCmd :: () => SomeKeyFile In -> File () Out - -> ExceptT ShelleyKeyCmdError IO () + -> ExceptT KeyCmdError IO () runLegacyConvertITNExtendedToStakeKeyCmd = runConvertITNExtendedToStakeKeyCmd runLegacyConvertITNBip32ToStakeKeyCmd :: () => SomeKeyFile In -> File () Out - -> ExceptT ShelleyKeyCmdError IO () + -> ExceptT KeyCmdError IO () runLegacyConvertITNBip32ToStakeKeyCmd = runConvertITNBip32ToStakeKeyCmd runLegacyConvertCardanoAddressSigningKeyCmd :: () => CardanoAddressKeyType -> SigningKeyFile In -> File () Out - -> ExceptT ShelleyKeyCmdError IO () + -> ExceptT KeyCmdError IO () runLegacyConvertCardanoAddressSigningKeyCmd = runConvertCardanoAddressSigningKeyCmd diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Node.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Node.hs index 626f2a1867..e23455bd2d 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Node.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Node.hs @@ -11,7 +11,7 @@ import Cardano.Api.Shelley import Cardano.CLI.EraBased.Run.Node import Cardano.CLI.Legacy.Commands.Node import Cardano.CLI.Types.Common -import Cardano.CLI.Types.Errors.ShelleyNodeCmdError +import Cardano.CLI.Types.Errors.NodeCmdError import Cardano.CLI.Types.Key import Control.Monad.Trans.Except (ExceptT) @@ -20,7 +20,7 @@ import Control.Monad.Trans.Except (ExceptT) runLegacyNodeCmds :: () => LegacyNodeCmds - -> ExceptT ShelleyNodeCmdError IO () + -> ExceptT NodeCmdError IO () runLegacyNodeCmds = \case NodeKeyGenCold fmt vk sk ctr -> runLegacyNodeKeyGenColdCmd fmt vk sk ctr @@ -40,34 +40,34 @@ runLegacyNodeKeyGenColdCmd :: () -> VerificationKeyFile Out -> SigningKeyFile Out -> OpCertCounterFile Out - -> ExceptT ShelleyNodeCmdError IO () + -> ExceptT NodeCmdError IO () runLegacyNodeKeyGenColdCmd = runNodeKeyGenColdCmd runLegacyNodeKeyGenKesCmd :: () => KeyOutputFormat -> VerificationKeyFile Out -> SigningKeyFile Out - -> ExceptT ShelleyNodeCmdError IO () + -> ExceptT NodeCmdError IO () runLegacyNodeKeyGenKesCmd = runNodeKeyGenKesCmd runLegacyNodeKeyGenVrfCmd :: () => KeyOutputFormat -> VerificationKeyFile Out -> SigningKeyFile Out - -> ExceptT ShelleyNodeCmdError IO () + -> ExceptT NodeCmdError IO () runLegacyNodeKeyGenVrfCmd = runNodeKeyGenVrfCmd runLegacyNodeKeyHashVrfCmd :: () => VerificationKeyOrFile VrfKey -> Maybe (File () Out) - -> ExceptT ShelleyNodeCmdError IO () + -> ExceptT NodeCmdError IO () runLegacyNodeKeyHashVrfCmd = runNodeKeyHashVrfCmd runLegacyNodeNewCounterCmd :: () => ColdVerificationKeyOrFile -> Word -> OpCertCounterFile InOut - -> ExceptT ShelleyNodeCmdError IO () + -> ExceptT NodeCmdError IO () runLegacyNodeNewCounterCmd = runNodeNewCounterCmd runLegacyNodeIssueOpCertCmd :: () @@ -81,5 +81,5 @@ runLegacyNodeIssueOpCertCmd :: () -> KESPeriod -- ^ Start of the validity period for this certificate. -> File () Out - -> ExceptT ShelleyNodeCmdError IO () + -> ExceptT NodeCmdError IO () runLegacyNodeIssueOpCertCmd = runNodeIssueOpCertCmd diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Query.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Query.hs index f43305c8bc..e6f5f75548 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Query.hs @@ -14,13 +14,13 @@ import Cardano.Api.Shelley hiding (QueryInShelleyBasedEra (..)) import qualified Cardano.CLI.EraBased.Run.Query as EraBased import Cardano.CLI.Legacy.Commands.Query import Cardano.CLI.Types.Common -import Cardano.CLI.Types.Errors.ShelleyQueryCmdError +import Cardano.CLI.Types.Errors.QueryCmdError import Cardano.CLI.Types.Key (VerificationKeyOrHashOrFile) import Control.Monad.Trans.Except import Data.Time.Clock -runLegacyQueryCmds :: LegacyQueryCmds -> ExceptT ShelleyQueryCmdError IO () +runLegacyQueryCmds :: LegacyQueryCmds -> ExceptT QueryCmdError IO () runLegacyQueryCmds = \case QueryLeadershipSchedule mNodeSocketPath consensusModeParams network shelleyGenFp poolid vrkSkeyFp whichSchedule outputAs -> runLegacyQueryLeadershipScheduleCmd mNodeSocketPath consensusModeParams network shelleyGenFp poolid vrkSkeyFp whichSchedule outputAs @@ -58,7 +58,7 @@ runLegacyQueryConstitutionHashCmd :: () -> AnyConsensusModeParams -> NetworkId -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () runLegacyQueryConstitutionHashCmd = EraBased.runQueryConstitutionHashCmd runLegacyQueryProtocolParametersCmd :: () @@ -66,7 +66,7 @@ runLegacyQueryProtocolParametersCmd :: () -> AnyConsensusModeParams -> NetworkId -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () runLegacyQueryProtocolParametersCmd = EraBased.runQueryProtocolParametersCmd runLegacyQueryTipCmd :: () @@ -74,7 +74,7 @@ runLegacyQueryTipCmd :: () -> AnyConsensusModeParams -> NetworkId -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () runLegacyQueryTipCmd = EraBased.runQueryTipCmd -- | Query the UTxO, filtered by a given set of addresses, from a Shelley node @@ -85,7 +85,7 @@ runLegacyQueryUTxOCmd :: () -> QueryUTxOFilter -> NetworkId -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () runLegacyQueryUTxOCmd = EraBased.runQueryUTxOCmd runLegacyQueryKesPeriodInfoCmd :: () @@ -94,7 +94,7 @@ runLegacyQueryKesPeriodInfoCmd :: () -> NetworkId -> File () In -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () runLegacyQueryKesPeriodInfoCmd = EraBased.runQueryKesPeriodInfoCmd -- | Query the current and future parameters for a stake pool, including the retirement date. @@ -105,7 +105,7 @@ runLegacyQueryPoolStateCmd :: () -> AnyConsensusModeParams -> NetworkId -> [Hash StakePoolKey] - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () runLegacyQueryPoolStateCmd = EraBased.runQueryPoolStateCmd -- | Query the local mempool state @@ -115,7 +115,7 @@ runLegacyQueryTxMempoolCmd :: () -> NetworkId -> TxMempoolQuery -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () runLegacyQueryTxMempoolCmd = EraBased.runQueryTxMempoolCmd runLegacyQuerySlotNumberCmd :: () @@ -123,7 +123,7 @@ runLegacyQuerySlotNumberCmd :: () -> AnyConsensusModeParams -> NetworkId -> UTCTime - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () runLegacyQuerySlotNumberCmd = EraBased.runQuerySlotNumberCmd -- | Obtain stake snapshot information for a pool, plus information about the total active stake. @@ -135,7 +135,7 @@ runLegacyQueryStakeSnapshotCmd :: () -> NetworkId -> AllOrOnly [Hash StakePoolKey] -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () runLegacyQueryStakeSnapshotCmd = EraBased.runQueryStakeSnapshotCmd runLegacyQueryLedgerStateCmd :: () @@ -143,7 +143,7 @@ runLegacyQueryLedgerStateCmd :: () -> AnyConsensusModeParams -> NetworkId -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () runLegacyQueryLedgerStateCmd = EraBased.runQueryLedgerStateCmd runLegacyQueryProtocolStateCmd :: () @@ -151,7 +151,7 @@ runLegacyQueryProtocolStateCmd :: () -> AnyConsensusModeParams -> NetworkId -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () runLegacyQueryProtocolStateCmd = EraBased.runQueryProtocolStateCmd -- | Query the current delegations and reward accounts, filtered by a given @@ -163,7 +163,7 @@ runLegacyQueryStakeAddressInfoCmd :: () -> StakeAddress -> NetworkId -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () runLegacyQueryStakeAddressInfoCmd = EraBased.runQueryStakeAddressInfoCmd runLegacyQueryStakePoolsCmd :: () @@ -171,7 +171,7 @@ runLegacyQueryStakePoolsCmd :: () -> AnyConsensusModeParams -> NetworkId -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () runLegacyQueryStakePoolsCmd = EraBased.runQueryStakePoolsCmd runLegacyQueryStakeDistributionCmd :: () @@ -179,7 +179,7 @@ runLegacyQueryStakeDistributionCmd :: () -> AnyConsensusModeParams -> NetworkId -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () runLegacyQueryStakeDistributionCmd = EraBased.runQueryStakeDistributionCmd runLegacyQueryLeadershipScheduleCmd :: () @@ -191,5 +191,5 @@ runLegacyQueryLeadershipScheduleCmd :: () -> SigningKeyFile In -- ^ VRF signing key -> EpochLeadershipSchedule -> Maybe (File () Out) - -> ExceptT ShelleyQueryCmdError IO () + -> ExceptT QueryCmdError IO () runLegacyQueryLeadershipScheduleCmd = EraBased.runQueryLeadershipScheduleCmd diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/StakeAddress.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/StakeAddress.hs index b5fd33c6e7..c537e57ee2 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/StakeAddress.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/StakeAddress.hs @@ -11,14 +11,14 @@ import Cardano.Api.Shelley import Cardano.CLI.EraBased.Run.StakeAddress import Cardano.CLI.Legacy.Commands.StakeAddress import Cardano.CLI.Types.Common -import Cardano.CLI.Types.Errors.ShelleyStakeAddressCmdError +import Cardano.CLI.Types.Errors.StakeAddressCmdError import Cardano.CLI.Types.Key import Control.Monad.Trans.Except (ExceptT) runLegacyStakeAddressCmds :: () => LegacyStakeAddressCmds - -> ExceptT ShelleyStakeAddressCmdError IO () + -> ExceptT StakeAddressCmdError IO () runLegacyStakeAddressCmds = \case StakeAddressKeyGenCmd fmt vk sk -> runLegacyStakeAddressKeyGenCmd fmt vk sk @@ -37,14 +37,14 @@ runLegacyStakeAddressKeyGenCmd :: () => KeyOutputFormat -> VerificationKeyFile Out -> SigningKeyFile Out - -> ExceptT ShelleyStakeAddressCmdError IO () + -> ExceptT StakeAddressCmdError IO () runLegacyStakeAddressKeyGenCmd = runStakeAddressKeyGenCmd runLegacyStakeAddressKeyHashCmd :: () => VerificationKeyOrFile StakeKey -> Maybe (File () Out) - -> ExceptT ShelleyStakeAddressCmdError IO () + -> ExceptT StakeAddressCmdError IO () runLegacyStakeAddressKeyHashCmd = runStakeAddressKeyHashCmd @@ -52,7 +52,7 @@ runLegacyStakeAddressBuildCmd :: () => StakeVerifier -> NetworkId -> Maybe (File () Out) - -> ExceptT ShelleyStakeAddressCmdError IO () + -> ExceptT StakeAddressCmdError IO () runLegacyStakeAddressBuildCmd = runStakeAddressBuildCmd @@ -61,7 +61,7 @@ runLegacyStakeAddressRegistrationCertificateCmd :: () -> StakeIdentifier -> Maybe Lovelace -- ^ Deposit required in conway era -> File () Out - -> ExceptT ShelleyStakeAddressCmdError IO () + -> ExceptT StakeAddressCmdError IO () runLegacyStakeAddressRegistrationCertificateCmd (AnyShelleyBasedEra sbe) = runStakeAddressRegistrationCertificateCmd sbe @@ -73,7 +73,7 @@ runLegacyStakeAddresslDelegationCertificateCmd :: () -- ^ Delegatee stake pool verification key or verification key file or -- verification key hash. -> File () Out - -> ExceptT ShelleyStakeAddressCmdError IO () + -> ExceptT StakeAddressCmdError IO () runLegacyStakeAddresslDelegationCertificateCmd (AnyShelleyBasedEra sbe) = runStakeAddressStakeDelegationCertificateCmd sbe @@ -82,6 +82,6 @@ runLegacyStakeAddressDeregistrationCertificateCmd :: () -> StakeIdentifier -> Maybe Lovelace -- ^ Deposit required in conway era -> File () Out - -> ExceptT ShelleyStakeAddressCmdError IO () + -> ExceptT StakeAddressCmdError IO () runLegacyStakeAddressDeregistrationCertificateCmd (AnyShelleyBasedEra sbe) = runStakeAddressDeregistrationCertificateCmd sbe diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/TextView.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/TextView.hs index 4830d6b547..53e367c08e 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/TextView.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/TextView.hs @@ -9,16 +9,16 @@ import Cardano.Api import Cardano.CLI.EraBased.Run.TextView import Cardano.CLI.Legacy.Commands.TextView -import Cardano.CLI.Types.Errors.ShelleyTextViewFileError +import Cardano.CLI.Types.Errors.TextViewFileError import Control.Monad.Trans.Except (ExceptT) -runLegacyTextViewCmds :: LegacyTextViewCmds -> ExceptT ShelleyTextViewFileError IO () +runLegacyTextViewCmds :: LegacyTextViewCmds -> ExceptT TextViewFileError IO () runLegacyTextViewCmds = \case TextViewInfo fpath mOutfile -> runLegacyTextViewInfoCmd fpath mOutfile runLegacyTextViewInfoCmd :: () => FilePath -> Maybe (File () Out) - -> ExceptT ShelleyTextViewFileError IO () + -> ExceptT TextViewFileError IO () runLegacyTextViewInfoCmd = runTextViewInfoCmd diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs index 82b6c01a9e..6be7d5aca9 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs @@ -13,13 +13,13 @@ import Cardano.Api import Cardano.CLI.EraBased.Run.Transaction import Cardano.CLI.Legacy.Commands.Transaction import Cardano.CLI.Types.Common -import Cardano.CLI.Types.Errors.ShelleyTxCmdError +import Cardano.CLI.Types.Errors.TxCmdError import Cardano.CLI.Types.Governance import Control.Monad.Trans.Except -runLegacyTransactionCmds :: LegacyTransactionCmds -> ExceptT ShelleyTxCmdError IO () +runLegacyTransactionCmds :: LegacyTransactionCmds -> ExceptT TxCmdError IO () runLegacyTransactionCmds cmd = case cmd of TxBuild mNodeSocketPath era consensusModeParams nid mScriptValidity mOverrideWits txins readOnlyRefIns @@ -88,7 +88,7 @@ runLegacyTxBuildCmd :: () -> [VoteFile In] -> [ProposalFile In] -> TxBuildOutputOptions - -> ExceptT ShelleyTxCmdError IO () + -> ExceptT TxCmdError IO () runLegacyTxBuildCmd socketPath (AnyCardanoEra era) = runTxBuildCmd era socketPath runLegacyTxBuildRawCmd :: () @@ -113,14 +113,14 @@ runLegacyTxBuildRawCmd :: () -> Maybe ProtocolParamsFile -> Maybe UpdateProposalFile -> TxBodyFile Out - -> ExceptT ShelleyTxCmdError IO () + -> ExceptT TxCmdError IO () runLegacyTxBuildRawCmd (AnyCardanoEra era) = runTxBuildRawCmd era runLegacyTxSignCmd :: InputTxBodyOrTxFile -> [WitnessSigningData] -> Maybe NetworkId -> TxFile Out - -> ExceptT ShelleyTxCmdError IO () + -> ExceptT TxCmdError IO () runLegacyTxSignCmd = runTxSignCmd runLegacyTxSubmitCmd :: () @@ -128,7 +128,7 @@ runLegacyTxSubmitCmd :: () -> AnyConsensusModeParams -> NetworkId -> FilePath - -> ExceptT ShelleyTxCmdError IO () + -> ExceptT TxCmdError IO () runLegacyTxSubmitCmd = runTxSubmitCmd runLegacyTxCalculateMinFeeCmd :: () @@ -139,26 +139,26 @@ runLegacyTxCalculateMinFeeCmd :: () -> TxOutCount -> TxShelleyWitnessCount -> TxByronWitnessCount - -> ExceptT ShelleyTxCmdError IO () + -> ExceptT TxCmdError IO () runLegacyTxCalculateMinFeeCmd = runTxCalculateMinFeeCmd runLegacyTxCalculateMinRequiredUTxOCmd :: () => AnyCardanoEra -> ProtocolParamsFile -> TxOutAnyEra - -> ExceptT ShelleyTxCmdError IO () + -> ExceptT TxCmdError IO () runLegacyTxCalculateMinRequiredUTxOCmd (AnyCardanoEra era) = runTxCalculateMinRequiredUTxOCmd era -runLegacyTxCreatePolicyIdCmd :: ScriptFile -> ExceptT ShelleyTxCmdError IO () +runLegacyTxCreatePolicyIdCmd :: ScriptFile -> ExceptT TxCmdError IO () runLegacyTxCreatePolicyIdCmd = runTxCreatePolicyIdCmd -runLegacyTxHashScriptDataCmd :: ScriptDataOrFile -> ExceptT ShelleyTxCmdError IO () +runLegacyTxHashScriptDataCmd :: ScriptDataOrFile -> ExceptT TxCmdError IO () runLegacyTxHashScriptDataCmd = runTxHashScriptDataCmd -runLegacyTxGetTxIdCmd :: InputTxBodyOrTxFile -> ExceptT ShelleyTxCmdError IO () +runLegacyTxGetTxIdCmd :: InputTxBodyOrTxFile -> ExceptT TxCmdError IO () runLegacyTxGetTxIdCmd = runTxGetTxIdCmd -runLegacyTxViewCmd :: InputTxBodyOrTxFile -> ExceptT ShelleyTxCmdError IO () +runLegacyTxViewCmd :: InputTxBodyOrTxFile -> ExceptT TxCmdError IO () runLegacyTxViewCmd = runTxViewCmd runLegacyTxCreateWitnessCmd :: () @@ -166,12 +166,12 @@ runLegacyTxCreateWitnessCmd :: () -> WitnessSigningData -> Maybe NetworkId -> File () Out - -> ExceptT ShelleyTxCmdError IO () + -> ExceptT TxCmdError IO () runLegacyTxCreateWitnessCmd = runTxCreateWitnessCmd runLegacyTxSignWitnessCmd :: () => TxBodyFile In -> [WitnessFile] -> File () Out - -> ExceptT ShelleyTxCmdError IO () + -> ExceptT TxCmdError IO () runLegacyTxSignWitnessCmd = runTxSignWitnessCmd diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/AddressCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/AddressCmdError.hs new file mode 100644 index 0000000000..4a26883393 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/AddressCmdError.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Cardano.CLI.Types.Errors.AddressCmdError + ( AddressCmdError(..) + , renderAddressCmdError + ) where + +import Cardano.Api + +import Cardano.CLI.Read +import Cardano.CLI.Types.Errors.AddressInfoError +import Cardano.CLI.Types.Key (VerificationKeyTextOrFileError (..), + renderVerificationKeyTextOrFileError) + +import Data.Text (Text) +import qualified Data.Text as Text + +data AddressCmdError + = AddressCmdAddressInfoError !AddressInfoError + | AddressCmdReadKeyFileError !(FileError InputDecodeError) + | AddressCmdReadScriptFileError !(FileError ScriptDecodeError) + | AddressCmdVerificationKeyTextOrFileError !VerificationKeyTextOrFileError + | AddressCmdWriteFileError !(FileError ()) + | AddressCmdExpectedPaymentVerificationKey SomeAddressVerificationKey + deriving Show + +renderAddressCmdError :: AddressCmdError -> Text +renderAddressCmdError err = + case err of + AddressCmdAddressInfoError addrInfoErr -> + Text.pack (displayError addrInfoErr) + AddressCmdReadKeyFileError fileErr -> + Text.pack (displayError fileErr) + AddressCmdVerificationKeyTextOrFileError vkTextOrFileErr -> + renderVerificationKeyTextOrFileError vkTextOrFileErr + AddressCmdReadScriptFileError fileErr -> + Text.pack (displayError fileErr) + AddressCmdWriteFileError fileErr -> Text.pack (displayError fileErr) + AddressCmdExpectedPaymentVerificationKey someAddress -> + "Expected payment verification key but got: " <> renderSomeAddressVerificationKey someAddress diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/AddressInfoError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/AddressInfoError.hs new file mode 100644 index 0000000000..19912630da --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/AddressInfoError.hs @@ -0,0 +1,14 @@ +module Cardano.CLI.Types.Errors.AddressInfoError + ( AddressInfoError(..) + ) where + +import Cardano.Api + +import Data.Text (Text) + +newtype AddressInfoError = ShelleyAddressInvalid Text + deriving Show + +instance Error AddressInfoError where + displayError (ShelleyAddressInvalid addrTxt) = + "Invalid address: " <> show addrTxt diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyBootstrapWitnessError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/BootstrapWitnessError.hs similarity index 60% rename from cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyBootstrapWitnessError.hs rename to cardano-cli/src/Cardano/CLI/Types/Errors/BootstrapWitnessError.hs index 8e7f63907c..29f94b367f 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyBootstrapWitnessError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/BootstrapWitnessError.hs @@ -1,21 +1,21 @@ -module Cardano.CLI.Types.Errors.ShelleyBootstrapWitnessError - ( ShelleyBootstrapWitnessError(..) - , renderShelleyBootstrapWitnessError +module Cardano.CLI.Types.Errors.BootstrapWitnessError + ( BootstrapWitnessError(..) + , renderBootstrapWitnessError ) where import Data.Text (Text) -- | Error constructing a Shelley bootstrap witness (i.e. a Byron key witness -- in the Shelley era). -data ShelleyBootstrapWitnessError +data BootstrapWitnessError = MissingNetworkIdOrByronAddressError -- ^ Neither a network ID nor a Byron address were provided to construct the -- Shelley bootstrap witness. One or the other is required. deriving Show --- | Render an error message for a 'ShelleyBootstrapWitnessError'. -renderShelleyBootstrapWitnessError :: ShelleyBootstrapWitnessError -> Text -renderShelleyBootstrapWitnessError MissingNetworkIdOrByronAddressError = +-- | Render an error message for a 'BootstrapWitnessError'. +renderBootstrapWitnessError :: BootstrapWitnessError -> Text +renderBootstrapWitnessError MissingNetworkIdOrByronAddressError = "Transactions witnessed by a Byron signing key must be accompanied by a " <> "network ID. Either provide a network ID or provide a Byron " <> "address with each Byron signing key (network IDs can be derived " diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/CmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/CmdError.hs index 551703f7de..8a8032fed0 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/CmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/CmdError.hs @@ -14,40 +14,40 @@ import Cardano.CLI.Types.Errors.GovernanceCommitteeError import Cardano.CLI.Types.Errors.GovernanceQueryError import Cardano.CLI.Types.Errors.GovernanceVoteCmdError import Cardano.CLI.Types.Errors.RegistrationError -import Cardano.CLI.Types.Errors.ShelleyAddressCmdError -import Cardano.CLI.Types.Errors.ShelleyGenesisCmdError -import Cardano.CLI.Types.Errors.ShelleyKeyCmdError -import Cardano.CLI.Types.Errors.ShelleyNodeCmdError -import Cardano.CLI.Types.Errors.ShelleyQueryCmdError -import Cardano.CLI.Types.Errors.ShelleyStakeAddressCmdError -import Cardano.CLI.Types.Errors.ShelleyTextViewFileError -import Cardano.CLI.Types.Errors.ShelleyTxCmdError +import Cardano.CLI.Types.Errors.AddressCmdError +import Cardano.CLI.Types.Errors.GenesisCmdError +import Cardano.CLI.Types.Errors.KeyCmdError +import Cardano.CLI.Types.Errors.NodeCmdError +import Cardano.CLI.Types.Errors.QueryCmdError +import Cardano.CLI.Types.Errors.StakeAddressCmdError +import Cardano.CLI.Types.Errors.TextViewFileError +import Cardano.CLI.Types.Errors.TxCmdError import Cardano.CLI.Types.Errors.StakePoolCmdError import Data.Text (Text) import qualified Data.Text as Text data CmdError - = CmdAddressError !ShelleyAddressCmdError + = CmdAddressError !AddressCmdError | CmdEraDelegationError !DelegationError - | CmdGenesisError !ShelleyGenesisCmdError + | CmdGenesisError !GenesisCmdError | CmdGovernanceActionError !GovernanceActionsError | CmdGovernanceCmdError !GovernanceCmdError | CmdGovernanceCommitteeError !GovernanceCommitteeError | CmdGovernanceQueryError !GovernanceQueryError | CmdGovernanceVoteError !GovernanceVoteCmdError - | CmdKeyError !ShelleyKeyCmdError - | CmdNodeError !ShelleyNodeCmdError - | CmdQueryError !ShelleyQueryCmdError + | CmdKeyError !KeyCmdError + | CmdNodeError !NodeCmdError + | CmdQueryError !QueryCmdError | CmdRegistrationError !RegistrationError - | CmdStakeAddressError !ShelleyStakeAddressCmdError + | CmdStakeAddressError !StakeAddressCmdError | CmdStakePoolError !StakePoolCmdError - | CmdTextViewError !ShelleyTextViewFileError - | CmdTransactionError !ShelleyTxCmdError + | CmdTextViewError !TextViewFileError + | CmdTransactionError !TxCmdError renderCmdError :: Text -> CmdError -> Text renderCmdError cmdText = \case - CmdAddressError e -> renderError renderShelleyAddressCmdError e + CmdAddressError e -> renderError renderAddressCmdError e CmdEraDelegationError e -> renderError (Text.pack . displayError) e CmdGenesisError e -> renderError (Text.pack . displayError) e CmdGovernanceActionError e -> renderError (Text.pack . displayError) e @@ -55,14 +55,14 @@ renderCmdError cmdText = \case CmdGovernanceCommitteeError e -> renderError (Text.pack . displayError) e CmdGovernanceQueryError e -> renderError (Text.pack . displayError) e CmdGovernanceVoteError e -> renderError (Text.pack . displayError) e - CmdKeyError e -> renderError renderShelleyKeyCmdError e - CmdNodeError e -> renderError renderShelleyNodeCmdError e - CmdQueryError e -> renderError renderShelleyQueryCmdError e + CmdKeyError e -> renderError renderKeyCmdError e + CmdNodeError e -> renderError renderNodeCmdError e + CmdQueryError e -> renderError renderQueryCmdError e CmdRegistrationError e -> renderError (Text.pack . displayError) e CmdStakeAddressError e -> renderError (Text.pack . displayError) e CmdStakePoolError e -> renderError renderStakePoolCmdError e - CmdTextViewError e -> renderError renderShelleyTextViewFileError e - CmdTransactionError e -> renderError renderShelleyTxCmdError e + CmdTextViewError e -> renderError renderTextViewFileError e + CmdTransactionError e -> renderError renderTxCmdError e where renderError :: (a -> Text) -> a -> Text renderError renderer shelCliCmdErr = diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/GenesisCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/GenesisCmdError.hs new file mode 100644 index 0000000000..6aa91f537b --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/GenesisCmdError.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} + +module Cardano.CLI.Types.Errors.GenesisCmdError + ( GenesisCmdError(..) + ) where + +import Cardano.Api + +import Cardano.CLI.Byron.Genesis as Byron +import Cardano.CLI.Orphans () +import Cardano.CLI.Types.Common +import Cardano.CLI.Types.Errors.AddressCmdError +import Cardano.CLI.Types.Errors.NodeCmdError +import Cardano.CLI.Types.Errors.StakeAddressCmdError +import Cardano.CLI.Types.Errors.StakePoolCmdError + +import Control.Exception (IOException) +import Data.Text (Text) +import qualified Data.Text as Text + +data GenesisCmdError + = GenesisCmdAesonDecodeError !FilePath !Text + | GenesisCmdGenesisFileReadError !(FileError IOException) + | GenesisCmdGenesisFileDecodeError !FilePath !Text + | GenesisCmdGenesisFileError !(FileError ()) + | GenesisCmdFileError !(FileError ()) + | GenesisCmdMismatchedGenesisKeyFiles [Int] [Int] [Int] + | GenesisCmdFilesNoIndex [FilePath] + | GenesisCmdFilesDupIndex [FilePath] + | GenesisCmdTextEnvReadFileError !(FileError TextEnvelopeError) + | GenesisCmdUnexpectedAddressVerificationKey !(VerificationKeyFile In) !Text !SomeAddressVerificationKey + | GenesisCmdTooFewPoolsForBulkCreds !Word !Word !Word + | GenesisCmdAddressCmdError !AddressCmdError + | GenesisCmdNodeCmdError !NodeCmdError + | GenesisCmdStakeAddressCmdError !StakeAddressCmdError + | GenesisCmdStakePoolCmdError !StakePoolCmdError + | GenesisCmdCostModelsError !FilePath + | GenesisCmdByronError !ByronGenesisError + | GenesisCmdStakePoolRelayFileError !FilePath !IOException + | GenesisCmdStakePoolRelayJsonDecodeError !FilePath !String + deriving Show + +instance Error GenesisCmdError where + displayError = + \case + GenesisCmdAesonDecodeError fp decErr -> + "Error while decoding Shelley genesis at: " <> fp <> " Error: " <> Text.unpack decErr + GenesisCmdGenesisFileError fe -> displayError fe + GenesisCmdFileError fe -> displayError fe + GenesisCmdMismatchedGenesisKeyFiles gfiles dfiles vfiles -> + "Mismatch between the files found:\n" + <> "Genesis key file indexes: " <> show gfiles <> "\n" + <> "Delegate key file indexes: " <> show dfiles <> "\n" + <> "Delegate VRF key file indexes: " <> show vfiles + GenesisCmdFilesNoIndex files -> + "The genesis keys files are expected to have a numeric index but these do not:\n" + <> unlines files + GenesisCmdFilesDupIndex files -> + "The genesis keys files are expected to have a unique numeric index but these do not:\n" + <> unlines files + GenesisCmdTextEnvReadFileError fileErr -> displayError fileErr + GenesisCmdUnexpectedAddressVerificationKey (File file) expect got -> mconcat + [ "Unexpected address verification key type in file ", file + , ", expected: ", Text.unpack expect, ", got: ", Text.unpack (renderSomeAddressVerificationKey got) + ] + GenesisCmdTooFewPoolsForBulkCreds pools files perPool -> mconcat + [ "Number of pools requested for generation (", show pools + , ") is insufficient to fill ", show files + , " bulk files, with ", show perPool, " pools per file." + ] + GenesisCmdAddressCmdError e -> + Text.unpack $ renderAddressCmdError e + GenesisCmdNodeCmdError e -> + Text.unpack $ renderNodeCmdError e + GenesisCmdStakePoolCmdError e -> + Text.unpack $ renderStakePoolCmdError e + GenesisCmdStakeAddressCmdError e -> + displayError e + GenesisCmdCostModelsError fp -> + "Cost model is invalid: " <> fp + GenesisCmdGenesisFileDecodeError fp e -> + "Error while decoding Shelley genesis at: " <> fp <> + " Error: " <> Text.unpack e + GenesisCmdGenesisFileReadError e -> displayError e + GenesisCmdByronError e -> show e + GenesisCmdStakePoolRelayFileError fp e -> + "Error occurred while reading the stake pool relay specification file: " <> fp <> + " Error: " <> show e + GenesisCmdStakePoolRelayJsonDecodeError fp e -> + "Error occurred while decoding the stake pool relay specification file: " <> fp <> + " Error: " <> e diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceCmdError.hs index 765d3d231d..f8c9399f4b 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceCmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceCmdError.hs @@ -9,7 +9,7 @@ import Cardano.Api.Shelley import Cardano.Binary (DecoderError) import Cardano.CLI.Read -import Cardano.CLI.Types.Errors.ShelleyStakeAddressCmdError +import Cardano.CLI.Types.Errors.StakeAddressCmdError import qualified Data.List as List import Data.Text (Text) @@ -20,7 +20,7 @@ import qualified Formatting.Buildable as B data GovernanceCmdError = -- Voting related - StakeCredGovCmdError ShelleyStakeAddressCmdError + StakeCredGovCmdError StakeAddressCmdError | VotingCredentialDecodeGovCmdEror DecoderError | WriteFileError (FileError ()) | ReadFileError (FileError InputDecodeError) diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/KeyCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/KeyCmdError.hs new file mode 100644 index 0000000000..0cd573ed55 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/KeyCmdError.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Cardano.CLI.Types.Errors.KeyCmdError + ( KeyCmdError(..) + , renderKeyCmdError + ) where + +import Cardano.Api + +import qualified Cardano.CLI.Byron.Key as Byron +import Cardano.CLI.Types.Errors.CardanoAddressSigningKeyConversionError +import Cardano.CLI.Types.Errors.ItnKeyConversionError +import Cardano.CLI.Types.Key + +import Data.Text (Text) +import qualified Data.Text as Text + +data KeyCmdError + = KeyCmdReadFileError !(FileError TextEnvelopeError) + | KeyCmdReadKeyFileError !(FileError InputDecodeError) + | KeyCmdWriteFileError !(FileError ()) + | KeyCmdByronKeyFailure !Byron.ByronKeyFailure + | KeyCmdByronKeyParseError + !Text + -- ^ Text representation of the parse error. Unfortunately, the actual + -- error type isn't exported. + | KeyCmdItnKeyConvError !ItnKeyConversionError + | KeyCmdWrongKeyTypeError + | KeyCmdCardanoAddressSigningKeyFileError + !(FileError CardanoAddressSigningKeyConversionError) + | KeyCmdNonLegacyKey !FilePath + | KeyCmdExpectedExtendedVerificationKey SomeAddressVerificationKey + | KeyCmdVerificationKeyReadError VerificationKeyTextOrFileError + deriving Show + +renderKeyCmdError :: KeyCmdError -> Text +renderKeyCmdError err = + case err of + KeyCmdReadFileError fileErr -> Text.pack (displayError fileErr) + KeyCmdReadKeyFileError fileErr -> Text.pack (displayError fileErr) + KeyCmdWriteFileError fileErr -> Text.pack (displayError fileErr) + KeyCmdByronKeyFailure e -> Byron.renderByronKeyFailure e + KeyCmdByronKeyParseError errTxt -> errTxt + KeyCmdItnKeyConvError convErr -> renderConversionError convErr + KeyCmdWrongKeyTypeError -> + Text.pack "Please use a signing key file when converting ITN BIP32 or Extended keys" + KeyCmdCardanoAddressSigningKeyFileError fileErr -> + Text.pack (displayError fileErr) + KeyCmdNonLegacyKey fp -> + "Signing key at: " <> Text.pack fp <> " is not a legacy Byron signing key and should not need to be converted." + KeyCmdVerificationKeyReadError e -> renderVerificationKeyTextOrFileError e + KeyCmdExpectedExtendedVerificationKey someVerKey -> + "Expected an extended verification key but got: " <> renderSomeAddressVerificationKey someVerKey diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/NodeCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/NodeCmdError.hs new file mode 100644 index 0000000000..0eddacbee2 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/NodeCmdError.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE DataKinds #-} + +module Cardano.CLI.Types.Errors.NodeCmdError + ( NodeCmdError(..) + , renderNodeCmdError + ) where + +import Cardano.Api + +import Data.Text (Text) +import qualified Data.Text as Text + +{- HLINT ignore "Reduce duplication" -} + +data NodeCmdError + = NodeCmdReadFileError !(FileError TextEnvelopeError) + | NodeCmdReadKeyFileError !(FileError InputDecodeError) + | NodeCmdWriteFileError !(FileError ()) + | NodeCmdOperationalCertificateIssueError !OperationalCertIssueError + | NodeCmdVrfSigningKeyCreationError + FilePath + -- ^ Target path + FilePath + -- ^ Temp path + deriving Show + +renderNodeCmdError :: NodeCmdError -> Text +renderNodeCmdError err = + case err of + NodeCmdVrfSigningKeyCreationError targetPath tempPath -> + Text.pack $ "Error creating VRF signing key file. Target path: " <> targetPath + <> " Temporary path: " <> tempPath + + NodeCmdReadFileError fileErr -> Text.pack (displayError fileErr) + + NodeCmdReadKeyFileError fileErr -> Text.pack (displayError fileErr) + + NodeCmdWriteFileError fileErr -> Text.pack (displayError fileErr) + + NodeCmdOperationalCertificateIssueError issueErr -> + Text.pack (displayError issueErr) diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/QueryCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/QueryCmdError.hs new file mode 100644 index 0000000000..acff562eb2 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/QueryCmdError.hs @@ -0,0 +1,93 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Cardano.CLI.Types.Errors.QueryCmdError + ( QueryCmdError(..) + , renderQueryCmdError + ) where + +import Cardano.Api hiding (QueryInShelleyBasedEra (..)) +import Cardano.Api.Shelley hiding (QueryInShelleyBasedEra (..)) + +import Cardano.Binary (DecoderError) +import Cardano.CLI.Helpers (HelpersError (..), renderHelpersError) +import Cardano.CLI.Types.Errors.GenesisCmdError +import Cardano.CLI.Types.Errors.QueryCmdLocalStateQueryError +import Ouroboros.Consensus.Cardano.Block as Consensus (EraMismatch (..)) +import qualified Ouroboros.Consensus.HardFork.History.Qry as Qry + +import qualified Data.ByteString.Lazy.Char8 as LBS +import Data.Text (Text) +import qualified Data.Text as Text +import Data.Text.Lazy (toStrict) +import Data.Text.Lazy.Builder (toLazyText) +import Formatting.Buildable (build) + +{- HLINT ignore "Move brackets to avoid $" -} +{- HLINT ignore "Redundant flip" -} + +data QueryCmdError + = QueryCmdLocalStateQueryError !QueryCmdLocalStateQueryError + | QueryCmdConvenienceError !QueryConvenienceError + | QueryCmdWriteFileError !(FileError ()) + | QueryCmdHelpersError !HelpersError + | QueryCmdAcquireFailure !AcquiringFailure + | QueryCmdEraConsensusModeMismatch !AnyConsensusMode !AnyCardanoEra + | QueryCmdByronEra + | QueryCmdEraMismatch !EraMismatch + | QueryCmdUnsupportedMode !AnyConsensusMode + | QueryCmdPastHorizon !Qry.PastHorizonException + | QueryCmdSystemStartUnavailable + | QueryCmdGenesisReadError !GenesisCmdError + | QueryCmdLeaderShipError !LeadershipError + | QueryCmdTextEnvelopeReadError !(FileError TextEnvelopeError) + | QueryCmdTextReadError !(FileError InputDecodeError) + | QueryCmdOpCertCounterReadError !(FileError TextEnvelopeError) + | QueryCmdProtocolStateDecodeFailure !(LBS.ByteString, DecoderError) + | QueryCmdPoolStateDecodeError DecoderError + | QueryCmdStakeSnapshotDecodeError DecoderError + | QueryCmdUnsupportedNtcVersion !UnsupportedNtcVersionError + | QueryCmdProtocolParameterConversionError !ProtocolParametersConversionError + deriving Show + +renderQueryCmdError :: QueryCmdError -> Text +renderQueryCmdError err = + case err of + QueryCmdLocalStateQueryError lsqErr -> renderLocalStateQueryError lsqErr + QueryCmdWriteFileError fileErr -> Text.pack (displayError fileErr) + QueryCmdHelpersError helpersErr -> renderHelpersError helpersErr + QueryCmdAcquireFailure acquireFail -> Text.pack $ show acquireFail + QueryCmdByronEra -> "This query cannot be used for the Byron era" + QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) (AnyCardanoEra era) -> + "Consensus mode and era mismatch. Consensus mode: " <> textShow cMode <> + " Era: " <> textShow era + QueryCmdEraMismatch (EraMismatch ledgerEra queryEra) -> + "\nAn error mismatch occurred." <> "\nSpecified query era: " <> queryEra <> + "\nCurrent ledger era: " <> ledgerEra + QueryCmdUnsupportedMode mode -> "Unsupported mode: " <> renderMode mode + QueryCmdPastHorizon e -> "Past horizon: " <> textShow e + QueryCmdSystemStartUnavailable -> "System start unavailable" + QueryCmdGenesisReadError err' -> Text.pack $ displayError err' + QueryCmdLeaderShipError e -> Text.pack $ displayError e + QueryCmdTextEnvelopeReadError e -> Text.pack $ displayError e + QueryCmdTextReadError e -> Text.pack $ displayError e + QueryCmdOpCertCounterReadError e -> Text.pack $ displayError e + QueryCmdProtocolStateDecodeFailure (_, decErr) -> + "Failed to decode the protocol state: " <> toStrict (toLazyText $ build decErr) + QueryCmdPoolStateDecodeError decoderError -> + "Failed to decode PoolState. Error: " <> Text.pack (show decoderError) + QueryCmdStakeSnapshotDecodeError decoderError -> + "Failed to decode StakeSnapshot. Error: " <> Text.pack (show decoderError) + QueryCmdUnsupportedNtcVersion (UnsupportedNtcVersionError minNtcVersion ntcVersion) -> + "Unsupported feature for the node-to-client protocol version.\n" <> + "This query requires at least " <> textShow minNtcVersion <> " but the node negotiated " <> textShow ntcVersion <> ".\n" <> + "Later node versions support later protocol versions (but development protocol versions are not enabled in the node by default)." + QueryCmdProtocolParameterConversionError ppce -> + Text.pack $ "Failed to convert protocol parameter: " <> displayError ppce + QueryCmdConvenienceError qce -> renderQueryConvenienceError qce diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyQueryCmdLocalStateQueryError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/QueryCmdLocalStateQueryError.hs similarity index 71% rename from cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyQueryCmdLocalStateQueryError.hs rename to cardano-cli/src/Cardano/CLI/Types/Errors/QueryCmdLocalStateQueryError.hs index 8b35bb37a9..1e4fec2f8e 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyQueryCmdLocalStateQueryError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/QueryCmdLocalStateQueryError.hs @@ -1,5 +1,5 @@ -module Cardano.CLI.Types.Errors.ShelleyQueryCmdLocalStateQueryError - ( ShelleyQueryCmdLocalStateQueryError(..) +module Cardano.CLI.Types.Errors.QueryCmdLocalStateQueryError + ( QueryCmdLocalStateQueryError(..) , renderLocalStateQueryError ) where @@ -10,13 +10,13 @@ import Ouroboros.Consensus.Cardano.Block (EraMismatch (..)) import Data.Text (Text) -- | An error that can occur while querying a node's local state. -newtype ShelleyQueryCmdLocalStateQueryError +newtype QueryCmdLocalStateQueryError = EraMismatchError EraMismatch -- ^ A query from a certain era was applied to a ledger from a different -- era. deriving (Eq, Show) -renderLocalStateQueryError :: ShelleyQueryCmdLocalStateQueryError -> Text +renderLocalStateQueryError :: QueryCmdLocalStateQueryError -> Text renderLocalStateQueryError lsqErr = case lsqErr of EraMismatchError err -> diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyAddressCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyAddressCmdError.hs deleted file mode 100644 index 2223cab5d5..0000000000 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyAddressCmdError.hs +++ /dev/null @@ -1,44 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module Cardano.CLI.Types.Errors.ShelleyAddressCmdError - ( ShelleyAddressCmdError(..) - , renderShelleyAddressCmdError - ) where - -import Cardano.Api - -import Cardano.CLI.Read -import Cardano.CLI.Types.Errors.ShelleyAddressInfoError -import Cardano.CLI.Types.Key (VerificationKeyTextOrFileError (..), - renderVerificationKeyTextOrFileError) - -import Data.Text (Text) -import qualified Data.Text as Text - -data ShelleyAddressCmdError - = ShelleyAddressCmdAddressInfoError !ShelleyAddressInfoError - | ShelleyAddressCmdReadKeyFileError !(FileError InputDecodeError) - | ShelleyAddressCmdReadScriptFileError !(FileError ScriptDecodeError) - | ShelleyAddressCmdVerificationKeyTextOrFileError !VerificationKeyTextOrFileError - | ShelleyAddressCmdWriteFileError !(FileError ()) - | ShelleyAddressCmdExpectedPaymentVerificationKey SomeAddressVerificationKey - deriving Show - -renderShelleyAddressCmdError :: ShelleyAddressCmdError -> Text -renderShelleyAddressCmdError err = - case err of - ShelleyAddressCmdAddressInfoError addrInfoErr -> - Text.pack (displayError addrInfoErr) - ShelleyAddressCmdReadKeyFileError fileErr -> - Text.pack (displayError fileErr) - ShelleyAddressCmdVerificationKeyTextOrFileError vkTextOrFileErr -> - renderVerificationKeyTextOrFileError vkTextOrFileErr - ShelleyAddressCmdReadScriptFileError fileErr -> - Text.pack (displayError fileErr) - ShelleyAddressCmdWriteFileError fileErr -> Text.pack (displayError fileErr) - ShelleyAddressCmdExpectedPaymentVerificationKey someAddress -> - "Expected payment verification key but got: " <> renderSomeAddressVerificationKey someAddress diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyAddressInfoError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyAddressInfoError.hs deleted file mode 100644 index 1833d06ba5..0000000000 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyAddressInfoError.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Cardano.CLI.Types.Errors.ShelleyAddressInfoError - ( ShelleyAddressInfoError(..) - ) where - -import Cardano.Api - -import Data.Text (Text) - -newtype ShelleyAddressInfoError = ShelleyAddressInvalid Text - deriving Show - -instance Error ShelleyAddressInfoError where - displayError (ShelleyAddressInvalid addrTxt) = - "Invalid address: " <> show addrTxt diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyGenesisCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyGenesisCmdError.hs deleted file mode 100644 index 814a072906..0000000000 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyGenesisCmdError.hs +++ /dev/null @@ -1,92 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE LambdaCase #-} - -module Cardano.CLI.Types.Errors.ShelleyGenesisCmdError - ( ShelleyGenesisCmdError(..) - ) where - -import Cardano.Api - -import Cardano.CLI.Byron.Genesis as Byron -import Cardano.CLI.Orphans () -import Cardano.CLI.Types.Common -import Cardano.CLI.Types.Errors.ShelleyAddressCmdError -import Cardano.CLI.Types.Errors.ShelleyNodeCmdError -import Cardano.CLI.Types.Errors.ShelleyStakeAddressCmdError -import Cardano.CLI.Types.Errors.StakePoolCmdError - -import Control.Exception (IOException) -import Data.Text (Text) -import qualified Data.Text as Text - -data ShelleyGenesisCmdError - = ShelleyGenesisCmdAesonDecodeError !FilePath !Text - | ShelleyGenesisCmdGenesisFileReadError !(FileError IOException) - | ShelleyGenesisCmdGenesisFileDecodeError !FilePath !Text - | ShelleyGenesisCmdGenesisFileError !(FileError ()) - | ShelleyGenesisCmdFileError !(FileError ()) - | ShelleyGenesisCmdMismatchedGenesisKeyFiles [Int] [Int] [Int] - | ShelleyGenesisCmdFilesNoIndex [FilePath] - | ShelleyGenesisCmdFilesDupIndex [FilePath] - | ShelleyGenesisCmdTextEnvReadFileError !(FileError TextEnvelopeError) - | ShelleyGenesisCmdUnexpectedAddressVerificationKey !(VerificationKeyFile In) !Text !SomeAddressVerificationKey - | ShelleyGenesisCmdTooFewPoolsForBulkCreds !Word !Word !Word - | ShelleyGenesisCmdAddressCmdError !ShelleyAddressCmdError - | ShelleyGenesisCmdNodeCmdError !ShelleyNodeCmdError - | ShelleyGenesisCmdStakeAddressCmdError !ShelleyStakeAddressCmdError - | ShelleyGenesisCmdStakePoolCmdError !StakePoolCmdError - | ShelleyGenesisCmdCostModelsError !FilePath - | ShelleyGenesisCmdByronError !ByronGenesisError - | ShelleyGenesisStakePoolRelayFileError !FilePath !IOException - | ShelleyGenesisStakePoolRelayJsonDecodeError !FilePath !String - deriving Show - -instance Error ShelleyGenesisCmdError where - displayError = - \case - ShelleyGenesisCmdAesonDecodeError fp decErr -> - "Error while decoding Shelley genesis at: " <> fp <> " Error: " <> Text.unpack decErr - ShelleyGenesisCmdGenesisFileError fe -> displayError fe - ShelleyGenesisCmdFileError fe -> displayError fe - ShelleyGenesisCmdMismatchedGenesisKeyFiles gfiles dfiles vfiles -> - "Mismatch between the files found:\n" - <> "Genesis key file indexes: " <> show gfiles <> "\n" - <> "Delegate key file indexes: " <> show dfiles <> "\n" - <> "Delegate VRF key file indexes: " <> show vfiles - ShelleyGenesisCmdFilesNoIndex files -> - "The genesis keys files are expected to have a numeric index but these do not:\n" - <> unlines files - ShelleyGenesisCmdFilesDupIndex files -> - "The genesis keys files are expected to have a unique numeric index but these do not:\n" - <> unlines files - ShelleyGenesisCmdTextEnvReadFileError fileErr -> displayError fileErr - ShelleyGenesisCmdUnexpectedAddressVerificationKey (File file) expect got -> mconcat - [ "Unexpected address verification key type in file ", file - , ", expected: ", Text.unpack expect, ", got: ", Text.unpack (renderSomeAddressVerificationKey got) - ] - ShelleyGenesisCmdTooFewPoolsForBulkCreds pools files perPool -> mconcat - [ "Number of pools requested for generation (", show pools - , ") is insufficient to fill ", show files - , " bulk files, with ", show perPool, " pools per file." - ] - ShelleyGenesisCmdAddressCmdError e -> - Text.unpack $ renderShelleyAddressCmdError e - ShelleyGenesisCmdNodeCmdError e -> - Text.unpack $ renderShelleyNodeCmdError e - ShelleyGenesisCmdStakePoolCmdError e -> - Text.unpack $ renderStakePoolCmdError e - ShelleyGenesisCmdStakeAddressCmdError e -> - displayError e - ShelleyGenesisCmdCostModelsError fp -> - "Cost model is invalid: " <> fp - ShelleyGenesisCmdGenesisFileDecodeError fp e -> - "Error while decoding Shelley genesis at: " <> fp <> - " Error: " <> Text.unpack e - ShelleyGenesisCmdGenesisFileReadError e -> displayError e - ShelleyGenesisCmdByronError e -> show e - ShelleyGenesisStakePoolRelayFileError fp e -> - "Error occurred while reading the stake pool relay specification file: " <> fp <> - " Error: " <> show e - ShelleyGenesisStakePoolRelayJsonDecodeError fp e -> - "Error occurred while decoding the stake pool relay specification file: " <> fp <> - " Error: " <> e diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyKeyCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyKeyCmdError.hs deleted file mode 100644 index 232d9f5ad7..0000000000 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyKeyCmdError.hs +++ /dev/null @@ -1,56 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module Cardano.CLI.Types.Errors.ShelleyKeyCmdError - ( ShelleyKeyCmdError(..) - , renderShelleyKeyCmdError - ) where - -import Cardano.Api - -import qualified Cardano.CLI.Byron.Key as Byron -import Cardano.CLI.Types.Errors.CardanoAddressSigningKeyConversionError -import Cardano.CLI.Types.Errors.ItnKeyConversionError -import Cardano.CLI.Types.Key - -import Data.Text (Text) -import qualified Data.Text as Text - -data ShelleyKeyCmdError - = ShelleyKeyCmdReadFileError !(FileError TextEnvelopeError) - | ShelleyKeyCmdReadKeyFileError !(FileError InputDecodeError) - | ShelleyKeyCmdWriteFileError !(FileError ()) - | ShelleyKeyCmdByronKeyFailure !Byron.ByronKeyFailure - | ShelleyKeyCmdByronKeyParseError - !Text - -- ^ Text representation of the parse error. Unfortunately, the actual - -- error type isn't exported. - | ShelleyKeyCmdItnKeyConvError !ItnKeyConversionError - | ShelleyKeyCmdWrongKeyTypeError - | ShelleyKeyCmdCardanoAddressSigningKeyFileError - !(FileError CardanoAddressSigningKeyConversionError) - | ShelleyKeyCmdNonLegacyKey !FilePath - | ShelleyKeyCmdExpectedExtendedVerificationKey SomeAddressVerificationKey - | ShelleyKeyCmdVerificationKeyReadError VerificationKeyTextOrFileError - deriving Show - -renderShelleyKeyCmdError :: ShelleyKeyCmdError -> Text -renderShelleyKeyCmdError err = - case err of - ShelleyKeyCmdReadFileError fileErr -> Text.pack (displayError fileErr) - ShelleyKeyCmdReadKeyFileError fileErr -> Text.pack (displayError fileErr) - ShelleyKeyCmdWriteFileError fileErr -> Text.pack (displayError fileErr) - ShelleyKeyCmdByronKeyFailure e -> Byron.renderByronKeyFailure e - ShelleyKeyCmdByronKeyParseError errTxt -> errTxt - ShelleyKeyCmdItnKeyConvError convErr -> renderConversionError convErr - ShelleyKeyCmdWrongKeyTypeError -> - Text.pack "Please use a signing key file when converting ITN BIP32 or Extended keys" - ShelleyKeyCmdCardanoAddressSigningKeyFileError fileErr -> - Text.pack (displayError fileErr) - ShelleyKeyCmdNonLegacyKey fp -> - "Signing key at: " <> Text.pack fp <> " is not a legacy Byron signing key and should not need to be converted." - ShelleyKeyCmdVerificationKeyReadError e -> renderVerificationKeyTextOrFileError e - ShelleyKeyCmdExpectedExtendedVerificationKey someVerKey -> - "Expected an extended verification key but got: " <> renderSomeAddressVerificationKey someVerKey diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyNodeCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyNodeCmdError.hs deleted file mode 100644 index 5ff06b402e..0000000000 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyNodeCmdError.hs +++ /dev/null @@ -1,41 +0,0 @@ -{-# LANGUAGE DataKinds #-} - -module Cardano.CLI.Types.Errors.ShelleyNodeCmdError - ( ShelleyNodeCmdError(..) - , renderShelleyNodeCmdError - ) where - -import Cardano.Api - -import Data.Text (Text) -import qualified Data.Text as Text - -{- HLINT ignore "Reduce duplication" -} - -data ShelleyNodeCmdError - = ShelleyNodeCmdReadFileError !(FileError TextEnvelopeError) - | ShelleyNodeCmdReadKeyFileError !(FileError InputDecodeError) - | ShelleyNodeCmdWriteFileError !(FileError ()) - | ShelleyNodeCmdOperationalCertificateIssueError !OperationalCertIssueError - | ShelleyNodeCmdVrfSigningKeyCreationError - FilePath - -- ^ Target path - FilePath - -- ^ Temp path - deriving Show - -renderShelleyNodeCmdError :: ShelleyNodeCmdError -> Text -renderShelleyNodeCmdError err = - case err of - ShelleyNodeCmdVrfSigningKeyCreationError targetPath tempPath -> - Text.pack $ "Error creating VRF signing key file. Target path: " <> targetPath - <> " Temporary path: " <> tempPath - - ShelleyNodeCmdReadFileError fileErr -> Text.pack (displayError fileErr) - - ShelleyNodeCmdReadKeyFileError fileErr -> Text.pack (displayError fileErr) - - ShelleyNodeCmdWriteFileError fileErr -> Text.pack (displayError fileErr) - - ShelleyNodeCmdOperationalCertificateIssueError issueErr -> - Text.pack (displayError issueErr) diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyQueryCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyQueryCmdError.hs deleted file mode 100644 index 51a7094084..0000000000 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyQueryCmdError.hs +++ /dev/null @@ -1,93 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module Cardano.CLI.Types.Errors.ShelleyQueryCmdError - ( ShelleyQueryCmdError(..) - , renderShelleyQueryCmdError - ) where - -import Cardano.Api hiding (QueryInShelleyBasedEra (..)) -import Cardano.Api.Shelley hiding (QueryInShelleyBasedEra (..)) - -import Cardano.Binary (DecoderError) -import Cardano.CLI.Helpers (HelpersError (..), renderHelpersError) -import Cardano.CLI.Types.Errors.ShelleyGenesisCmdError -import Cardano.CLI.Types.Errors.ShelleyQueryCmdLocalStateQueryError -import Ouroboros.Consensus.Cardano.Block as Consensus (EraMismatch (..)) -import qualified Ouroboros.Consensus.HardFork.History.Qry as Qry - -import qualified Data.ByteString.Lazy.Char8 as LBS -import Data.Text (Text) -import qualified Data.Text as Text -import Data.Text.Lazy (toStrict) -import Data.Text.Lazy.Builder (toLazyText) -import Formatting.Buildable (build) - -{- HLINT ignore "Move brackets to avoid $" -} -{- HLINT ignore "Redundant flip" -} - -data ShelleyQueryCmdError - = ShelleyQueryCmdLocalStateQueryError !ShelleyQueryCmdLocalStateQueryError - | ShelleyQueryCmdConvenienceError !QueryConvenienceError - | ShelleyQueryCmdWriteFileError !(FileError ()) - | ShelleyQueryCmdHelpersError !HelpersError - | ShelleyQueryCmdAcquireFailure !AcquiringFailure - | ShelleyQueryCmdEraConsensusModeMismatch !AnyConsensusMode !AnyCardanoEra - | ShelleyQueryCmdByronEra - | ShelleyQueryCmdEraMismatch !EraMismatch - | ShelleyQueryCmdUnsupportedMode !AnyConsensusMode - | ShelleyQueryCmdPastHorizon !Qry.PastHorizonException - | ShelleyQueryCmdSystemStartUnavailable - | ShelleyQueryCmdGenesisReadError !ShelleyGenesisCmdError - | ShelleyQueryCmdLeaderShipError !LeadershipError - | ShelleyQueryCmdTextEnvelopeReadError !(FileError TextEnvelopeError) - | ShelleyQueryCmdTextReadError !(FileError InputDecodeError) - | ShelleyQueryCmdOpCertCounterReadError !(FileError TextEnvelopeError) - | ShelleyQueryCmdProtocolStateDecodeFailure !(LBS.ByteString, DecoderError) - | ShelleyQueryCmdPoolStateDecodeError DecoderError - | ShelleyQueryCmdStakeSnapshotDecodeError DecoderError - | ShelleyQueryCmdUnsupportedNtcVersion !UnsupportedNtcVersionError - | ShelleyQueryCmdProtocolParameterConversionError !ProtocolParametersConversionError - deriving Show - -renderShelleyQueryCmdError :: ShelleyQueryCmdError -> Text -renderShelleyQueryCmdError err = - case err of - ShelleyQueryCmdLocalStateQueryError lsqErr -> renderLocalStateQueryError lsqErr - ShelleyQueryCmdWriteFileError fileErr -> Text.pack (displayError fileErr) - ShelleyQueryCmdHelpersError helpersErr -> renderHelpersError helpersErr - ShelleyQueryCmdAcquireFailure acquireFail -> Text.pack $ show acquireFail - ShelleyQueryCmdByronEra -> "This query cannot be used for the Byron era" - ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) (AnyCardanoEra era) -> - "Consensus mode and era mismatch. Consensus mode: " <> textShow cMode <> - " Era: " <> textShow era - ShelleyQueryCmdEraMismatch (EraMismatch ledgerEra queryEra) -> - "\nAn error mismatch occurred." <> "\nSpecified query era: " <> queryEra <> - "\nCurrent ledger era: " <> ledgerEra - ShelleyQueryCmdUnsupportedMode mode -> "Unsupported mode: " <> renderMode mode - ShelleyQueryCmdPastHorizon e -> "Past horizon: " <> textShow e - ShelleyQueryCmdSystemStartUnavailable -> "System start unavailable" - ShelleyQueryCmdGenesisReadError err' -> Text.pack $ displayError err' - ShelleyQueryCmdLeaderShipError e -> Text.pack $ displayError e - ShelleyQueryCmdTextEnvelopeReadError e -> Text.pack $ displayError e - ShelleyQueryCmdTextReadError e -> Text.pack $ displayError e - ShelleyQueryCmdOpCertCounterReadError e -> Text.pack $ displayError e - ShelleyQueryCmdProtocolStateDecodeFailure (_, decErr) -> - "Failed to decode the protocol state: " <> toStrict (toLazyText $ build decErr) - ShelleyQueryCmdPoolStateDecodeError decoderError -> - "Failed to decode PoolState. Error: " <> Text.pack (show decoderError) - ShelleyQueryCmdStakeSnapshotDecodeError decoderError -> - "Failed to decode StakeSnapshot. Error: " <> Text.pack (show decoderError) - ShelleyQueryCmdUnsupportedNtcVersion (UnsupportedNtcVersionError minNtcVersion ntcVersion) -> - "Unsupported feature for the node-to-client protocol version.\n" <> - "This query requires at least " <> textShow minNtcVersion <> " but the node negotiated " <> textShow ntcVersion <> ".\n" <> - "Later node versions support later protocol versions (but development protocol versions are not enabled in the node by default)." - ShelleyQueryCmdProtocolParameterConversionError ppce -> - Text.pack $ "Failed to convert protocol parameter: " <> displayError ppce - ShelleyQueryCmdConvenienceError qce -> renderQueryConvenienceError qce diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyStakeAddressCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyStakeAddressCmdError.hs deleted file mode 100644 index 1450448df3..0000000000 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyStakeAddressCmdError.hs +++ /dev/null @@ -1,30 +0,0 @@ -{-# LANGUAGE LambdaCase #-} - -module Cardano.CLI.Types.Errors.ShelleyStakeAddressCmdError - ( ShelleyStakeAddressCmdError(..) - ) where - -import Cardano.Api - -import Cardano.CLI.Types.Errors.ScriptDecodeError -import Cardano.CLI.Types.Errors.StakeAddressRegistrationError -import Cardano.CLI.Types.Errors.StakeCredentialError -import Cardano.CLI.Types.Errors.DelegationError - -data ShelleyStakeAddressCmdError - = ShelleyStakeAddressCmdReadKeyFileError !(FileError InputDecodeError) - | ShelleyStakeAddressCmdReadScriptFileError !(FileError ScriptDecodeError) - | ShelleyStakeAddressCmdStakeCredentialError !StakeCredentialError - | ShelleyStakeAddressCmdWriteFileError !(FileError ()) - | StakeAddressDelegationError !DelegationError - | StakeRegistrationError !StakeAddressRegistrationError - deriving Show - -instance Error ShelleyStakeAddressCmdError where - displayError = \case - ShelleyStakeAddressCmdReadKeyFileError e -> displayError e - ShelleyStakeAddressCmdReadScriptFileError e -> displayError e - ShelleyStakeAddressCmdStakeCredentialError e -> displayError e - ShelleyStakeAddressCmdWriteFileError e -> displayError e - StakeAddressDelegationError e -> displayError e - StakeRegistrationError e -> displayError e diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyTxCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyTxCmdError.hs deleted file mode 100644 index aa5990b3a1..0000000000 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyTxCmdError.hs +++ /dev/null @@ -1,212 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module Cardano.CLI.Types.Errors.ShelleyTxCmdError - ( ShelleyTxCmdError(..) - , renderShelleyTxCmdError - ) where - -import Cardano.Api -import Cardano.Api.Shelley - -import Cardano.CLI.Read -import Cardano.CLI.Types.Common -import Cardano.CLI.Types.Errors.ProtocolParamsError -import Cardano.CLI.Types.Errors.ShelleyBootstrapWitnessError -import Cardano.CLI.Types.Errors.TxValidationError -import Cardano.CLI.Types.Output -import Cardano.CLI.Types.TxFeature -import Ouroboros.Consensus.Cardano.Block (EraMismatch (..)) - -import Data.Text (Text) -import qualified Data.Text as Text - -{- HLINT ignore "Use let" -} - -data ShelleyTxCmdError - = ShelleyTxCmdMetadataError MetadataError - | ShelleyTxCmdVoteError VoteError - | ShelleyTxCmdConstitutionError ConstitutionError - | ShelleyTxCmdScriptWitnessError ScriptWitnessError - | ShelleyTxCmdProtocolParamsError ProtocolParamsError - | ShelleyTxCmdScriptFileError (FileError ScriptDecodeError) - | ShelleyTxCmdReadTextViewFileError !(FileError TextEnvelopeError) - | ShelleyTxCmdReadWitnessSigningDataError !ReadWitnessSigningDataError - | ShelleyTxCmdWriteFileError !(FileError ()) - | ShelleyTxCmdEraConsensusModeMismatch - !(Maybe FilePath) - !AnyConsensusMode - !AnyCardanoEra - -- ^ Era - | ShelleyTxCmdBootstrapWitnessError !ShelleyBootstrapWitnessError - | ShelleyTxCmdTxSubmitError !Text - | ShelleyTxCmdTxSubmitErrorEraMismatch !EraMismatch - | ShelleyTxCmdTxFeatureMismatch !AnyCardanoEra !TxFeature - | ShelleyTxCmdTxBodyError !TxBodyError - | ShelleyTxCmdNotImplemented !Text - | ShelleyTxCmdWitnessEraMismatch !AnyCardanoEra !AnyCardanoEra !WitnessFile - | ShelleyTxCmdPolicyIdsMissing ![PolicyId] - | ShelleyTxCmdPolicyIdsExcess ![PolicyId] - | ShelleyTxCmdUnsupportedMode !AnyConsensusMode - | ShelleyTxCmdByronEra - | ShelleyTxCmdEraConsensusModeMismatchTxBalance - !TxBuildOutputOptions - !AnyConsensusMode - !AnyCardanoEra - | ShelleyTxCmdBalanceTxBody !TxBodyErrorAutoBalance - | ShelleyTxCmdTxInsDoNotExist !TxInsExistError - | ShelleyTxCmdPParamsErr !ProtocolParametersError - | ShelleyTxCmdTextEnvCddlError - !(FileError TextEnvelopeError) - !(FileError TextEnvelopeCddlError) - | ShelleyTxCmdTxExecUnitsErr !TransactionValidityError - | ShelleyTxCmdPlutusScriptCostErr !PlutusScriptCostError - | ShelleyTxCmdPParamExecutionUnitsNotAvailable - | ShelleyTxCmdPlutusScriptsRequireCardanoMode - | ShelleyTxCmdProtocolParametersNotPresentInTxBody - | ShelleyTxCmdTxEraCastErr EraCastError - | ShelleyTxCmdQueryConvenienceError !QueryConvenienceError - | ShelleyTxCmdQueryNotScriptLocked !ScriptLockedTxInsError - | ShelleyTxCmdScriptDataError !ScriptDataError - | ShelleyTxCmdCddlError CddlError - | ShelleyTxCmdCddlWitnessError CddlWitnessError - | ShelleyTxCmdRequiredSignerError RequiredSignerError - -- Validation errors - | ShelleyTxCmdAuxScriptsValidationError TxAuxScriptsValidationError - | ShelleyTxCmdTotalCollateralValidationError TxTotalCollateralValidationError - | ShelleyTxCmdReturnCollateralValidationError TxReturnCollateralValidationError - | ShelleyTxCmdTxFeeValidationError TxFeeValidationError - | ShelleyTxCmdTxValidityLowerBoundValidationError TxValidityLowerBoundValidationError - | ShelleyTxCmdTxValidityUpperBoundValidationError TxValidityUpperBoundValidationError - | ShelleyTxCmdRequiredSignersValidationError TxRequiredSignersValidationError - | ShelleyTxCmdProtocolParametersValidationError TxProtocolParametersValidationError - | ShelleyTxCmdTxWithdrawalsValidationError TxWithdrawalsValidationError - | ShelleyTxCmdTxCertificatesValidationError TxCertificatesValidationError - | ShelleyTxCmdTxUpdateProposalValidationError TxUpdateProposalValidationError - | ShelleyTxCmdScriptValidityValidationError TxScriptValidityValidationError - | ShelleyTxCmdProtocolParamsConverstionError ProtocolParametersConversionError - -renderShelleyTxCmdError :: ShelleyTxCmdError -> Text -renderShelleyTxCmdError err = - case err of - ShelleyTxCmdProtocolParamsConverstionError err' -> - "Error while converting protocol parameters: " <> Text.pack (displayError err') - ShelleyTxCmdVoteError voteErr -> Text.pack $ show voteErr - ShelleyTxCmdConstitutionError constErr -> Text.pack $ show constErr - ShelleyTxCmdReadTextViewFileError fileErr -> Text.pack (displayError fileErr) - ShelleyTxCmdScriptFileError fileErr -> Text.pack (displayError fileErr) - ShelleyTxCmdReadWitnessSigningDataError witSignDataErr -> - renderReadWitnessSigningDataError witSignDataErr - ShelleyTxCmdWriteFileError fileErr -> Text.pack (displayError fileErr) - ShelleyTxCmdTxSubmitError res -> "Error while submitting tx: " <> res - ShelleyTxCmdTxSubmitErrorEraMismatch EraMismatch{ledgerEraName, otherEraName} -> - "The era of the node and the tx do not match. " <> - "The node is running in the " <> ledgerEraName <> - " era, but the transaction is for the " <> otherEraName <> " era." - ShelleyTxCmdBootstrapWitnessError sbwErr -> - renderShelleyBootstrapWitnessError sbwErr - ShelleyTxCmdTxFeatureMismatch era TxFeatureImplicitFees -> - "An explicit transaction fee must be specified for " <> - renderEra era <> " era transactions." - - ShelleyTxCmdTxFeatureMismatch (AnyCardanoEra ShelleyEra) - TxFeatureValidityNoUpperBound -> - "A TTL must be specified for Shelley era transactions." - - ShelleyTxCmdTxFeatureMismatch era feature -> - renderFeature feature <> " cannot be used for " <> renderEra era <> - " era transactions." - - ShelleyTxCmdTxBodyError err' -> - "Transaction validaton error: " <> Text.pack (displayError err') - - ShelleyTxCmdNotImplemented msg -> - "Feature not yet implemented: " <> msg - - ShelleyTxCmdWitnessEraMismatch era era' (WitnessFile file) -> - "The era of a witness does not match the era of the transaction. " <> - "The transaction is for the " <> renderEra era <> " era, but the " <> - "witness in " <> textShow file <> " is for the " <> renderEra era' <> " era." - - ShelleyTxCmdEraConsensusModeMismatch fp mode era -> - "Submitting " <> renderEra era <> " era transaction (" <> textShow fp <> - ") is not supported in the " <> renderMode mode <> " consensus mode." - ShelleyTxCmdPolicyIdsMissing policyids -> mconcat - [ "The \"--mint\" flag specifies an asset with a policy Id, but no " - , "corresponding monetary policy script has been provided as a witness " - , "(via the \"--mint-script-file\" flag). The policy Id in question is: " - , Text.intercalate ", " (map serialiseToRawBytesHexText policyids) - ] - - ShelleyTxCmdPolicyIdsExcess policyids -> mconcat - [ "A script provided to witness minting does not correspond to the policy " - , "id of any asset specified in the \"--mint\" field. The script hash is: " - , Text.intercalate ", " (map serialiseToRawBytesHexText policyids) - ] - ShelleyTxCmdUnsupportedMode mode -> "Unsupported mode: " <> renderMode mode - ShelleyTxCmdByronEra -> "This query cannot be used for the Byron era" - ShelleyTxCmdEraConsensusModeMismatchTxBalance fp mode era -> - "Cannot balance " <> renderEra era <> " era transaction body (" <> textShow fp <> - ") because is not supported in the " <> renderMode mode <> " consensus mode." - ShelleyTxCmdBalanceTxBody err' -> Text.pack $ displayError err' - ShelleyTxCmdTxInsDoNotExist e -> - renderTxInsExistError e - ShelleyTxCmdPParamsErr err' -> Text.pack $ displayError err' - ShelleyTxCmdTextEnvCddlError textEnvErr cddlErr -> mconcat - [ "Failed to decode neither the cli's serialisation format nor the ledger's " - , "CDDL serialisation format. TextEnvelope error: " <> Text.pack (displayError textEnvErr) <> "\n" - , "TextEnvelopeCddl error: " <> Text.pack (displayError cddlErr) - ] - ShelleyTxCmdTxExecUnitsErr err' -> Text.pack $ displayError err' - ShelleyTxCmdPlutusScriptCostErr err'-> Text.pack $ displayError err' - ShelleyTxCmdPParamExecutionUnitsNotAvailable -> mconcat - [ "Execution units not available in the protocol parameters. This is " - , "likely due to not being in the Alonzo era" - ] - ShelleyTxCmdTxEraCastErr (EraCastError value fromEra toEra) -> - "Transactions can only be produced in the same era as the node. Mismatched eras of " - <> textShow value <> ". Requested era: " <> renderEra (AnyCardanoEra toEra) <> ", node era: " <> renderEra (AnyCardanoEra fromEra) <> "." - ShelleyTxCmdQueryConvenienceError e -> - renderQueryConvenienceError e - ShelleyTxCmdQueryNotScriptLocked e -> - renderNotScriptLockedTxInsError e - ShelleyTxCmdPlutusScriptsRequireCardanoMode -> - "Plutus scripts are only available in CardanoMode" - ShelleyTxCmdProtocolParametersNotPresentInTxBody -> - "Protocol parameters were not found in transaction body" - ShelleyTxCmdMetadataError e -> renderMetadataError e - ShelleyTxCmdScriptWitnessError e -> renderScriptWitnessError e - ShelleyTxCmdScriptDataError e -> renderScriptDataError e - ShelleyTxCmdProtocolParamsError e -> renderProtocolParamsError e - ShelleyTxCmdCddlError e -> Text.pack $ displayError e - ShelleyTxCmdCddlWitnessError e -> Text.pack $ displayError e - ShelleyTxCmdRequiredSignerError e -> Text.pack $ displayError e - -- Validation errors - ShelleyTxCmdAuxScriptsValidationError e -> - Text.pack $ displayError e - ShelleyTxCmdTotalCollateralValidationError e -> - Text.pack $ displayError e - ShelleyTxCmdReturnCollateralValidationError e -> - Text.pack $ displayError e - ShelleyTxCmdTxFeeValidationError e -> - Text.pack $ displayError e - ShelleyTxCmdTxValidityLowerBoundValidationError e -> - Text.pack $ displayError e - ShelleyTxCmdTxValidityUpperBoundValidationError e -> - Text.pack $ displayError e - ShelleyTxCmdRequiredSignersValidationError e -> - Text.pack $ displayError e - ShelleyTxCmdProtocolParametersValidationError e -> - Text.pack $ displayError e - ShelleyTxCmdTxWithdrawalsValidationError e -> - Text.pack $ displayError e - ShelleyTxCmdTxCertificatesValidationError e -> - Text.pack $ displayError e - ShelleyTxCmdTxUpdateProposalValidationError e -> - Text.pack $ displayError e - ShelleyTxCmdScriptValidityValidationError e -> - Text.pack $ displayError e diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/StakeAddressCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/StakeAddressCmdError.hs new file mode 100644 index 0000000000..f0abec87c2 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/StakeAddressCmdError.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE LambdaCase #-} + +module Cardano.CLI.Types.Errors.StakeAddressCmdError + ( StakeAddressCmdError(..) + ) where + +import Cardano.Api + +import Cardano.CLI.Types.Errors.ScriptDecodeError +import Cardano.CLI.Types.Errors.StakeAddressRegistrationError +import Cardano.CLI.Types.Errors.StakeCredentialError +import Cardano.CLI.Types.Errors.DelegationError + +data StakeAddressCmdError + = StakeAddressCmdReadKeyFileError !(FileError InputDecodeError) + | StakeAddressCmdReadScriptFileError !(FileError ScriptDecodeError) + | StakeAddressCmdStakeCredentialError !StakeCredentialError + | StakeAddressCmdWriteFileError !(FileError ()) + | StakeAddressCmdDelegationError !DelegationError + | StakeAddressCmdRegistrationError !StakeAddressRegistrationError + deriving Show + +instance Error StakeAddressCmdError where + displayError = \case + StakeAddressCmdReadKeyFileError e -> displayError e + StakeAddressCmdReadScriptFileError e -> displayError e + StakeAddressCmdStakeCredentialError e -> displayError e + StakeAddressCmdWriteFileError e -> displayError e + StakeAddressCmdDelegationError e -> displayError e + StakeAddressCmdRegistrationError e -> displayError e diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyTextViewFileError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/TextViewFileError.hs similarity index 67% rename from cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyTextViewFileError.hs rename to cardano-cli/src/Cardano/CLI/Types/Errors/TextViewFileError.hs index aee27de3ec..e3ecd15b7c 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/ShelleyTextViewFileError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/TextViewFileError.hs @@ -1,8 +1,8 @@ {-# LANGUAGE DataKinds #-} -module Cardano.CLI.Types.Errors.ShelleyTextViewFileError - ( ShelleyTextViewFileError(..) - , renderShelleyTextViewFileError +module Cardano.CLI.Types.Errors.TextViewFileError + ( TextViewFileError(..) + , renderTextViewFileError ) where import Cardano.Api @@ -12,13 +12,13 @@ import Cardano.CLI.Helpers (HelpersError, renderHelpersError) import Data.Text (Text) import qualified Data.Text as Text -data ShelleyTextViewFileError +data TextViewFileError = TextViewReadFileError (FileError TextEnvelopeError) | TextViewCBORPrettyPrintError !HelpersError deriving Show -renderShelleyTextViewFileError :: ShelleyTextViewFileError -> Text -renderShelleyTextViewFileError err = +renderTextViewFileError :: TextViewFileError -> Text +renderTextViewFileError err = case err of TextViewReadFileError fileErr -> Text.pack (displayError fileErr) TextViewCBORPrettyPrintError hlprsErr -> diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs new file mode 100644 index 0000000000..98af501e7e --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs @@ -0,0 +1,212 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Cardano.CLI.Types.Errors.TxCmdError + ( TxCmdError(..) + , renderTxCmdError + ) where + +import Cardano.Api +import Cardano.Api.Shelley + +import Cardano.CLI.Read +import Cardano.CLI.Types.Common +import Cardano.CLI.Types.Errors.ProtocolParamsError +import Cardano.CLI.Types.Errors.BootstrapWitnessError +import Cardano.CLI.Types.Errors.TxValidationError +import Cardano.CLI.Types.Output +import Cardano.CLI.Types.TxFeature +import Ouroboros.Consensus.Cardano.Block (EraMismatch (..)) + +import Data.Text (Text) +import qualified Data.Text as Text + +{- HLINT ignore "Use let" -} + +data TxCmdError + = TxCmdMetadataError MetadataError + | TxCmdVoteError VoteError + | TxCmdConstitutionError ConstitutionError + | TxCmdScriptWitnessError ScriptWitnessError + | TxCmdProtocolParamsError ProtocolParamsError + | TxCmdScriptFileError (FileError ScriptDecodeError) + | TxCmdReadTextViewFileError !(FileError TextEnvelopeError) + | TxCmdReadWitnessSigningDataError !ReadWitnessSigningDataError + | TxCmdWriteFileError !(FileError ()) + | TxCmdEraConsensusModeMismatch + !(Maybe FilePath) + !AnyConsensusMode + !AnyCardanoEra + -- ^ Era + | TxCmdBootstrapWitnessError !BootstrapWitnessError + | TxCmdTxSubmitError !Text + | TxCmdTxSubmitErrorEraMismatch !EraMismatch + | TxCmdTxFeatureMismatch !AnyCardanoEra !TxFeature + | TxCmdTxBodyError !TxBodyError + | TxCmdNotImplemented !Text + | TxCmdWitnessEraMismatch !AnyCardanoEra !AnyCardanoEra !WitnessFile + | TxCmdPolicyIdsMissing ![PolicyId] + | TxCmdPolicyIdsExcess ![PolicyId] + | TxCmdUnsupportedMode !AnyConsensusMode + | TxCmdByronEra + | TxCmdEraConsensusModeMismatchTxBalance + !TxBuildOutputOptions + !AnyConsensusMode + !AnyCardanoEra + | TxCmdBalanceTxBody !TxBodyErrorAutoBalance + | TxCmdTxInsDoNotExist !TxInsExistError + | TxCmdPParamsErr !ProtocolParametersError + | TxCmdTextEnvCddlError + !(FileError TextEnvelopeError) + !(FileError TextEnvelopeCddlError) + | TxCmdTxExecUnitsErr !TransactionValidityError + | TxCmdPlutusScriptCostErr !PlutusScriptCostError + | TxCmdPParamExecutionUnitsNotAvailable + | TxCmdPlutusScriptsRequireCardanoMode + | TxCmdProtocolParametersNotPresentInTxBody + | TxCmdTxEraCastErr EraCastError + | TxCmdQueryConvenienceError !QueryConvenienceError + | TxCmdQueryNotScriptLocked !ScriptLockedTxInsError + | TxCmdScriptDataError !ScriptDataError + | TxCmdCddlError CddlError + | TxCmdCddlWitnessError CddlWitnessError + | TxCmdRequiredSignerError RequiredSignerError + -- Validation errors + | TxCmdAuxScriptsValidationError TxAuxScriptsValidationError + | TxCmdTotalCollateralValidationError TxTotalCollateralValidationError + | TxCmdReturnCollateralValidationError TxReturnCollateralValidationError + | TxCmdTxFeeValidationError TxFeeValidationError + | TxCmdTxValidityLowerBoundValidationError TxValidityLowerBoundValidationError + | TxCmdTxValidityUpperBoundValidationError TxValidityUpperBoundValidationError + | TxCmdRequiredSignersValidationError TxRequiredSignersValidationError + | TxCmdProtocolParametersValidationError TxProtocolParametersValidationError + | TxCmdTxWithdrawalsValidationError TxWithdrawalsValidationError + | TxCmdTxCertificatesValidationError TxCertificatesValidationError + | TxCmdTxUpdateProposalValidationError TxUpdateProposalValidationError + | TxCmdScriptValidityValidationError TxScriptValidityValidationError + | TxCmdProtocolParamsConverstionError ProtocolParametersConversionError + +renderTxCmdError :: TxCmdError -> Text +renderTxCmdError err = + case err of + TxCmdProtocolParamsConverstionError err' -> + "Error while converting protocol parameters: " <> Text.pack (displayError err') + TxCmdVoteError voteErr -> Text.pack $ show voteErr + TxCmdConstitutionError constErr -> Text.pack $ show constErr + TxCmdReadTextViewFileError fileErr -> Text.pack (displayError fileErr) + TxCmdScriptFileError fileErr -> Text.pack (displayError fileErr) + TxCmdReadWitnessSigningDataError witSignDataErr -> + renderReadWitnessSigningDataError witSignDataErr + TxCmdWriteFileError fileErr -> Text.pack (displayError fileErr) + TxCmdTxSubmitError res -> "Error while submitting tx: " <> res + TxCmdTxSubmitErrorEraMismatch EraMismatch{ledgerEraName, otherEraName} -> + "The era of the node and the tx do not match. " <> + "The node is running in the " <> ledgerEraName <> + " era, but the transaction is for the " <> otherEraName <> " era." + TxCmdBootstrapWitnessError sbwErr -> + renderBootstrapWitnessError sbwErr + TxCmdTxFeatureMismatch era TxFeatureImplicitFees -> + "An explicit transaction fee must be specified for " <> + renderEra era <> " era transactions." + + TxCmdTxFeatureMismatch (AnyCardanoEra ShelleyEra) + TxFeatureValidityNoUpperBound -> + "A TTL must be specified for Shelley era transactions." + + TxCmdTxFeatureMismatch era feature -> + renderFeature feature <> " cannot be used for " <> renderEra era <> + " era transactions." + + TxCmdTxBodyError err' -> + "Transaction validaton error: " <> Text.pack (displayError err') + + TxCmdNotImplemented msg -> + "Feature not yet implemented: " <> msg + + TxCmdWitnessEraMismatch era era' (WitnessFile file) -> + "The era of a witness does not match the era of the transaction. " <> + "The transaction is for the " <> renderEra era <> " era, but the " <> + "witness in " <> textShow file <> " is for the " <> renderEra era' <> " era." + + TxCmdEraConsensusModeMismatch fp mode era -> + "Submitting " <> renderEra era <> " era transaction (" <> textShow fp <> + ") is not supported in the " <> renderMode mode <> " consensus mode." + TxCmdPolicyIdsMissing policyids -> mconcat + [ "The \"--mint\" flag specifies an asset with a policy Id, but no " + , "corresponding monetary policy script has been provided as a witness " + , "(via the \"--mint-script-file\" flag). The policy Id in question is: " + , Text.intercalate ", " (map serialiseToRawBytesHexText policyids) + ] + + TxCmdPolicyIdsExcess policyids -> mconcat + [ "A script provided to witness minting does not correspond to the policy " + , "id of any asset specified in the \"--mint\" field. The script hash is: " + , Text.intercalate ", " (map serialiseToRawBytesHexText policyids) + ] + TxCmdUnsupportedMode mode -> "Unsupported mode: " <> renderMode mode + TxCmdByronEra -> "This query cannot be used for the Byron era" + TxCmdEraConsensusModeMismatchTxBalance fp mode era -> + "Cannot balance " <> renderEra era <> " era transaction body (" <> textShow fp <> + ") because is not supported in the " <> renderMode mode <> " consensus mode." + TxCmdBalanceTxBody err' -> Text.pack $ displayError err' + TxCmdTxInsDoNotExist e -> + renderTxInsExistError e + TxCmdPParamsErr err' -> Text.pack $ displayError err' + TxCmdTextEnvCddlError textEnvErr cddlErr -> mconcat + [ "Failed to decode neither the cli's serialisation format nor the ledger's " + , "CDDL serialisation format. TextEnvelope error: " <> Text.pack (displayError textEnvErr) <> "\n" + , "TextEnvelopeCddl error: " <> Text.pack (displayError cddlErr) + ] + TxCmdTxExecUnitsErr err' -> Text.pack $ displayError err' + TxCmdPlutusScriptCostErr err'-> Text.pack $ displayError err' + TxCmdPParamExecutionUnitsNotAvailable -> mconcat + [ "Execution units not available in the protocol parameters. This is " + , "likely due to not being in the Alonzo era" + ] + TxCmdTxEraCastErr (EraCastError value fromEra toEra) -> + "Transactions can only be produced in the same era as the node. Mismatched eras of " + <> textShow value <> ". Requested era: " <> renderEra (AnyCardanoEra toEra) <> ", node era: " <> renderEra (AnyCardanoEra fromEra) <> "." + TxCmdQueryConvenienceError e -> + renderQueryConvenienceError e + TxCmdQueryNotScriptLocked e -> + renderNotScriptLockedTxInsError e + TxCmdPlutusScriptsRequireCardanoMode -> + "Plutus scripts are only available in CardanoMode" + TxCmdProtocolParametersNotPresentInTxBody -> + "Protocol parameters were not found in transaction body" + TxCmdMetadataError e -> renderMetadataError e + TxCmdScriptWitnessError e -> renderScriptWitnessError e + TxCmdScriptDataError e -> renderScriptDataError e + TxCmdProtocolParamsError e -> renderProtocolParamsError e + TxCmdCddlError e -> Text.pack $ displayError e + TxCmdCddlWitnessError e -> Text.pack $ displayError e + TxCmdRequiredSignerError e -> Text.pack $ displayError e + -- Validation errors + TxCmdAuxScriptsValidationError e -> + Text.pack $ displayError e + TxCmdTotalCollateralValidationError e -> + Text.pack $ displayError e + TxCmdReturnCollateralValidationError e -> + Text.pack $ displayError e + TxCmdTxFeeValidationError e -> + Text.pack $ displayError e + TxCmdTxValidityLowerBoundValidationError e -> + Text.pack $ displayError e + TxCmdTxValidityUpperBoundValidationError e -> + Text.pack $ displayError e + TxCmdRequiredSignersValidationError e -> + Text.pack $ displayError e + TxCmdProtocolParametersValidationError e -> + Text.pack $ displayError e + TxCmdTxWithdrawalsValidationError e -> + Text.pack $ displayError e + TxCmdTxCertificatesValidationError e -> + Text.pack $ displayError e + TxCmdTxUpdateProposalValidationError e -> + Text.pack $ displayError e + TxCmdScriptValidityValidationError e -> + Text.pack $ displayError e diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/ErrorsSpec.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/ErrorsSpec.hs index b14720543f..d23d19ce63 100644 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/ErrorsSpec.hs +++ b/cardano-cli/test/cardano-cli-golden/Test/Golden/ErrorsSpec.hs @@ -20,7 +20,7 @@ import Cardano.CLI.Types.Errors.DelegationError import Cardano.CLI.Types.Errors.GovernanceCmdError import Cardano.CLI.Types.Errors.GovernanceVoteCmdError import Cardano.CLI.Types.Errors.RegistrationError -import Cardano.CLI.Types.Errors.ShelleyStakeAddressCmdError +import Cardano.CLI.Types.Errors.StakeAddressCmdError import Cardano.CLI.Types.Errors.StakeAddressRegistrationError import Cardano.CLI.Types.Errors.StakeCredentialError @@ -35,7 +35,7 @@ test_GovernanceCmdError = testErrorMessagesRendering "Cardano.CLI.Types.Errors.GovernanceCmdError" "GovernanceCmdError" [ ("StakeCredGovCmdError" , StakeCredGovCmdError - . ShelleyStakeAddressCmdReadKeyFileError + . StakeAddressCmdReadKeyFileError $ FileError "path/file.txt" InputInvalidError) , ("VotingCredentialDecodeGovCmdEror" , VotingCredentialDecodeGovCmdEror $ DecoderErrorEmptyList "emptylist")