diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run.hs index 16a27ff86d..f7a3a1405a 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run.hs @@ -22,13 +22,13 @@ import Control.Monad.Trans.Except.Extra (firstExceptT) runLegacyCmds :: LegacyCmds -> ExceptT CmdError IO () runLegacyCmds = \case - LegacyAddressCmds cmd -> firstExceptT CmdAddressError $ runAddressCmds cmd - LegacyGenesisCmds cmd -> firstExceptT CmdGenesisError $ runGenesisCmds cmd + LegacyAddressCmds cmd -> firstExceptT CmdAddressError $ runLegacyAddressCmds cmd + LegacyGenesisCmds cmd -> firstExceptT CmdGenesisError $ runLegacyGenesisCmds cmd LegacyGovernanceCmds cmd -> firstExceptT CmdGovernanceCmdError $ runLegacyGovernanceCmds cmd - LegacyKeyCmds cmd -> firstExceptT CmdKeyError $ runKeyCmds cmd - LegacyNodeCmds cmd -> firstExceptT CmdNodeError $ runNodeCmds cmd - LegacyPoolCmds cmd -> firstExceptT CmdPoolError $ runPoolCmds cmd - LegacyQueryCmds cmd -> firstExceptT CmdQueryError $ runQueryCmds cmd - LegacyStakeAddressCmds cmd -> firstExceptT CmdStakeAddressError $ runStakeAddressCmds cmd - LegacyTextViewCmds cmd -> firstExceptT CmdTextViewError $ runTextViewCmds cmd - LegacyTransactionCmds cmd -> firstExceptT CmdTransactionError $ runTransactionCmds cmd + LegacyKeyCmds cmd -> firstExceptT CmdKeyError $ runLegacyKeyCmds cmd + LegacyNodeCmds cmd -> firstExceptT CmdNodeError $ runLegacyNodeCmds cmd + LegacyPoolCmds cmd -> firstExceptT CmdPoolError $ runLegacyPoolCmds cmd + LegacyQueryCmds cmd -> firstExceptT CmdQueryError $ runLegacyQueryCmds cmd + LegacyStakeAddressCmds cmd -> firstExceptT CmdStakeAddressError $ runLegacyStakeAddressCmds cmd + LegacyTextViewCmds cmd -> firstExceptT CmdTextViewError $ runLegacyTextViewCmds cmd + LegacyTransactionCmds cmd -> firstExceptT CmdTransactionError $ runLegacyTransactionCmds cmd diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Address.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Address.hs index c87d0d36cd..fda5ced325 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Address.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Address.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -8,8 +9,7 @@ module Cardano.CLI.Legacy.Run.Address ( SomeAddressVerificationKey(..) , buildShelleyAddress , renderShelleyAddressCmdError - , runAddressCmds - , runAddressKeyGenToFile + , runLegacyAddressCmds , makeStakeAddressRef ) where @@ -17,7 +17,7 @@ import Cardano.Api import Cardano.Api.Shelley import Cardano.CLI.Legacy.Commands.Address -import Cardano.CLI.Legacy.Run.Address.Info (runAddressInfo) +import Cardano.CLI.Legacy.Run.Address.Info (runLegacyAddressInfoCmd) import Cardano.CLI.Read import Cardano.CLI.Types.Key (PaymentVerifier (..), StakeIdentifier (..), StakeVerifier (..), VerificationKeyTextOrFile, generateKeyPair, readVerificationKeyOrFile, @@ -31,21 +31,24 @@ import Control.Monad.Trans.Except.Extra (firstExceptT, left, newExcept import qualified Data.ByteString.Char8 as BS import qualified Data.Text.IO as Text -runAddressCmds :: LegacyAddressCmds -> ExceptT ShelleyAddressCmdError IO () -runAddressCmds cmd = - case cmd of - AddressKeyGen fmt kt vkf skf -> runAddressKeyGenToFile fmt kt vkf skf - AddressKeyHash vkf mOFp -> runAddressKeyHash vkf mOFp - AddressBuild paymentVerifier mbStakeVerifier nw mOutFp -> runAddressBuild paymentVerifier mbStakeVerifier nw mOutFp - AddressInfo txt mOFp -> firstExceptT ShelleyAddressCmdAddressInfoError $ runAddressInfo txt mOFp - -runAddressKeyGenToFile +runLegacyAddressCmds :: LegacyAddressCmds -> ExceptT ShelleyAddressCmdError IO () +runLegacyAddressCmds = \case + AddressKeyGen fmt kt vkf skf -> + runLegacyAddressKeyGenCmd fmt kt vkf skf + AddressKeyHash vkf mOFp -> + runLegacyAddressKeyHashCmd vkf mOFp + AddressBuild paymentVerifier mbStakeVerifier nw mOutFp -> + runLegacyAddressBuildCmd paymentVerifier mbStakeVerifier nw mOutFp + AddressInfo txt mOFp -> + firstExceptT ShelleyAddressCmdAddressInfoError $ runLegacyAddressInfoCmd txt mOFp + +runLegacyAddressKeyGenCmd :: KeyOutputFormat -> AddressKeyType -> VerificationKeyFile Out -> SigningKeyFile Out -> ExceptT ShelleyAddressCmdError IO () -runAddressKeyGenToFile fmt kt vkf skf = case kt of +runLegacyAddressKeyGenCmd fmt kt vkf skf = case kt of AddressKeyShelley -> generateAndWriteKeyFiles fmt AsPaymentKey vkf skf AddressKeyShelleyExtended -> generateAndWriteKeyFiles fmt AsPaymentExtendedKey vkf skf AddressKeyByron -> generateAndWriteByronKeyFiles AsByronKey vkf skf @@ -135,10 +138,10 @@ writeByronPaymentKeyFiles vkeyPath skeyPath vkey skey = do skeyDesc = "Payment Signing Key" vkeyDesc = "Payment Verification Key" -runAddressKeyHash :: VerificationKeyTextOrFile +runLegacyAddressKeyHashCmd :: VerificationKeyTextOrFile -> Maybe (File () Out) -> ExceptT ShelleyAddressCmdError IO () -runAddressKeyHash vkeyTextOrFile mOutputFp = do +runLegacyAddressKeyHashCmd vkeyTextOrFile mOutputFp = do vkey <- firstExceptT ShelleyAddressCmdVerificationKeyTextOrFileError $ newExceptT $ readVerificationKeyTextOrFileAnyOf vkeyTextOrFile @@ -150,12 +153,12 @@ runAddressKeyHash vkeyTextOrFile mOutputFp = do Nothing -> liftIO $ BS.putStrLn hexKeyHash -runAddressBuild :: PaymentVerifier +runLegacyAddressBuildCmd :: PaymentVerifier -> Maybe StakeIdentifier -> NetworkId -> Maybe (File () Out) -> ExceptT ShelleyAddressCmdError IO () -runAddressBuild paymentVerifier mbStakeVerifier nw mOutFp = do +runLegacyAddressBuildCmd paymentVerifier mbStakeVerifier nw mOutFp = do outText <- case paymentVerifier of PaymentVerifierKey payVkeyTextOrFile -> do payVKey <- firstExceptT ShelleyAddressCmdVerificationKeyTextOrFileError $ diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Address/Info.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Address/Info.hs index 8be7b6e084..7cbd279e13 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Address/Info.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Address/Info.hs @@ -2,7 +2,7 @@ {-# LANGUAGE GADTs #-} module Cardano.CLI.Legacy.Run.Address.Info - ( runAddressInfo + ( runLegacyAddressInfoCmd ) where import Cardano.Api @@ -36,8 +36,8 @@ instance ToJSON AddressInfo where , "base16" .= aiBase16 addrInfo ] -runAddressInfo :: Text -> Maybe (File () Out) -> ExceptT ShelleyAddressInfoError IO () -runAddressInfo addrTxt mOutputFp = do +runLegacyAddressInfoCmd :: Text -> Maybe (File () Out) -> ExceptT ShelleyAddressInfoError IO () +runLegacyAddressInfoCmd addrTxt mOutputFp = do addrInfo <- case (Left <$> deserialiseAddress AsAddressAny addrTxt) <|> (Right <$> deserialiseAddress AsStakeAddress addrTxt) of diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs index a229ff5620..e8e51ba236 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs @@ -1,11 +1,12 @@ {-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} @@ -21,7 +22,7 @@ module Cardano.CLI.Legacy.Run.Genesis ( readShelleyGenesisWithDefault , readAndDecodeShelleyGenesis , readAlonzoGenesis - , runGenesisCmds + , runLegacyGenesisCmds -- * Protocol Parameters , ProtocolParamsError(..) @@ -48,8 +49,8 @@ import qualified Cardano.CLI.Byron.Key as Byron import qualified Cardano.CLI.IO.Lazy as Lazy import Cardano.CLI.Legacy.Commands.Genesis import Cardano.CLI.Legacy.Run.Node ( - runNodeIssueOpCert, runNodeKeyGenCold, runNodeKeyGenKES, runNodeKeyGenVRF) -import Cardano.CLI.Legacy.Run.StakeAddress (runStakeAddressKeyGenToFile) + runLegacyNodeIssueOpCertCmd, runLegacyNodeKeyGenColdCmd, runLegacyNodeKeyGenKesCmd, runLegacyNodeKeyGenVrfCmd) +import Cardano.CLI.Legacy.Run.StakeAddress (runLegacyStakeAddressKeyGenToFileCmd) import Cardano.CLI.Orphans () import Cardano.CLI.Types.Common import Cardano.CLI.Types.Errors.ProtocolParamsError @@ -131,29 +132,40 @@ import Text.Read (readMaybe) import Crypto.Random as Crypto -runGenesisCmds :: LegacyGenesisCmds -> ExceptT ShelleyGenesisCmdError IO () -runGenesisCmds (GenesisKeyGenGenesis vk sk) = runGenesisKeyGenGenesis vk sk -runGenesisCmds (GenesisKeyGenDelegate vk sk ctr) = runGenesisKeyGenDelegate vk sk ctr -runGenesisCmds (GenesisKeyGenUTxO vk sk) = runGenesisKeyGenUTxO vk sk -runGenesisCmds (GenesisCmdKeyHash vk) = runGenesisKeyHash vk -runGenesisCmds (GenesisVerKey vk sk) = runGenesisVerKey vk sk -runGenesisCmds (GenesisTxIn vk nw mOutFile) = runGenesisTxIn vk nw mOutFile -runGenesisCmds (GenesisAddr vk nw mOutFile) = runGenesisAddr vk nw mOutFile -runGenesisCmds (GenesisCreate fmt gd gn un ms am nw) = runGenesisCreate fmt gd gn un ms am nw -runGenesisCmds (GenesisCreateCardano gd gn un ms am k slotLength sc nw bg sg ag cg mNodeCfg) = runGenesisCreateCardano gd gn un ms am k slotLength sc nw bg sg ag cg mNodeCfg -runGenesisCmds (GenesisCreateStaked fmt gd gn gp gl un ms am ds nw bf bp su relayJsonFp) = - runGenesisCreateStaked fmt gd gn gp gl un ms am ds nw bf bp su relayJsonFp -runGenesisCmds (GenesisHashFile gf) = runGenesisHashFile gf +runLegacyGenesisCmds :: LegacyGenesisCmds -> ExceptT ShelleyGenesisCmdError IO () +runLegacyGenesisCmds = \case + GenesisKeyGenGenesis vk sk -> + runLegacyGenesisKeyGenGenesisCmd vk sk + GenesisKeyGenDelegate vk sk ctr -> + runLegacyGenesisKeyGenDelegateCmd vk sk ctr + GenesisKeyGenUTxO vk sk -> + runLegacyGenesisKeyGenUTxOCmd vk sk + GenesisCmdKeyHash vk -> + runLegacyGenesisKeyHashCmd vk + GenesisVerKey vk sk -> + runLegacyGenesisVerKeyCmd vk sk + GenesisTxIn vk nw mOutFile -> + runLegacyGenesisTxInCmd vk nw mOutFile + GenesisAddr vk nw mOutFile -> + runLegacyGenesisAddrCmd vk nw mOutFile + GenesisCreate fmt gd gn un ms am nw -> + runLegacyGenesisCreateCmd fmt gd gn un ms am nw + GenesisCreateCardano gd gn un ms am k slotLength sc nw bg sg ag cg mNodeCfg -> + runLegacyGenesisCreateCardanoCmd gd gn un ms am k slotLength sc nw bg sg ag cg mNodeCfg + GenesisCreateStaked fmt gd gn gp gl un ms am ds nw bf bp su relayJsonFp -> + runLegacyGenesisCreateStakedCmd fmt gd gn gp gl un ms am ds nw bf bp su relayJsonFp + GenesisHashFile gf -> + runLegacyGenesisHashFileCmd gf -- -- Genesis command implementations -- -runGenesisKeyGenGenesis :: +runLegacyGenesisKeyGenGenesisCmd :: VerificationKeyFile Out -> SigningKeyFile Out -> ExceptT ShelleyGenesisCmdError IO () -runGenesisKeyGenGenesis vkeyPath skeyPath = do +runLegacyGenesisKeyGenGenesisCmd vkeyPath skeyPath = do skey <- liftIO $ generateSigningKey AsGenesisKey let vkey = getVerificationKey skey firstExceptT ShelleyGenesisCmdGenesisFileError @@ -170,12 +182,12 @@ runGenesisKeyGenGenesis vkeyPath skeyPath = do vkeyDesc = "Genesis Verification Key" -runGenesisKeyGenDelegate :: +runLegacyGenesisKeyGenDelegateCmd :: VerificationKeyFile Out -> SigningKeyFile Out -> OpCertCounterFile Out -> ExceptT ShelleyGenesisCmdError IO () -runGenesisKeyGenDelegate vkeyPath skeyPath ocertCtrPath = do +runLegacyGenesisKeyGenDelegateCmd vkeyPath skeyPath ocertCtrPath = do skey <- liftIO $ generateSigningKey AsGenesisDelegateKey let vkey = getVerificationKey skey firstExceptT ShelleyGenesisCmdGenesisFileError @@ -225,11 +237,11 @@ runGenesisKeyGenDelegateVRF vkeyPath skeyPath = do vkeyDesc = "VRF Verification Key" -runGenesisKeyGenUTxO :: +runLegacyGenesisKeyGenUTxOCmd :: VerificationKeyFile Out -> SigningKeyFile Out -> ExceptT ShelleyGenesisCmdError IO () -runGenesisKeyGenUTxO vkeyPath skeyPath = do +runLegacyGenesisKeyGenUTxOCmd vkeyPath skeyPath = do skey <- liftIO $ generateSigningKey AsGenesisUTxOKey let vkey = getVerificationKey skey firstExceptT ShelleyGenesisCmdGenesisFileError @@ -246,8 +258,8 @@ runGenesisKeyGenUTxO vkeyPath skeyPath = do vkeyDesc = "Genesis Initial UTxO Verification Key" -runGenesisKeyHash :: VerificationKeyFile In -> ExceptT ShelleyGenesisCmdError IO () -runGenesisKeyHash vkeyPath = do +runLegacyGenesisKeyHashCmd :: VerificationKeyFile In -> ExceptT ShelleyGenesisCmdError IO () +runLegacyGenesisKeyHashCmd vkeyPath = do vkey <- firstExceptT ShelleyGenesisCmdTextEnvReadFileError . newExceptT $ readFileTextEnvelopeAnyOf [ FromSomeType (AsVerificationKey AsGenesisKey) @@ -270,11 +282,11 @@ runGenesisKeyHash vkeyPath = do . verificationKeyHash -runGenesisVerKey :: +runLegacyGenesisVerKeyCmd :: VerificationKeyFile Out -> SigningKeyFile In -> ExceptT ShelleyGenesisCmdError IO () -runGenesisVerKey vkeyPath skeyPath = do +runLegacyGenesisVerKeyCmd vkeyPath skeyPath = do skey <- firstExceptT ShelleyGenesisCmdTextEnvReadFileError . newExceptT $ readFileTextEnvelopeAnyOf [ FromSomeType (AsSigningKey AsGenesisKey) @@ -304,24 +316,24 @@ data SomeGenesisKey f | AGenesisUTxOKey (f GenesisUTxOKey) -runGenesisTxIn :: +runLegacyGenesisTxInCmd :: VerificationKeyFile In -> NetworkId -> Maybe (File () Out) -> ExceptT ShelleyGenesisCmdError IO () -runGenesisTxIn vkeyPath network mOutFile = do +runLegacyGenesisTxInCmd vkeyPath network mOutFile = do vkey <- firstExceptT ShelleyGenesisCmdTextEnvReadFileError . newExceptT $ readFileTextEnvelope (AsVerificationKey AsGenesisUTxOKey) vkeyPath let txin = genesisUTxOPseudoTxIn network (verificationKeyHash vkey) liftIO $ writeOutput mOutFile (renderTxIn txin) -runGenesisAddr :: +runLegacyGenesisAddrCmd :: VerificationKeyFile In -> NetworkId -> Maybe (File () Out) -> ExceptT ShelleyGenesisCmdError IO () -runGenesisAddr vkeyPath network mOutFile = do +runLegacyGenesisAddrCmd vkeyPath network mOutFile = do vkey <- firstExceptT ShelleyGenesisCmdTextEnvReadFileError . newExceptT $ readFileTextEnvelope (AsVerificationKey AsGenesisUTxOKey) vkeyPath let vkh = verificationKeyHash (castVerificationKey vkey) @@ -338,7 +350,7 @@ writeOutput Nothing = Text.putStrLn -- Create Genesis command implementation -- -runGenesisCreate +runLegacyGenesisCreateCmd :: KeyOutputFormat -> GenesisDir -> Word -- ^ num genesis & delegate keys to make @@ -347,7 +359,7 @@ runGenesisCreate -> Maybe Lovelace -> NetworkId -> ExceptT ShelleyGenesisCmdError IO () -runGenesisCreate +runLegacyGenesisCreateCmd fmt (GenesisDir rootdir) genNumGenesisKeys genNumUTxOKeys mStart mAmount network = do @@ -460,7 +472,7 @@ generateShelleyNodeSecrets shelleyDelegateKeys shelleyGenesisvkeys = do -- Create Genesis Cardano command implementation -- -runGenesisCreateCardano :: GenesisDir +runLegacyGenesisCreateCardanoCmd :: GenesisDir -> Word -- ^ num genesis & delegate keys to make -> Word -- ^ num utxo keys to make -> Maybe SystemStart @@ -475,7 +487,7 @@ runGenesisCreateCardano :: GenesisDir -> FilePath -- ^ Conway Genesis -> Maybe FilePath -> ExceptT ShelleyGenesisCmdError IO () -runGenesisCreateCardano (GenesisDir rootdir) +runLegacyGenesisCreateCardanoCmd (GenesisDir rootdir) genNumGenesisKeys genNumUTxOKeys mStart mAmount mSecurity slotLength mSlotCoeff network byronGenesisT shelleyGenesisT alonzoGenesisT conwayGenesisT mNodeCfg = do @@ -622,7 +634,7 @@ runGenesisCreateCardano (GenesisDir rootdir) dlgCertMap :: Genesis.GenesisData -> Map Byron.KeyHash Dlg.Certificate dlgCertMap byronGenesis = Genesis.unGenesisDelegation $ Genesis.gdHeavyDelegation byronGenesis -runGenesisCreateStaked +runLegacyGenesisCreateStakedCmd :: KeyOutputFormat -- ^ key output format -> GenesisDir -> Word -- ^ num genesis & delegate keys to make @@ -638,7 +650,7 @@ runGenesisCreateStaked -> Word -- ^ num stuffed UTxO entries -> Maybe FilePath -- ^ Specified stake pool relays -> ExceptT ShelleyGenesisCmdError IO () -runGenesisCreateStaked +runLegacyGenesisCreateStakedCmd fmt (GenesisDir rootdir) genNumGenesisKeys genNumUTxOKeys genNumPools genNumStDelegs mStart mNonDlgAmount stDlgAmount network @@ -772,7 +784,7 @@ runGenesisCreateStaked createDelegateKeys :: KeyOutputFormat -> FilePath -> Word -> ExceptT ShelleyGenesisCmdError IO () createDelegateKeys fmt dir index = do liftIO $ createDirectoryIfMissing False dir - runGenesisKeyGenDelegate + runLegacyGenesisKeyGenDelegateCmd (File @(VerificationKey ()) $ dir "delegate" ++ strIndex ++ ".vkey") (onlyOut coldSK) (onlyOut opCertCtr) @@ -780,11 +792,11 @@ createDelegateKeys fmt dir index = do (File @(VerificationKey ()) $ dir "delegate" ++ strIndex ++ ".vrf.vkey") (File @(SigningKey ()) $ dir "delegate" ++ strIndex ++ ".vrf.skey") firstExceptT ShelleyGenesisCmdNodeCmdError $ do - runNodeKeyGenKES + runLegacyNodeKeyGenKesCmd fmt (onlyOut kesVK) (File @(SigningKey ()) $ dir "delegate" ++ strIndex ++ ".kes.skey") - runNodeIssueOpCert + runLegacyNodeIssueOpCertCmd (VerificationKeyFilePath (onlyIn kesVK)) (onlyIn coldSK) opCertCtr @@ -800,7 +812,7 @@ createGenesisKeys :: FilePath -> Word -> ExceptT ShelleyGenesisCmdError IO () createGenesisKeys dir index = do liftIO $ createDirectoryIfMissing False dir let strIndex = show index - runGenesisKeyGenGenesis + runLegacyGenesisKeyGenGenesisCmd (File @(VerificationKey ()) $ dir "genesis" ++ strIndex ++ ".vkey") (File @(SigningKey ()) $ dir "genesis" ++ strIndex ++ ".skey") @@ -809,7 +821,7 @@ createUtxoKeys :: FilePath -> Word -> ExceptT ShelleyGenesisCmdError IO () createUtxoKeys dir index = do liftIO $ createDirectoryIfMissing False dir let strIndex = show index - runGenesisKeyGenUTxO + runLegacyGenesisKeyGenUTxOCmd (File @(VerificationKey ()) $ dir "utxo" ++ strIndex ++ ".vkey") (File @(SigningKey ()) $ dir "utxo" ++ strIndex ++ ".skey") @@ -817,27 +829,27 @@ createPoolCredentials :: KeyOutputFormat -> FilePath -> Word -> ExceptT ShelleyG createPoolCredentials fmt dir index = do liftIO $ createDirectoryIfMissing False dir firstExceptT ShelleyGenesisCmdNodeCmdError $ do - runNodeKeyGenKES + runLegacyNodeKeyGenKesCmd fmt (onlyOut kesVK) (File @(SigningKey ()) $ dir "kes" ++ strIndex ++ ".skey") - runNodeKeyGenVRF + runLegacyNodeKeyGenVrfCmd fmt (File @(VerificationKey ()) $ dir "vrf" ++ strIndex ++ ".vkey") (File @(SigningKey ()) $ dir "vrf" ++ strIndex ++ ".skey") - runNodeKeyGenCold + runLegacyNodeKeyGenColdCmd fmt (File @(VerificationKey ()) $ dir "cold" ++ strIndex ++ ".vkey") (onlyOut coldSK) (onlyOut opCertCtr) - runNodeIssueOpCert + runLegacyNodeIssueOpCertCmd (VerificationKeyFilePath (onlyIn kesVK)) (onlyIn coldSK) opCertCtr (KESPeriod 0) (File $ dir "opcert" ++ strIndex ++ ".cert") firstExceptT ShelleyGenesisCmdStakeAddressCmdError $ - runStakeAddressKeyGenToFile + runLegacyStakeAddressKeyGenToFileCmd fmt (File @(VerificationKey ()) $ dir "staking-reward" ++ strIndex ++ ".vkey") (File @(SigningKey ()) $ dir "staking-reward" ++ strIndex ++ ".skey") @@ -1285,8 +1297,8 @@ readInitialFundAddresses utxodir nw = do -- | Hash a genesis file -runGenesisHashFile :: GenesisFile -> ExceptT ShelleyGenesisCmdError IO () -runGenesisHashFile (GenesisFile fpath) = do +runLegacyGenesisHashFileCmd :: GenesisFile -> ExceptT ShelleyGenesisCmdError IO () +runLegacyGenesisHashFileCmd (GenesisFile fpath) = do content <- handleIOExceptT (ShelleyGenesisCmdGenesisFileError . FileIOError fpath) $ BS.readFile fpath let gh :: Crypto.Hash Crypto.Blake2b_256 ByteString diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Key.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Key.hs index 3d8a44a428..45fd234c19 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Key.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Key.hs @@ -1,11 +1,12 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} module Cardano.CLI.Legacy.Run.Key ( SomeSigningKey(..) - , runKeyCmds + , runLegacyKeyCmds , readSigningKeyFile -- * Exports for testing @@ -44,35 +45,29 @@ import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import System.Exit (exitFailure) -runKeyCmds :: LegacyKeyCmds -> ExceptT ShelleyKeyCmdError IO () -runKeyCmds cmd = - case cmd of - KeyGetVerificationKey skf vkf -> - runGetVerificationKey skf vkf - - KeyNonExtendedKey evkf vkf -> - runConvertToNonExtendedKey evkf vkf - - KeyConvertByronKey mPassword keytype skfOld skfNew -> - runConvertByronKey mPassword keytype skfOld skfNew - - KeyConvertByronGenesisVKey oldVk newVkf -> - runConvertByronGenesisVerificationKey oldVk newVkf - - KeyConvertITNStakeKey itnKeyFile outFile -> - runConvertITNStakeKey itnKeyFile outFile - KeyConvertITNExtendedToStakeKey itnPrivKeyFile outFile -> - runConvertITNExtendedToStakeKey itnPrivKeyFile outFile - KeyConvertITNBip32ToStakeKey itnPrivKeyFile outFile -> - runConvertITNBip32ToStakeKey itnPrivKeyFile outFile - - KeyConvertCardanoAddressSigningKey keyType skfOld skfNew -> - runConvertCardanoAddressSigningKey keyType skfOld skfNew - -runGetVerificationKey :: SigningKeyFile In +runLegacyKeyCmds :: LegacyKeyCmds -> ExceptT ShelleyKeyCmdError IO () +runLegacyKeyCmds = \case + KeyGetVerificationKey skf vkf -> + runLegacyGetVerificationKeyCmd skf vkf + KeyNonExtendedKey evkf vkf -> + runLegacyConvertToNonExtendedKeyCmd evkf vkf + KeyConvertByronKey mPassword keytype skfOld skfNew -> + runLegacyConvertByronKeyCmd mPassword keytype skfOld skfNew + KeyConvertByronGenesisVKey oldVk newVkf -> + runLegacyConvertByronGenesisVerificationKeyCmd oldVk newVkf + KeyConvertITNStakeKey itnKeyFile outFile -> + runLegacyConvertITNStakeKeyCmd itnKeyFile outFile + KeyConvertITNExtendedToStakeKey itnPrivKeyFile outFile -> + runLegacyConvertITNExtendedToStakeKeyCmd itnPrivKeyFile outFile + KeyConvertITNBip32ToStakeKey itnPrivKeyFile outFile -> + runLegacyConvertITNBip32ToStakeKeyCmd itnPrivKeyFile outFile + KeyConvertCardanoAddressSigningKey keyType skfOld skfNew -> + runLegacyConvertCardanoAddressSigningKeyCmd keyType skfOld skfNew + +runLegacyGetVerificationKeyCmd :: SigningKeyFile In -> VerificationKeyFile Out -> ExceptT ShelleyKeyCmdError IO () -runGetVerificationKey skf vkf = do +runLegacyGetVerificationKeyCmd skf vkf = do ssk <- firstExceptT ShelleyKeyCmdReadKeyFileError $ readSigningKeyFile skf withSomeSigningKey ssk $ \sk -> @@ -171,11 +166,11 @@ readSigningKeyFile skFile = ] -runConvertToNonExtendedKey +runLegacyConvertToNonExtendedKeyCmd :: VerificationKeyFile In -> VerificationKeyFile Out -> ExceptT ShelleyKeyCmdError IO () -runConvertToNonExtendedKey evkf vkf = +runLegacyConvertToNonExtendedKeyCmd evkf vkf = writeVerificationKey =<< readExtendedVerificationKeyFile evkf where -- TODO: Expose a function specifically for this purpose @@ -225,45 +220,45 @@ readExtendedVerificationKeyFile evkfile = do left $ ShelleyKeyCmdExpectedExtendedVerificationKey nonExtendedKey -runConvertByronKey +runLegacyConvertByronKeyCmd :: Maybe Text -- ^ Password (if applicable) -> ByronKeyType -> SomeKeyFile In -- ^ Input file: old format -> File () Out -- ^ Output file: new format -> ExceptT ShelleyKeyCmdError IO () -runConvertByronKey mPwd (ByronPaymentKey format) (ASigningKeyFile skeyPathOld) = +runLegacyConvertByronKeyCmd mPwd (ByronPaymentKey format) (ASigningKeyFile skeyPathOld) = convertByronSigningKey mPwd format convert skeyPathOld where convert :: Byron.SigningKey -> SigningKey ByronKey convert = ByronSigningKey -runConvertByronKey mPwd (ByronGenesisKey format) (ASigningKeyFile skeyPathOld) = +runLegacyConvertByronKeyCmd mPwd (ByronGenesisKey format) (ASigningKeyFile skeyPathOld) = convertByronSigningKey mPwd format convert skeyPathOld where convert :: Byron.SigningKey -> SigningKey GenesisExtendedKey convert (Byron.SigningKey xsk) = GenesisExtendedSigningKey xsk -runConvertByronKey mPwd (ByronDelegateKey format) (ASigningKeyFile skeyPathOld) = +runLegacyConvertByronKeyCmd mPwd (ByronDelegateKey format) (ASigningKeyFile skeyPathOld) = convertByronSigningKey mPwd format convert skeyPathOld where convert :: Byron.SigningKey -> SigningKey GenesisDelegateExtendedKey convert (Byron.SigningKey xsk) = GenesisDelegateExtendedSigningKey xsk -runConvertByronKey _ (ByronPaymentKey NonLegacyByronKeyFormat) +runLegacyConvertByronKeyCmd _ (ByronPaymentKey NonLegacyByronKeyFormat) (AVerificationKeyFile vkeyPathOld) = convertByronVerificationKey convert vkeyPathOld where convert :: Byron.VerificationKey -> VerificationKey ByronKey convert = ByronVerificationKey -runConvertByronKey _ (ByronGenesisKey NonLegacyByronKeyFormat) +runLegacyConvertByronKeyCmd _ (ByronGenesisKey NonLegacyByronKeyFormat) (AVerificationKeyFile vkeyPathOld) = convertByronVerificationKey convert vkeyPathOld where convert :: Byron.VerificationKey -> VerificationKey GenesisExtendedKey convert (Byron.VerificationKey xvk) = GenesisExtendedVerificationKey xvk -runConvertByronKey _ (ByronDelegateKey NonLegacyByronKeyFormat) +runLegacyConvertByronKeyCmd _ (ByronDelegateKey NonLegacyByronKeyFormat) (AVerificationKeyFile vkeyPathOld) = convertByronVerificationKey convert vkeyPathOld where @@ -272,15 +267,15 @@ runConvertByronKey _ (ByronDelegateKey NonLegacyByronKeyFormat) convert (Byron.VerificationKey xvk) = GenesisDelegateExtendedVerificationKey xvk -runConvertByronKey _ (ByronPaymentKey LegacyByronKeyFormat) +runLegacyConvertByronKeyCmd _ (ByronPaymentKey LegacyByronKeyFormat) AVerificationKeyFile{} = const legacyVerificationKeysNotSupported -runConvertByronKey _ (ByronGenesisKey LegacyByronKeyFormat) +runLegacyConvertByronKeyCmd _ (ByronGenesisKey LegacyByronKeyFormat) AVerificationKeyFile{} = const legacyVerificationKeysNotSupported -runConvertByronKey _ (ByronDelegateKey LegacyByronKeyFormat) +runLegacyConvertByronKeyCmd _ (ByronDelegateKey LegacyByronKeyFormat) AVerificationKeyFile{} = const legacyVerificationKeysNotSupported @@ -342,11 +337,11 @@ convertByronVerificationKey convert vkeyPathOld vkeyPathNew = do writeLazyByteStringFile vkeyPathNew $ textEnvelopeToJSON Nothing vk' -runConvertByronGenesisVerificationKey +runLegacyConvertByronGenesisVerificationKeyCmd :: VerificationKeyBase64 -- ^ Input key raw old format -> File () Out -- ^ Output file: new format -> ExceptT ShelleyKeyCmdError IO () -runConvertByronGenesisVerificationKey (VerificationKeyBase64 b64ByronVKey) vkeyPathNew = do +runLegacyConvertByronGenesisVerificationKeyCmd (VerificationKeyBase64 b64ByronVKey) vkeyPathNew = do vk <- firstExceptT (ShelleyKeyCmdByronKeyParseError . textShow) . hoistEither @@ -369,11 +364,11 @@ runConvertByronGenesisVerificationKey (VerificationKeyBase64 b64ByronVKey) vkeyP -- ITN verification/signing key conversion to Haskell verficiation/signing keys -------------------------------------------------------------------------------- -runConvertITNStakeKey +runLegacyConvertITNStakeKeyCmd :: SomeKeyFile In -> File () Out -> ExceptT ShelleyKeyCmdError IO () -runConvertITNStakeKey (AVerificationKeyFile (File vk)) outFile = do +runLegacyConvertITNStakeKeyCmd (AVerificationKeyFile (File vk)) outFile = do bech32publicKey <- firstExceptT ShelleyKeyCmdItnKeyConvError . newExceptT $ readFileITNKey vk vkey <- hoistEither @@ -382,7 +377,7 @@ runConvertITNStakeKey (AVerificationKeyFile (File vk)) outFile = do firstExceptT ShelleyKeyCmdWriteFileError . newExceptT $ writeLazyByteStringFile outFile $ textEnvelopeToJSON Nothing vkey -runConvertITNStakeKey (ASigningKeyFile (File sk)) outFile = do +runLegacyConvertITNStakeKeyCmd (ASigningKeyFile (File sk)) outFile = do bech32privateKey <- firstExceptT ShelleyKeyCmdItnKeyConvError . newExceptT $ readFileITNKey sk skey <- hoistEither @@ -392,9 +387,9 @@ runConvertITNStakeKey (ASigningKeyFile (File sk)) outFile = do $ writeLazyByteStringFile outFile $ textEnvelopeToJSON Nothing skey -runConvertITNExtendedToStakeKey :: SomeKeyFile In -> File () Out -> ExceptT ShelleyKeyCmdError IO () -runConvertITNExtendedToStakeKey (AVerificationKeyFile _) _ = left ShelleyKeyCmdWrongKeyTypeError -runConvertITNExtendedToStakeKey (ASigningKeyFile (File sk)) outFile = do +runLegacyConvertITNExtendedToStakeKeyCmd :: SomeKeyFile In -> File () Out -> ExceptT ShelleyKeyCmdError IO () +runLegacyConvertITNExtendedToStakeKeyCmd (AVerificationKeyFile _) _ = left ShelleyKeyCmdWrongKeyTypeError +runLegacyConvertITNExtendedToStakeKeyCmd (ASigningKeyFile (File sk)) outFile = do bech32privateKey <- firstExceptT ShelleyKeyCmdItnKeyConvError . newExceptT $ readFileITNKey sk skey <- hoistEither . first ShelleyKeyCmdItnKeyConvError $ convertITNExtendedSigningKey bech32privateKey @@ -402,9 +397,9 @@ runConvertITNExtendedToStakeKey (ASigningKeyFile (File sk)) outFile = do $ writeLazyByteStringFile outFile $ textEnvelopeToJSON Nothing skey -runConvertITNBip32ToStakeKey :: SomeKeyFile In -> File () Out -> ExceptT ShelleyKeyCmdError IO () -runConvertITNBip32ToStakeKey (AVerificationKeyFile _) _ = left ShelleyKeyCmdWrongKeyTypeError -runConvertITNBip32ToStakeKey (ASigningKeyFile (File sk)) outFile = do +runLegacyConvertITNBip32ToStakeKeyCmd :: SomeKeyFile In -> File () Out -> ExceptT ShelleyKeyCmdError IO () +runLegacyConvertITNBip32ToStakeKeyCmd (AVerificationKeyFile _) _ = left ShelleyKeyCmdWrongKeyTypeError +runLegacyConvertITNBip32ToStakeKeyCmd (ASigningKeyFile (File sk)) outFile = do bech32privateKey <- firstExceptT ShelleyKeyCmdItnKeyConvError . newExceptT $ readFileITNKey sk skey <- hoistEither . first ShelleyKeyCmdItnKeyConvError $ convertITNBIP32SigningKey bech32privateKey @@ -459,12 +454,12 @@ readFileITNKey fp = do -- `cardano-address` extended signing key conversions -------------------------------------------------------------------------------- -runConvertCardanoAddressSigningKey +runLegacyConvertCardanoAddressSigningKeyCmd :: CardanoAddressKeyType -> SigningKeyFile In -> File () Out -> ExceptT ShelleyKeyCmdError IO () -runConvertCardanoAddressSigningKey keyType skFile outFile = do +runLegacyConvertCardanoAddressSigningKeyCmd keyType skFile outFile = do sKey <- firstExceptT ShelleyKeyCmdCardanoAddressSigningKeyFileError . newExceptT $ readSomeCardanoAddressSigningKeyFile keyType skFile diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Node.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Node.hs index 2415ce912f..b3f17a7808 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Node.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Node.hs @@ -1,11 +1,12 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} module Cardano.CLI.Legacy.Run.Node - ( runNodeCmds - , runNodeIssueOpCert - , runNodeKeyGenCold - , runNodeKeyGenKES - , runNodeKeyGenVRF + ( runLegacyNodeCmds + , runLegacyNodeIssueOpCertCmd + , runLegacyNodeKeyGenColdCmd + , runLegacyNodeKeyGenKesCmd + , runLegacyNodeKeyGenVrfCmd , readColdVerificationKeyOrFile ) where @@ -26,28 +27,32 @@ import Data.Word (Word64) {- HLINT ignore "Reduce duplication" -} -runNodeCmds :: LegacyNodeCmds -> ExceptT ShelleyNodeCmdError IO () -runNodeCmds (NodeKeyGenCold fmt vk sk ctr) = runNodeKeyGenCold fmt vk sk ctr -runNodeCmds (NodeKeyGenKES fmt vk sk) = runNodeKeyGenKES fmt vk sk -runNodeCmds (NodeKeyGenVRF fmt vk sk) = runNodeKeyGenVRF fmt vk sk -runNodeCmds (NodeKeyHashVRF vk mOutFp) = runNodeKeyHashVRF vk mOutFp -runNodeCmds (NodeNewCounter vk ctr out) = runNodeNewCounter vk ctr out -runNodeCmds (NodeIssueOpCert vk sk ctr p out) = - runNodeIssueOpCert vk sk ctr p out - - +runLegacyNodeCmds :: LegacyNodeCmds -> ExceptT ShelleyNodeCmdError IO () +runLegacyNodeCmds = \case + NodeKeyGenCold fmt vk sk ctr -> + runLegacyNodeKeyGenColdCmd fmt vk sk ctr + NodeKeyGenKES fmt vk sk -> + runLegacyNodeKeyGenKesCmd fmt vk sk + NodeKeyGenVRF fmt vk sk -> + runLegacyNodeKeyGenVrfCmd fmt vk sk + NodeKeyHashVRF vk mOutFp -> + runLegacyNodeKeyHashVrfCmd vk mOutFp + NodeNewCounter vk ctr out -> + runLegacyNodeNewCounterCmd vk ctr out + NodeIssueOpCert vk sk ctr p out -> + runLegacyNodeIssueOpCertCmd vk sk ctr p out -- -- Node command implementations -- -runNodeKeyGenCold +runLegacyNodeKeyGenColdCmd :: KeyOutputFormat -> VerificationKeyFile Out -> SigningKeyFile Out -> OpCertCounterFile Out -> ExceptT ShelleyNodeCmdError IO () -runNodeKeyGenCold fmt vkeyPath skeyPath ocertCtrPath = do +runLegacyNodeKeyGenColdCmd fmt vkeyPath skeyPath ocertCtrPath = do skey <- liftIO $ generateSigningKey AsStakePoolKey let vkey = getVerificationKey skey @@ -95,12 +100,12 @@ runNodeKeyGenCold fmt vkeyPath skeyPath ocertCtrPath = do initialCounter = 0 -runNodeKeyGenKES +runLegacyNodeKeyGenKesCmd :: KeyOutputFormat -> VerificationKeyFile Out -> SigningKeyFile Out -> ExceptT ShelleyNodeCmdError IO () -runNodeKeyGenKES fmt vkeyPath skeyPath = do +runLegacyNodeKeyGenKesCmd fmt vkeyPath skeyPath = do skey <- liftIO $ generateSigningKey AsKesKey let vkey = getVerificationKey skey @@ -136,12 +141,12 @@ runNodeKeyGenKES fmt vkeyPath skeyPath = do vkeyDesc :: TextEnvelopeDescr vkeyDesc = "KES Verification Key" -runNodeKeyGenVRF +runLegacyNodeKeyGenVrfCmd :: KeyOutputFormat -> VerificationKeyFile Out -> SigningKeyFile Out -> ExceptT ShelleyNodeCmdError IO () -runNodeKeyGenVRF fmt vkeyPath skeyPath = do +runLegacyNodeKeyGenVrfCmd fmt vkeyPath skeyPath = do skey <- liftIO $ generateSigningKey AsVrfKey let vkey = getVerificationKey skey @@ -174,10 +179,10 @@ runNodeKeyGenVRF fmt vkeyPath skeyPath = do skeyDesc = "VRF Signing Key" vkeyDesc = "VRF Verification Key" -runNodeKeyHashVRF :: VerificationKeyOrFile VrfKey +runLegacyNodeKeyHashVrfCmd :: VerificationKeyOrFile VrfKey -> Maybe (File () Out) -> ExceptT ShelleyNodeCmdError IO () -runNodeKeyHashVRF verKeyOrFile mOutputFp = do +runLegacyNodeKeyHashVrfCmd verKeyOrFile mOutputFp = do vkey <- firstExceptT ShelleyNodeCmdReadKeyFileError . newExceptT $ readVerificationKeyOrFile AsVrfKey verKeyOrFile @@ -189,11 +194,11 @@ runNodeKeyHashVRF verKeyOrFile mOutputFp = do Nothing -> liftIO $ BS.putStrLn hexKeyHash -runNodeNewCounter :: ColdVerificationKeyOrFile +runLegacyNodeNewCounterCmd :: ColdVerificationKeyOrFile -> Word -> OpCertCounterFile InOut -> ExceptT ShelleyNodeCmdError IO () -runNodeNewCounter coldVerKeyOrFile counter ocertCtrPath = do +runLegacyNodeNewCounterCmd coldVerKeyOrFile counter ocertCtrPath = do vkey <- firstExceptT ShelleyNodeCmdReadFileError . newExceptT $ readColdVerificationKeyOrFile coldVerKeyOrFile @@ -206,7 +211,7 @@ runNodeNewCounter coldVerKeyOrFile counter ocertCtrPath = do $ textEnvelopeToJSON Nothing ocertIssueCounter -runNodeIssueOpCert :: VerificationKeyOrFile KesKey +runLegacyNodeIssueOpCertCmd :: VerificationKeyOrFile KesKey -- ^ This is the hot KES verification key. -> SigningKeyFile In -- ^ This is the cold signing key. @@ -217,7 +222,7 @@ runNodeIssueOpCert :: VerificationKeyOrFile KesKey -- ^ Start of the validity period for this certificate. -> File () Out -> ExceptT ShelleyNodeCmdError IO () -runNodeIssueOpCert kesVerKeyOrFile stakePoolSKeyFile ocertCtrPath kesPeriod certFile = do +runLegacyNodeIssueOpCertCmd kesVerKeyOrFile stakePoolSKeyFile ocertCtrPath kesPeriod certFile = do ocertIssueCounter <- firstExceptT ShelleyNodeCmdReadFileError . newExceptT diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Pool.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Pool.hs index ce9e4c4f23..e72a29adc8 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Pool.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Pool.hs @@ -4,7 +4,7 @@ {-# LANGUAGE RankNTypes #-} module Cardano.CLI.Legacy.Run.Pool - ( runPoolCmds + ( runLegacyPoolCmds ) where import Cardano.Api @@ -25,16 +25,16 @@ import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT import qualified Data.ByteString.Char8 as BS import Data.Function ((&)) -runPoolCmds :: LegacyPoolCmds -> ExceptT ShelleyPoolCmdError IO () -runPoolCmds = \case +runLegacyPoolCmds :: LegacyPoolCmds -> ExceptT ShelleyPoolCmdError IO () +runLegacyPoolCmds = \case PoolRegistrationCert anyEra sPvkey vrfVkey pldg pCost pMrgn rwdVerFp ownerVerFps relays mbMetadata network outfp -> - runStakePoolRegistrationCert anyEra sPvkey vrfVkey pldg pCost pMrgn rwdVerFp ownerVerFps relays mbMetadata network outfp + runLegacyStakePoolRegistrationCertCmd anyEra sPvkey vrfVkey pldg pCost pMrgn rwdVerFp ownerVerFps relays mbMetadata network outfp PoolRetirementCert anyEra sPvkeyFp retireEpoch outfp -> - runStakePoolRetirementCert anyEra sPvkeyFp retireEpoch outfp + runLegacyStakePoolRetirementCertCmd anyEra sPvkeyFp retireEpoch outfp PoolGetId sPvkey outputFormat mOutFile -> - runPoolId sPvkey outputFormat mOutFile + runLegacyPoolIdCmd sPvkey outputFormat mOutFile PoolMetadataHash poolMdFile mOutFile -> - runPoolMetadataHash poolMdFile mOutFile + runLegacyPoolMetadataHashCmd poolMdFile mOutFile -- -- Stake pool command implementations @@ -43,7 +43,7 @@ runPoolCmds = \case -- | Create a stake pool registration cert. -- TODO: Metadata and more stake pool relay support to be -- added in the future. -runStakePoolRegistrationCert +runLegacyStakePoolRegistrationCertCmd :: AnyShelleyBasedEra -> VerificationKeyOrFile StakePoolKey -- ^ Stake pool verification key. @@ -66,7 +66,7 @@ runStakePoolRegistrationCert -> NetworkId -> File () Out -> ExceptT ShelleyPoolCmdError IO () -runStakePoolRegistrationCert +runLegacyStakePoolRegistrationCertCmd anyEra stakePoolVerKeyOrFile vrfVerKeyOrFile @@ -156,13 +156,13 @@ createStakePoolRegistrationRequirements sbe pparams = StakePoolRegistrationRequirementsConwayOnwards ConwayEraOnwardsConway pparams -runStakePoolRetirementCert +runLegacyStakePoolRetirementCertCmd :: AnyShelleyBasedEra -> VerificationKeyOrFile StakePoolKey -> Shelley.EpochNo -> File () Out -> ExceptT ShelleyPoolCmdError IO () -runStakePoolRetirementCert anyEra stakePoolVerKeyOrFile retireEpoch outfp = do +runLegacyStakePoolRetirementCertCmd anyEra stakePoolVerKeyOrFile retireEpoch outfp = do AnyShelleyBasedEra sbe <- pure anyEra -- Pool verification key @@ -203,12 +203,12 @@ createStakePoolRetirementRequirements sbe pid epoch = StakePoolRetirementRequirementsConwayOnwards ConwayEraOnwardsConway pid epoch -runPoolId +runLegacyPoolIdCmd :: VerificationKeyOrFile StakePoolKey -> IdOutputFormat -> Maybe (File () Out) -> ExceptT ShelleyPoolCmdError IO () -runPoolId verKeyOrFile outputFormat mOutFile = do +runLegacyPoolIdCmd verKeyOrFile outputFormat mOutFile = do stakePoolVerKey <- firstExceptT ShelleyPoolCmdReadKeyFileError . newExceptT $ readVerificationKeyOrFile AsStakePoolKey verKeyOrFile @@ -225,8 +225,8 @@ runPoolId verKeyOrFile outputFormat mOutFile = do $ writeTextOutput mOutFile $ serialiseToBech32 (verificationKeyHash stakePoolVerKey) -runPoolMetadataHash :: StakePoolMetadataFile In -> Maybe (File () Out) -> ExceptT ShelleyPoolCmdError IO () -runPoolMetadataHash poolMDPath mOutFile = do +runLegacyPoolMetadataHashCmd :: StakePoolMetadataFile In -> Maybe (File () Out) -> ExceptT ShelleyPoolCmdError IO () +runLegacyPoolMetadataHashCmd poolMDPath mOutFile = do metadataBytes <- lift (readByteStringFile poolMDPath) & onLeft (left . ShelleyPoolCmdReadFileError) diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Query.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Query.hs index 7b1f78639e..ebed37135f 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Query.hs @@ -18,7 +18,7 @@ module Cardano.CLI.Legacy.Run.Query , renderOpCertIntervalInformation , renderShelleyQueryCmdError , renderLocalStateQueryError - , runQueryCmds + , runLegacyQueryCmds , toEpochInfo , utcTimeToSlotNo , determineEra @@ -97,47 +97,46 @@ import Text.Printf (printf) {- HLINT ignore "Move brackets to avoid $" -} {- HLINT ignore "Redundant flip" -} -runQueryCmds :: LegacyQueryCmds -> ExceptT ShelleyQueryCmdError IO () -runQueryCmds cmd = - case cmd of - QueryLeadershipSchedule mNodeSocketPath consensusModeParams network shelleyGenFp poolid vrkSkeyFp whichSchedule outputAs -> - runQueryLeadershipSchedule mNodeSocketPath consensusModeParams network shelleyGenFp poolid vrkSkeyFp whichSchedule outputAs - QueryProtocolParameters' mNodeSocketPath consensusModeParams network mOutFile -> - runQueryProtocolParameters mNodeSocketPath consensusModeParams network mOutFile - QueryConstitutionHash mNodeSocketPath consensusModeParams network mOutFile -> - runQueryConstitutionHash mNodeSocketPath consensusModeParams network mOutFile - QueryTip mNodeSocketPath consensusModeParams network mOutFile -> - runQueryTip mNodeSocketPath consensusModeParams network mOutFile - QueryStakePools' mNodeSocketPath consensusModeParams network mOutFile -> - runQueryStakePools mNodeSocketPath consensusModeParams network mOutFile - QueryStakeDistribution' mNodeSocketPath consensusModeParams network mOutFile -> - runQueryStakeDistribution mNodeSocketPath consensusModeParams network mOutFile - QueryStakeAddressInfo mNodeSocketPath consensusModeParams addr network mOutFile -> - runQueryStakeAddressInfo mNodeSocketPath consensusModeParams addr network mOutFile - QueryDebugLedgerState' mNodeSocketPath consensusModeParams network mOutFile -> - runQueryLedgerState mNodeSocketPath consensusModeParams network mOutFile - QueryStakeSnapshot' mNodeSocketPath consensusModeParams network allOrOnlyPoolIds mOutFile -> - runQueryStakeSnapshot mNodeSocketPath consensusModeParams network allOrOnlyPoolIds mOutFile - QueryProtocolState' mNodeSocketPath consensusModeParams network mOutFile -> - runQueryProtocolState mNodeSocketPath consensusModeParams network mOutFile - QueryUTxO' mNodeSocketPath consensusModeParams qFilter networkId mOutFile -> - runQueryUTxO mNodeSocketPath consensusModeParams qFilter networkId mOutFile - QueryKesPeriodInfo mNodeSocketPath consensusModeParams network nodeOpCert mOutFile -> - runQueryKesPeriodInfo mNodeSocketPath consensusModeParams network nodeOpCert mOutFile - QueryPoolState' mNodeSocketPath consensusModeParams network poolid -> - runQueryPoolState mNodeSocketPath consensusModeParams network poolid - QueryTxMempool mNodeSocketPath consensusModeParams network op mOutFile -> - runQueryTxMempool mNodeSocketPath consensusModeParams network op mOutFile - QuerySlotNumber mNodeSocketPath consensusModeParams network utcTime -> - runQuerySlotNumber mNodeSocketPath consensusModeParams network utcTime - -runQueryConstitutionHash +runLegacyQueryCmds :: LegacyQueryCmds -> ExceptT ShelleyQueryCmdError IO () +runLegacyQueryCmds = \case + QueryLeadershipSchedule mNodeSocketPath consensusModeParams network shelleyGenFp poolid vrkSkeyFp whichSchedule outputAs -> + runLegacyQueryLeadershipScheduleCmd mNodeSocketPath consensusModeParams network shelleyGenFp poolid vrkSkeyFp whichSchedule outputAs + QueryProtocolParameters' mNodeSocketPath consensusModeParams network mOutFile -> + runLegacyQueryProtocolParametersCmd mNodeSocketPath consensusModeParams network mOutFile + QueryConstitutionHash mNodeSocketPath consensusModeParams network mOutFile -> + runLegacyQueryConstitutionHashCmd mNodeSocketPath consensusModeParams network mOutFile + QueryTip mNodeSocketPath consensusModeParams network mOutFile -> + runLegacyQueryTipCmd mNodeSocketPath consensusModeParams network mOutFile + QueryStakePools' mNodeSocketPath consensusModeParams network mOutFile -> + runLegacyQueryStakePoolsCmd mNodeSocketPath consensusModeParams network mOutFile + QueryStakeDistribution' mNodeSocketPath consensusModeParams network mOutFile -> + runLegacyQueryStakeDistributionCmd mNodeSocketPath consensusModeParams network mOutFile + QueryStakeAddressInfo mNodeSocketPath consensusModeParams addr network mOutFile -> + runLegacyQueryStakeAddressInfoCmd mNodeSocketPath consensusModeParams addr network mOutFile + QueryDebugLedgerState' mNodeSocketPath consensusModeParams network mOutFile -> + runLegacyQueryLedgerStateCmd mNodeSocketPath consensusModeParams network mOutFile + QueryStakeSnapshot' mNodeSocketPath consensusModeParams network allOrOnlyPoolIds mOutFile -> + runLegacyQueryStakeSnapshotCmd mNodeSocketPath consensusModeParams network allOrOnlyPoolIds mOutFile + QueryProtocolState' mNodeSocketPath consensusModeParams network mOutFile -> + runLegacyQueryProtocolStateCmd mNodeSocketPath consensusModeParams network mOutFile + QueryUTxO' mNodeSocketPath consensusModeParams qFilter networkId mOutFile -> + runLegacyQueryUTxOCmd mNodeSocketPath consensusModeParams qFilter networkId mOutFile + QueryKesPeriodInfo mNodeSocketPath consensusModeParams network nodeOpCert mOutFile -> + runLegacyQueryKesPeriodInfoCmd mNodeSocketPath consensusModeParams network nodeOpCert mOutFile + QueryPoolState' mNodeSocketPath consensusModeParams network poolid -> + runLegacyQueryPoolStateCmd mNodeSocketPath consensusModeParams network poolid + QueryTxMempool mNodeSocketPath consensusModeParams network op mOutFile -> + runLegacyQueryTxMempoolCmd mNodeSocketPath consensusModeParams network op mOutFile + QuerySlotNumber mNodeSocketPath consensusModeParams network utcTime -> + runLegacyQuerySlotNumberCmd mNodeSocketPath consensusModeParams network utcTime + +runLegacyQueryConstitutionHashCmd :: SocketPath -> AnyConsensusModeParams -> NetworkId -> Maybe (File () Out) -> ExceptT ShelleyQueryCmdError IO () -runQueryConstitutionHash socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do +runLegacyQueryConstitutionHashCmd socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath result <- liftIO $ executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do @@ -169,13 +168,13 @@ runQueryConstitutionHash socketPath (AnyConsensusModeParams cModeParams) network handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError fpath) $ LBS.writeFile fpath (encodePretty cHash) -runQueryProtocolParameters +runLegacyQueryProtocolParametersCmd :: SocketPath -> AnyConsensusModeParams -> NetworkId -> Maybe (File () Out) -> ExceptT ShelleyQueryCmdError IO () -runQueryProtocolParameters socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do +runLegacyQueryProtocolParametersCmd socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath result <- liftIO $ executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do @@ -242,13 +241,13 @@ queryChainTipViaChainSync localNodeConnInfo = do "Warning: Local header state query unavailable. Falling back to chain sync query" liftIO $ getLocalChainTip localNodeConnInfo -runQueryTip +runLegacyQueryTipCmd :: SocketPath -> AnyConsensusModeParams -> NetworkId -> Maybe (File () Out) -> ExceptT ShelleyQueryCmdError IO () -runQueryTip socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do +runLegacyQueryTipCmd socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do case consensusModeOnly cModeParams of CardanoMode -> do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath @@ -326,14 +325,14 @@ runQueryTip socketPath (AnyConsensusModeParams cModeParams) network mOutFile = d -- | Query the UTxO, filtered by a given set of addresses, from a Shelley node -- via the local state query protocol. -runQueryUTxO +runLegacyQueryUTxOCmd :: SocketPath -> AnyConsensusModeParams -> QueryUTxOFilter -> NetworkId -> Maybe (File () Out) -> ExceptT ShelleyQueryCmdError IO () -runQueryUTxO socketPath (AnyConsensusModeParams cModeParams) +runLegacyQueryUTxOCmd socketPath (AnyConsensusModeParams cModeParams) qfilter network mOutFile = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath @@ -364,14 +363,14 @@ runQueryUTxO socketPath (AnyConsensusModeParams cModeParams) & onLeft (left . ShelleyQueryCmdAcquireFailure) & onLeft left -runQueryKesPeriodInfo +runLegacyQueryKesPeriodInfoCmd :: SocketPath -> AnyConsensusModeParams -> NetworkId -> File () In -> Maybe (File () Out) -> ExceptT ShelleyQueryCmdError IO () -runQueryKesPeriodInfo socketPath (AnyConsensusModeParams cModeParams) network nodeOpCertFile mOutFile = do +runLegacyQueryKesPeriodInfoCmd socketPath (AnyConsensusModeParams cModeParams) network nodeOpCertFile mOutFile = do opCert <- lift (readFileTextEnvelope AsOperationalCertificate nodeOpCertFile) & onLeft (left . ShelleyQueryCmdOpCertCounterReadError) @@ -648,13 +647,13 @@ renderOpCertIntervalInformation opCertFile opCertInfo = case opCertInfo of -- | Query the current and future parameters for a stake pool, including the retirement date. -- Any of these may be empty (in which case a null will be displayed). -- -runQueryPoolState +runLegacyQueryPoolStateCmd :: SocketPath -> AnyConsensusModeParams -> NetworkId -> [Hash StakePoolKey] -> ExceptT ShelleyQueryCmdError IO () -runQueryPoolState socketPath (AnyConsensusModeParams cModeParams) network poolIds = do +runLegacyQueryPoolStateCmd socketPath (AnyConsensusModeParams cModeParams) network poolIds = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath join $ lift @@ -685,14 +684,14 @@ runQueryPoolState socketPath (AnyConsensusModeParams cModeParams) network poolId & onLeft left -- | Query the local mempool state -runQueryTxMempool +runLegacyQueryTxMempoolCmd :: SocketPath -> AnyConsensusModeParams -> NetworkId -> TxMempoolQuery -> Maybe (File () Out) -> ExceptT ShelleyQueryCmdError IO () -runQueryTxMempool socketPath (AnyConsensusModeParams cModeParams) network query mOutFile = do +runLegacyQueryTxMempoolCmd socketPath (AnyConsensusModeParams cModeParams) network query mOutFile = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath localQuery <- case query of @@ -714,27 +713,27 @@ runQueryTxMempool socketPath (AnyConsensusModeParams cModeParams) network query Just (File oFp) -> handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError oFp) $ LBS.writeFile oFp renderedResult -runQuerySlotNumber +runLegacyQuerySlotNumberCmd :: SocketPath -> AnyConsensusModeParams -> NetworkId -> UTCTime -> ExceptT ShelleyQueryCmdError IO () -runQuerySlotNumber sockPath aCmp network utcTime = do +runLegacyQuerySlotNumberCmd sockPath aCmp network utcTime = do SlotNo slotNo <- utcTimeToSlotNo sockPath aCmp network utcTime liftIO . putStr $ show slotNo -- | Obtain stake snapshot information for a pool, plus information about the total active stake. -- This information can be used for leader slot calculation, for example, and has been requested by SPOs. -- Obtaining the information directly is significantly more time and memory efficient than using a full ledger state dump. -runQueryStakeSnapshot +runLegacyQueryStakeSnapshotCmd :: SocketPath -> AnyConsensusModeParams -> NetworkId -> AllOrOnly [Hash StakePoolKey] -> Maybe (File () Out) -> ExceptT ShelleyQueryCmdError IO () -runQueryStakeSnapshot socketPath (AnyConsensusModeParams cModeParams) network allOrOnlyPoolIds mOutFile = do +runLegacyQueryStakeSnapshotCmd socketPath (AnyConsensusModeParams cModeParams) network allOrOnlyPoolIds mOutFile = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath join $ lift @@ -768,13 +767,13 @@ runQueryStakeSnapshot socketPath (AnyConsensusModeParams cModeParams) network al & onLeft (left . ShelleyQueryCmdAcquireFailure) & onLeft left -runQueryLedgerState +runLegacyQueryLedgerStateCmd :: SocketPath -> AnyConsensusModeParams -> NetworkId -> Maybe (File () Out) -> ExceptT ShelleyQueryCmdError IO () -runQueryLedgerState socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do +runLegacyQueryLedgerStateCmd socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath join $ lift @@ -804,13 +803,13 @@ runQueryLedgerState socketPath (AnyConsensusModeParams cModeParams) network mOut & onLeft (left . ShelleyQueryCmdAcquireFailure) & onLeft left -runQueryProtocolState +runLegacyQueryProtocolStateCmd :: SocketPath -> AnyConsensusModeParams -> NetworkId -> Maybe (File () Out) -> ExceptT ShelleyQueryCmdError IO () -runQueryProtocolState socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do +runLegacyQueryProtocolStateCmd socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath join $ lift @@ -845,14 +844,14 @@ runQueryProtocolState socketPath (AnyConsensusModeParams cModeParams) network mO -- | Query the current delegations and reward accounts, filtered by a given -- set of addresses, from a Shelley node via the local state query protocol. -runQueryStakeAddressInfo +runLegacyQueryStakeAddressInfoCmd :: SocketPath -> AnyConsensusModeParams -> StakeAddress -> NetworkId -> Maybe (File () Out) -> ExceptT ShelleyQueryCmdError IO () -runQueryStakeAddressInfo socketPath (AnyConsensusModeParams cModeParams) (StakeAddress _ addr) network mOutFile = do +runLegacyQueryStakeAddressInfoCmd socketPath (AnyConsensusModeParams cModeParams) (StakeAddress _ addr) network mOutFile = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath join $ lift @@ -1081,13 +1080,13 @@ printUtxo sbe txInOutTuple = printableValue (TxOutValue _ val) = renderValue val printableValue (TxOutAdaOnly _ (Lovelace i)) = Text.pack $ show i -runQueryStakePools +runLegacyQueryStakePoolsCmd :: SocketPath -> AnyConsensusModeParams -> NetworkId -> Maybe (File () Out) -> ExceptT ShelleyQueryCmdError IO () -runQueryStakePools socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do +runLegacyQueryStakePoolsCmd socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath join $ lift @@ -1126,13 +1125,13 @@ writeStakePools Nothing stakePools = forM_ (Set.toList stakePools) $ \poolId -> liftIO . putStrLn $ Text.unpack (serialiseToBech32 poolId) -runQueryStakeDistribution +runLegacyQueryStakeDistributionCmd :: SocketPath -> AnyConsensusModeParams -> NetworkId -> Maybe (File () Out) -> ExceptT ShelleyQueryCmdError IO () -runQueryStakeDistribution socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do +runLegacyQueryStakeDistributionCmd socketPath (AnyConsensusModeParams cModeParams) network mOutFile = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams network socketPath join $ lift @@ -1253,7 +1252,7 @@ instance FromJSON DelegationsAndRewards where rewardAccountBalance <- o .:? "rewardAccountBalance" pure (address, rewardAccountBalance, delegation) -runQueryLeadershipSchedule +runLegacyQueryLeadershipScheduleCmd :: SocketPath -> AnyConsensusModeParams -> NetworkId @@ -1263,7 +1262,7 @@ runQueryLeadershipSchedule -> EpochLeadershipSchedule -> Maybe (File () Out) -> ExceptT ShelleyQueryCmdError IO () -runQueryLeadershipSchedule +runLegacyQueryLeadershipScheduleCmd socketPath (AnyConsensusModeParams cModeParams) network (GenesisFile genFile) coldVerKeyFile vrfSkeyFp whichSchedule mJsonOutputFile = do diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/StakeAddress.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/StakeAddress.hs index b979843c94..d364153171 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/StakeAddress.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/StakeAddress.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-} @@ -8,8 +9,8 @@ module Cardano.CLI.Legacy.Run.StakeAddress ( ShelleyStakeAddressCmdError(ShelleyStakeAddressCmdReadKeyFileError) , getStakeCredentialFromIdentifier - , runStakeAddressCmds - , runStakeAddressKeyGenToFile + , runLegacyStakeAddressCmds + , runLegacyStakeAddressKeyGenToFileCmd , createDelegationCertRequirements , createRegistrationCertRequirements @@ -38,28 +39,31 @@ import qualified Data.ByteString.Char8 as BS import Data.Function ((&)) import qualified Data.Text.IO as Text -runStakeAddressCmds :: LegacyStakeAddressCmds -> ExceptT ShelleyStakeAddressCmdError IO () -runStakeAddressCmds (StakeAddressKeyGen fmt vk sk) = runStakeAddressKeyGenToFile fmt vk sk -runStakeAddressCmds (StakeAddressKeyHash vk mOutputFp) = runStakeAddressKeyHash vk mOutputFp -runStakeAddressCmds (StakeAddressBuild stakeVerifier nw mOutputFp) = - runStakeAddressBuild stakeVerifier nw mOutputFp -runStakeAddressCmds (StakeRegistrationCert anyEra stakeIdentifier mDeposit outputFp) = - runStakeCredentialRegistrationCert anyEra stakeIdentifier mDeposit outputFp -runStakeAddressCmds (StakeCredentialDelegationCert anyEra stakeIdentifier stkPoolVerKeyHashOrFp outputFp) = - runStakeCredentialDelegationCert anyEra stakeIdentifier stkPoolVerKeyHashOrFp outputFp -runStakeAddressCmds (StakeCredentialDeRegistrationCert anyEra stakeIdentifier mDeposit outputFp) = - runStakeCredentialDeRegistrationCert anyEra stakeIdentifier mDeposit outputFp +runLegacyStakeAddressCmds :: LegacyStakeAddressCmds -> ExceptT ShelleyStakeAddressCmdError IO () +runLegacyStakeAddressCmds = \case + StakeAddressKeyGen fmt vk sk -> + runLegacyStakeAddressKeyGenToFileCmd fmt vk sk + StakeAddressKeyHash vk mOutputFp -> + runLegacyStakeAddressKeyHashCmd vk mOutputFp + StakeAddressBuild stakeVerifier nw mOutputFp -> + runLegacyStakeAddressBuildCmd stakeVerifier nw mOutputFp + StakeRegistrationCert anyEra stakeIdentifier mDeposit outputFp -> + runLegacyStakeCredentialRegistrationCertCmd anyEra stakeIdentifier mDeposit outputFp + StakeCredentialDelegationCert anyEra stakeIdentifier stkPoolVerKeyHashOrFp outputFp -> + runLegacyStakeCredentialDelegationCertCmd anyEra stakeIdentifier stkPoolVerKeyHashOrFp outputFp + StakeCredentialDeRegistrationCert anyEra stakeIdentifier mDeposit outputFp -> + runLegacyStakeCredentialDeRegistrationCertCmd anyEra stakeIdentifier mDeposit outputFp -- -- Stake address command implementations -- -runStakeAddressKeyGenToFile +runLegacyStakeAddressKeyGenToFileCmd :: KeyOutputFormat -> VerificationKeyFile Out -> SigningKeyFile Out -> ExceptT ShelleyStakeAddressCmdError IO () -runStakeAddressKeyGenToFile fmt vkFp skFp = do +runLegacyStakeAddressKeyGenToFileCmd fmt vkFp skFp = do let skeyDesc = "Stake Signing Key" let vkeyDesc = "Stake Verification Key" @@ -80,11 +84,11 @@ runStakeAddressKeyGenToFile fmt vkFp skFp = do KeyOutputFormatBech32 -> newExceptT $ writeTextFile vkFp $ serialiseToBech32 vkey -runStakeAddressKeyHash +runLegacyStakeAddressKeyHashCmd :: VerificationKeyOrFile StakeKey -> Maybe (File () Out) -> ExceptT ShelleyStakeAddressCmdError IO () -runStakeAddressKeyHash stakeVerKeyOrFile mOutputFp = do +runLegacyStakeAddressKeyHashCmd stakeVerKeyOrFile mOutputFp = do vkey <- firstExceptT ShelleyStakeAddressCmdReadKeyFileError . newExceptT $ readVerificationKeyOrFile AsStakeKey stakeVerKeyOrFile @@ -95,12 +99,12 @@ runStakeAddressKeyHash stakeVerKeyOrFile mOutputFp = do Just (File fpath) -> liftIO $ BS.writeFile fpath hexKeyHash Nothing -> liftIO $ BS.putStrLn hexKeyHash -runStakeAddressBuild +runLegacyStakeAddressBuildCmd :: StakeVerifier -> NetworkId -> Maybe (File () Out) -> ExceptT ShelleyStakeAddressCmdError IO () -runStakeAddressBuild stakeVerifier network mOutputFp = do +runLegacyStakeAddressBuildCmd stakeVerifier network mOutputFp = do stakeAddr <- getStakeAddressFromVerifier network stakeVerifier & firstExceptT ShelleyStakeAddressCmdStakeCredentialError @@ -111,13 +115,13 @@ runStakeAddressBuild stakeVerifier network mOutputFp = do Nothing -> Text.putStrLn stakeAddrText -runStakeCredentialRegistrationCert +runLegacyStakeCredentialRegistrationCertCmd :: AnyShelleyBasedEra -> StakeIdentifier -> Maybe Lovelace -- ^ Deposit required in conway era -> File () Out -> ExceptT ShelleyStakeAddressCmdError IO () -runStakeCredentialRegistrationCert anyEra stakeIdentifier mDeposit oFp = do +runLegacyStakeCredentialRegistrationCertCmd anyEra stakeIdentifier mDeposit oFp = do AnyShelleyBasedEra sbe <- pure anyEra stakeCred <- getStakeCredentialFromIdentifier stakeIdentifier @@ -167,7 +171,7 @@ createRegistrationCertRequirements sbe stakeCred mdeposit = return $ StakeAddrRegistrationConway ConwayEraOnwardsConway dep stakeCred -runStakeCredentialDelegationCert +runLegacyStakeCredentialDelegationCertCmd :: AnyShelleyBasedEra -> StakeIdentifier -- ^ Delegator stake verification key, verification key file or script file. @@ -176,7 +180,7 @@ runStakeCredentialDelegationCert -- verification key hash. -> File () Out -> ExceptT ShelleyStakeAddressCmdError IO () -runStakeCredentialDelegationCert anyEra stakeVerifier delegationTarget outFp = do +runLegacyStakeCredentialDelegationCertCmd anyEra stakeVerifier delegationTarget outFp = do AnyShelleyBasedEra sbe <- pure anyEra case delegationTarget of StakePoolDelegationTarget poolVKeyOrHashOrFile -> do @@ -232,13 +236,13 @@ onlySpoDelegatee w ledgerDelegatee = Ledger.DelegStakeVote{} -> Left . VoteDelegationNotSupported $ AnyShelleyToBabbageEra w -runStakeCredentialDeRegistrationCert +runLegacyStakeCredentialDeRegistrationCertCmd :: AnyShelleyBasedEra -> StakeIdentifier -> Maybe Lovelace -- ^ Deposit required in conway era -> File () Out -> ExceptT ShelleyStakeAddressCmdError IO () -runStakeCredentialDeRegistrationCert anyEra stakeVerifier mDeposit oFp = do +runLegacyStakeCredentialDeRegistrationCertCmd anyEra stakeVerifier mDeposit oFp = do AnyShelleyBasedEra sbe <- pure anyEra stakeCred <- getStakeCredentialFromIdentifier stakeVerifier diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/TextView.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/TextView.hs index b593f55422..dd8b7b07a5 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/TextView.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/TextView.hs @@ -1,7 +1,8 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} module Cardano.CLI.Legacy.Run.TextView - ( runTextViewCmds + ( runLegacyTextViewCmds ) where import Cardano.Api @@ -15,13 +16,12 @@ import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Except.Extra (firstExceptT, newExceptT) import qualified Data.ByteString.Lazy.Char8 as LBS -runTextViewCmds :: LegacyTextViewCmds -> ExceptT ShelleyTextViewFileError IO () -runTextViewCmds cmd = - case cmd of - TextViewInfo fpath mOutfile -> runTextViewInfo fpath mOutfile +runLegacyTextViewCmds :: LegacyTextViewCmds -> ExceptT ShelleyTextViewFileError IO () +runLegacyTextViewCmds = \case + TextViewInfo fpath mOutfile -> runLegacyTextViewInfoCmd fpath mOutfile -runTextViewInfo :: FilePath -> Maybe (File () Out) -> ExceptT ShelleyTextViewFileError IO () -runTextViewInfo fpath mOutFile = do +runLegacyTextViewInfoCmd :: FilePath -> Maybe (File () Out) -> ExceptT ShelleyTextViewFileError IO () +runLegacyTextViewInfoCmd fpath mOutFile = do tv <- firstExceptT TextViewReadFileError $ newExceptT (readTextEnvelopeFromFile fpath) let lbCBOR = LBS.fromStrict (textEnvelopeRawCBOR tv) case mOutFile of diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs index fe702bdbb6..7e25a35ff4 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs @@ -13,7 +13,7 @@ {- HLINT ignore "Use let" -} module Cardano.CLI.Legacy.Run.Transaction - ( runTransactionCmds + ( runLegacyTransactionCmds , readFileTx , toTxOutInAnyEra ) where @@ -61,44 +61,49 @@ import qualified Data.Text.IO as Text import Data.Type.Equality (TestEquality (..)) import qualified System.IO as IO -runTransactionCmds :: LegacyTransactionCmds -> ExceptT ShelleyTxCmdError IO () -runTransactionCmds cmd = +runLegacyTransactionCmds :: LegacyTransactionCmds -> ExceptT ShelleyTxCmdError IO () +runLegacyTransactionCmds cmd = case cmd of TxBuild mNodeSocketPath era consensusModeParams nid mScriptValidity mOverrideWits txins readOnlyRefIns reqSigners txinsc mReturnColl mTotCollateral txouts changeAddr mValue mLowBound mUpperBound certs wdrls metadataSchema scriptFiles metadataFiles mUpProp mconwayVote mNewConstitution outputOptions -> do - runTxBuildCmd mNodeSocketPath era consensusModeParams nid mScriptValidity mOverrideWits txins readOnlyRefIns + runLegacyTxBuildCmd mNodeSocketPath era consensusModeParams nid mScriptValidity mOverrideWits txins readOnlyRefIns reqSigners txinsc mReturnColl mTotCollateral txouts changeAddr mValue mLowBound mUpperBound certs wdrls metadataSchema scriptFiles metadataFiles mUpProp mconwayVote mNewConstitution outputOptions TxBuildRaw era mScriptValidity txins readOnlyRefIns txinsc mReturnColl mTotColl reqSigners txouts mValue mLowBound mUpperBound fee certs wdrls metadataSchema scriptFiles metadataFiles mProtocolParamsFile mUpProp out -> do - runTxBuildRawCmd era mScriptValidity txins readOnlyRefIns txinsc mReturnColl + runLegacyTxBuildRawCmd era mScriptValidity txins readOnlyRefIns txinsc mReturnColl mTotColl reqSigners txouts mValue mLowBound mUpperBound fee certs wdrls metadataSchema scriptFiles metadataFiles mProtocolParamsFile mUpProp out TxSign txinfile skfiles network txoutfile -> - runTxSign txinfile skfiles network txoutfile + runLegacyTxSignCmd txinfile skfiles network txoutfile TxSubmit mNodeSocketPath anyConsensusModeParams network txFp -> - runTxSubmit mNodeSocketPath anyConsensusModeParams network txFp + runLegacyTxSubmitCmd mNodeSocketPath anyConsensusModeParams network txFp TxCalculateMinFee txbody nw pParamsFile nInputs nOutputs nShelleyKeyWitnesses nByronKeyWitnesses -> - runTxCalculateMinFee txbody nw pParamsFile nInputs nOutputs nShelleyKeyWitnesses nByronKeyWitnesses - TxCalculateMinRequiredUTxO era pParamsFile txOuts -> runTxCalculateMinRequiredUTxO era pParamsFile txOuts - TxHashScriptData scriptDataOrFile -> runTxHashScriptData scriptDataOrFile - TxGetTxId txinfile -> runTxGetTxId txinfile - TxView txinfile -> runTxView txinfile - TxMintedPolicyId sFile -> runTxCreatePolicyId sFile + runLegacyTxCalculateMinFeeCmd txbody nw pParamsFile nInputs nOutputs nShelleyKeyWitnesses nByronKeyWitnesses + TxCalculateMinRequiredUTxO era pParamsFile txOuts -> + runLegacyTxCalculateMinRequiredUTxOCmd era pParamsFile txOuts + TxHashScriptData scriptDataOrFile -> + runLegacyTxHashScriptDataCmd scriptDataOrFile + TxGetTxId txinfile -> + runLegacyTxGetTxIdCmd txinfile + TxView txinfile -> + runLegacyTxViewCmd txinfile + TxMintedPolicyId sFile -> + runLegacyTxCreatePolicyIdCmd sFile TxCreateWitness txBodyfile witSignData mbNw outFile -> - runTxCreateWitness txBodyfile witSignData mbNw outFile + runLegacyTxCreateWitnessCmd txBodyfile witSignData mbNw outFile TxAssembleTxBodyWitness txBodyFile witnessFile outFile -> - runTxSignWitness txBodyFile witnessFile outFile + runLegacyTxSignWitnessCmd txBodyFile witnessFile outFile -- ---------------------------------------------------------------------------- -- Building transactions -- -runTxBuildCmd +runLegacyTxBuildCmd :: SocketPath -> AnyCardanoEra -> AnyConsensusModeParams @@ -126,7 +131,7 @@ runTxBuildCmd -> [ProposalFile In] -> TxBuildOutputOptions -> ExceptT ShelleyTxCmdError IO () -runTxBuildCmd +runLegacyTxBuildCmd socketPath (AnyCardanoEra cEra) consensusModeParams@(AnyConsensusModeParams cModeParams) nid mScriptValidity mOverrideWits txins readOnlyRefIns reqSigners txinsc mReturnColl mTotCollateral txouts changeAddr mValue mLowBound mUpperBound certs wdrls metadataSchema scriptFiles metadataFiles mUpProp @@ -262,7 +267,7 @@ runTxBuildCmd & onLeft (left . ShelleyTxCmdWriteFileError) -runTxBuildRawCmd +runLegacyTxBuildRawCmd :: AnyCardanoEra -> Maybe ScriptValidity -> [(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))] @@ -285,7 +290,7 @@ runTxBuildRawCmd -> Maybe UpdateProposalFile -> TxBodyFile Out -> ExceptT ShelleyTxCmdError IO () -runTxBuildRawCmd +runLegacyTxBuildRawCmd (AnyCardanoEra cEra) mScriptValidity txins readOnlyRefIns txinsc mReturnColl mTotColl reqSigners txouts mValue mLowBound mUpperBound fee certs wdrls metadataSchema scriptFiles metadataFiles mpParamsFile mUpProp out = do @@ -857,12 +862,12 @@ readValueScriptWitnesses era (v, sWitFiles) = do -- Transaction signing -- -runTxSign :: InputTxBodyOrTxFile +runLegacyTxSignCmd :: InputTxBodyOrTxFile -> [WitnessSigningData] -> Maybe NetworkId -> TxFile Out -> ExceptT ShelleyTxCmdError IO () -runTxSign txOrTxBody witSigningData mnw outTxFile = do +runLegacyTxSignCmd txOrTxBody witSigningData mnw outTxFile = do sks <- mapM (firstExceptT ShelleyTxCmdReadWitnessSigningDataError . newExceptT . readWitnessSigningData) witSigningData let (sksByron, sksShelley) = partitionSomeWitnesses $ map categoriseSomeWitness sks @@ -933,13 +938,13 @@ runTxSign txOrTxBody witSigningData mnw outTxFile = do -- -runTxSubmit +runLegacyTxSubmitCmd :: SocketPath -> AnyConsensusModeParams -> NetworkId -> FilePath -> ExceptT ShelleyTxCmdError IO () -runTxSubmit socketPath (AnyConsensusModeParams cModeParams) network txFilePath = do +runLegacyTxSubmitCmd socketPath (AnyConsensusModeParams cModeParams) network txFilePath = do txFile <- liftIO $ fileOrPipe txFilePath InAnyCardanoEra era tx <- lift (readFileTx txFile) & onLeft (left . ShelleyTxCmdCddlError) let cMode = AnyConsensusMode $ consensusModeOnly cModeParams @@ -965,7 +970,7 @@ runTxSubmit socketPath (AnyConsensusModeParams cModeParams) network txFilePath = -- Transaction fee calculation -- -runTxCalculateMinFee +runLegacyTxCalculateMinFeeCmd :: TxBodyFile In -> NetworkId -> ProtocolParamsFile @@ -974,7 +979,7 @@ runTxCalculateMinFee -> TxShelleyWitnessCount -> TxByronWitnessCount -> ExceptT ShelleyTxCmdError IO () -runTxCalculateMinFee (File txbodyFilePath) nw pParamsFile +runLegacyTxCalculateMinFeeCmd (File txbodyFilePath) nw pParamsFile (TxInCount nInputs) (TxOutCount nOutputs) (TxShelleyWitnessCount nShelleyKeyWitnesses) (TxByronWitnessCount nByronKeyWitnesses) = do @@ -1019,16 +1024,16 @@ runTxCalculateMinFee (File txbodyFilePath) nw pParamsFile -- Transaction fee calculation -- -runTxCalculateMinRequiredUTxO +runLegacyTxCalculateMinRequiredUTxOCmd :: AnyCardanoEra -> ProtocolParamsFile -> TxOutAnyEra -> ExceptT ShelleyTxCmdError IO () -runTxCalculateMinRequiredUTxO (AnyCardanoEra era) pParamsFile txOut = do +runLegacyTxCalculateMinRequiredUTxOCmd (AnyCardanoEra era) pParamsFile txOut = do pp <- firstExceptT ShelleyTxCmdProtocolParamsError (readProtocolParameters pParamsFile) out <- toTxOutInAnyEra era txOut case cardanoEraStyle era of - LegacyByronEra -> error "runTxCalculateMinRequiredUTxO: Byron era not implemented yet" + LegacyByronEra -> error "runLegacyTxCalculateMinRequiredUTxOCmd: Byron era not implemented yet" ShelleyBasedEra sbe -> do firstExceptT ShelleyTxCmdPParamsErr . hoistEither $ checkProtocolParameters sbe pp @@ -1036,8 +1041,8 @@ runTxCalculateMinRequiredUTxO (AnyCardanoEra era) pParamsFile txOut = do let minValue = calculateMinimumUTxO sbe out pp' liftIO . IO.print $ minValue -runTxCreatePolicyId :: ScriptFile -> ExceptT ShelleyTxCmdError IO () -runTxCreatePolicyId (ScriptFile sFile) = do +runLegacyTxCreatePolicyIdCmd :: ScriptFile -> ExceptT ShelleyTxCmdError IO () +runLegacyTxCreatePolicyIdCmd (ScriptFile sFile) = do ScriptInAnyLang _ script <- firstExceptT ShelleyTxCmdScriptFileError $ readFileScriptInAnyLang sFile liftIO . Text.putStrLn . serialiseToRawBytesHexText $ hashScript script @@ -1094,13 +1099,13 @@ mkShelleyBootstrapWitnesses mnw txBody = -- Other misc small commands -- -runTxHashScriptData :: ScriptDataOrFile -> ExceptT ShelleyTxCmdError IO () -runTxHashScriptData scriptDataOrFile = do +runLegacyTxHashScriptDataCmd :: ScriptDataOrFile -> ExceptT ShelleyTxCmdError IO () +runLegacyTxHashScriptDataCmd scriptDataOrFile = do d <- firstExceptT ShelleyTxCmdScriptDataError $ readScriptDataOrFile scriptDataOrFile liftIO $ BS.putStrLn $ serialiseToRawBytesHex (hashScriptDataBytes d) -runTxGetTxId :: InputTxBodyOrTxFile -> ExceptT ShelleyTxCmdError IO () -runTxGetTxId txfile = do +runLegacyTxGetTxIdCmd :: InputTxBodyOrTxFile -> ExceptT ShelleyTxCmdError IO () +runLegacyTxGetTxIdCmd txfile = do InAnyCardanoEra _era txbody <- case txfile of InputTxBodyFile (File txbodyFilePath) -> do @@ -1119,8 +1124,8 @@ runTxGetTxId txfile = do liftIO $ BS.putStrLn $ serialiseToRawBytesHex (getTxId txbody) -runTxView :: InputTxBodyOrTxFile -> ExceptT ShelleyTxCmdError IO () -runTxView = \case +runLegacyTxViewCmd :: InputTxBodyOrTxFile -> ExceptT ShelleyTxCmdError IO () +runLegacyTxViewCmd = \case InputTxBodyFile (File txbodyFilePath) -> do txbodyFile <- liftIO $ fileOrPipe txbodyFilePath unwitnessed <- firstExceptT ShelleyTxCmdCddlError . newExceptT @@ -1144,13 +1149,13 @@ runTxView = \case -- Witness commands -- -runTxCreateWitness +runLegacyTxCreateWitnessCmd :: TxBodyFile In -> WitnessSigningData -> Maybe NetworkId -> File () Out -> ExceptT ShelleyTxCmdError IO () -runTxCreateWitness (File txbodyFilePath) witSignData mbNw oFile = do +runLegacyTxCreateWitnessCmd (File txbodyFilePath) witSignData mbNw oFile = do txbodyFile <- liftIO $ fileOrPipe txbodyFilePath unwitnessed <- firstExceptT ShelleyTxCmdCddlError . newExceptT $ readFileTxBody txbodyFile @@ -1198,12 +1203,12 @@ runTxCreateWitness (File txbodyFilePath) witSignData mbNw oFile = do $ writeLazyByteStringFile oFile $ textEnvelopeToJSON Nothing witness -runTxSignWitness +runLegacyTxSignWitnessCmd :: TxBodyFile In -> [WitnessFile] -> File () Out -> ExceptT ShelleyTxCmdError IO () -runTxSignWitness (File txbodyFilePath) witnessFiles oFp = do +runLegacyTxSignWitnessCmd (File txbodyFilePath) witnessFiles oFp = do txbodyFile <- liftIO $ fileOrPipe txbodyFilePath unwitnessed <- firstExceptT ShelleyTxCmdCddlError . newExceptT $ readFileTxBody txbodyFile diff --git a/cardano-cli/src/Cardano/CLI/Read.hs b/cardano-cli/src/Cardano/CLI/Read.hs index 4e2fe73037..9bebd98072 100644 --- a/cardano-cli/src/Cardano/CLI/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Read.hs @@ -4,7 +4,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} module Cardano.CLI.Read ( -- * Metadata