From 17ed5c5ad8b392c48fbd225b2c10670d6c5ff8ee Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 18 Nov 2020 17:44:24 +0000 Subject: [PATCH] Replace CardanoEra with ByronKeyFormat --- cardano-cli/src/Cardano/CLI/Byron/Commands.hs | 25 +++--- .../src/Cardano/CLI/Byron/Delegation.hs | 17 ++-- cardano-cli/src/Cardano/CLI/Byron/Genesis.hs | 6 +- cardano-cli/src/Cardano/CLI/Byron/Key.hs | 32 +++----- cardano-cli/src/Cardano/CLI/Byron/Parsers.hs | 33 ++++---- cardano-cli/src/Cardano/CLI/Byron/Run.hs | 77 ++++++++++--------- .../src/Cardano/CLI/Byron/UpdateProposal.hs | 6 +- cardano-cli/src/Cardano/CLI/Byron/Vote.hs | 5 +- cardano-cli/src/Cardano/CLI/Run.hs | 1 - .../src/Cardano/CLI/Shelley/Run/Key.hs | 9 +-- 10 files changed, 97 insertions(+), 114 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Byron/Commands.hs b/cardano-cli/src/Cardano/CLI/Byron/Commands.hs index 59e0e577042..9f1f1addaea 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Commands.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Commands.hs @@ -26,6 +26,7 @@ import Cardano.CLI.Types import Cardano.Chain.Common (Address (..)) import Cardano.Chain.UTxO (TxIn (..), TxOut (..)) +import Cardano.CLI.Shelley.Commands (ByronKeyFormat) data ByronCommand = @@ -36,36 +37,36 @@ data ByronCommand = | Genesis NewDirectory GenesisParameters - CardanoEra + ByronKeyFormat | PrintGenesisHash GenesisFile --- Key Related Commands --- | Keygen - CardanoEra + ByronKeyFormat NewSigningKeyFile PasswordRequirement | ToVerification - CardanoEra + ByronKeyFormat SigningKeyFile NewVerificationKeyFile | PrettySigningKeyPublic - CardanoEra + ByronKeyFormat SigningKeyFile | MigrateDelegateKeyFrom - CardanoEra - -- ^ Old CardanoEra + ByronKeyFormat + -- ^ Old ByronKeyFormat SigningKeyFile -- ^ Old key - CardanoEra - -- ^ New CardanoEra + ByronKeyFormat + -- ^ New ByronKeyFormat NewSigningKeyFile -- ^ New Key | PrintSigningKeyAddress - CardanoEra + ByronKeyFormat NetworkId SigningKeyFile @@ -73,7 +74,7 @@ data ByronCommand = | IssueDelegationCertificate NetworkId - CardanoEra + ByronKeyFormat EpochNumber -- ^ The epoch from which the delegation is valid. SigningKeyFile @@ -101,7 +102,7 @@ data ByronCommand = | SpendGenesisUTxO GenesisFile NetworkId - CardanoEra + ByronKeyFormat NewTxFile -- ^ Filepath of the newly created transaction. SigningKeyFile @@ -112,7 +113,7 @@ data ByronCommand = -- ^ Tx output. | SpendUTxO NetworkId - CardanoEra + ByronKeyFormat NewTxFile -- ^ Filepath of the newly created transaction. SigningKeyFile diff --git a/cardano-cli/src/Cardano/CLI/Byron/Delegation.hs b/cardano-cli/src/Cardano/CLI/Byron/Delegation.hs index f65bbcf4183..766457e0ddd 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Delegation.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Delegation.hs @@ -26,9 +26,9 @@ import qualified Cardano.CLI.Byron.Legacy as Legacy import Cardano.Crypto (ProtocolMagicId, SigningKey) import qualified Cardano.Crypto as Crypto -import Cardano.CLI.Byron.Key (ByronKeyFailure, CardanoEra (..), renderByronKeyFailure, - serialiseSigningKey) +import Cardano.CLI.Byron.Key (ByronKeyFailure, renderByronKeyFailure, serialiseSigningKey) import Cardano.CLI.Helpers (textShow) +import Cardano.CLI.Shelley.Commands (ByronKeyFormat (..)) import Cardano.CLI.Types (CertificateFile (..)) data ByronDelegationError @@ -117,11 +117,8 @@ checkDlgCert cert magic issuerVK' delegateVK' = serialiseDelegationCert :: Dlg.Certificate -> LB.ByteString serialiseDelegationCert = canonicalEncodePretty -serialiseDelegateKey :: CardanoEra -> SigningKey -> Either ByronDelegationError LB.ByteString -serialiseDelegateKey ByronEraLegacy sk = pure - . toLazyByteString - . Legacy.encodeLegacyDelegateKey - $ Legacy.LegacyDelegateKey sk -serialiseDelegateKey ByronEra sk = - first ByronDelegationKeyError $ - serialiseSigningKey ByronEra sk +serialiseDelegateKey :: ByronKeyFormat -> SigningKey -> Either ByronDelegationError LB.ByteString +serialiseDelegateKey LegacyByronKeyFormat sk = + pure . toLazyByteString . Legacy.encodeLegacyDelegateKey $ Legacy.LegacyDelegateKey sk +serialiseDelegateKey NonLegacyByronKeyFormat sk = + first ByronDelegationKeyError $ serialiseSigningKey NonLegacyByronKeyFormat sk diff --git a/cardano-cli/src/Cardano/CLI/Byron/Genesis.hs b/cardano-cli/src/Cardano/CLI/Byron/Genesis.hs index 07db662b910..9626df0c07d 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Genesis.hs @@ -48,12 +48,12 @@ import qualified Cardano.Crypto as Crypto import Cardano.CLI.Byron.Delegation import Cardano.CLI.Byron.Key import Cardano.CLI.Helpers (textShow) +import Cardano.CLI.Shelley.Commands (ByronKeyFormat (..)) import Cardano.CLI.Types (GenesisFile (..)) data ByronGenesisError = ByronDelegationCertSerializationError !ByronDelegationError | ByronDelegationKeySerializationError ByronDelegationError - | ByronGenesisCardanoEraNotSupported !CardanoEra | GenesisGenerationError !Genesis.GenesisDataGenerationError | GenesisOutputDirAlreadyExists FilePath | GenesisReadError !FilePath !Genesis.GenesisDataError @@ -80,8 +80,6 @@ renderByronGenesisError err = "Error creating genesis delegation: " <> textShow genDelegError GenesisGenerationError genDataGenError -> "Error generating genesis: " <> textShow genDataGenError - ByronGenesisCardanoEraNotSupported era -> - "Error while serialising genesis, " <> textShow era <> " is not supported." GenesisOutputDirAlreadyExists genOutDir -> "Genesis output directory already exists: " <> textShow genOutDir GenesisReadError genFp genDataError -> @@ -172,7 +170,7 @@ readGenesis (GenesisFile file) nw = -- thrown if the directory already exists, or the genesis has delegate keys that -- are not delegated to. dumpGenesis - :: CardanoEra + :: ByronKeyFormat -> NewDirectory -> Genesis.GenesisData -> Genesis.GeneratedSecrets diff --git a/cardano-cli/src/Cardano/CLI/Byron/Key.hs b/cardano-cli/src/Cardano/CLI/Byron/Key.hs index 1b121b638fd..00877a50f61 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Key.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Key.hs @@ -6,7 +6,6 @@ module Cardano.CLI.Byron.Key , NewSigningKeyFile(..) , NewVerificationKeyFile(..) , VerificationKeyFile(..) - , CardanoEra(..) , serialiseSigningKey , deserialiseSigningKey , keygen @@ -43,6 +42,7 @@ import qualified Cardano.Chain.Common as Common import qualified Cardano.Chain.Genesis as Genesis import qualified Cardano.CLI.Byron.Legacy as Legacy import Cardano.CLI.Helpers (textShow) +import Cardano.CLI.Shelley.Commands (ByronKeyFormat (..)) import Cardano.CLI.Types import Cardano.Crypto (SigningKey (..)) import qualified Cardano.Crypto.Random as Crypto @@ -85,27 +85,21 @@ data PasswordRequirement type PasswordPrompt = String -- | Some commands have variants or file formats that depend on the era. --- --- TODO: this looks like it's only used for Byron era keys, so could be renamed --- -data CardanoEra = ByronEraLegacy | ByronEra - deriving Show serialiseSigningKey - :: CardanoEra + :: ByronKeyFormat -> Crypto.SigningKey -> Either ByronKeyFailure LB.ByteString -serialiseSigningKey ByronEraLegacy (Crypto.SigningKey k) = pure $ toLazyByteString (Crypto.toCBORXPrv k) -serialiseSigningKey ByronEra (Crypto.SigningKey k) = pure $ toLazyByteString (Crypto.toCBORXPrv k) +serialiseSigningKey _ (Crypto.SigningKey k) = pure $ toLazyByteString (Crypto.toCBORXPrv k) -deserialiseSigningKey :: CardanoEra -> FilePath -> LB.ByteString +deserialiseSigningKey :: ByronKeyFormat -> FilePath -> LB.ByteString -> Either ByronKeyFailure SigningKey -deserialiseSigningKey ByronEraLegacy fp delSkey = +deserialiseSigningKey LegacyByronKeyFormat fp delSkey = case deserialiseFromBytes Legacy.decodeLegacyDelegateKey delSkey of Left deSerFail -> Left $ SigningKeyDeserialisationFailed fp deSerFail Right (_, Legacy.LegacyDelegateKey sKey ) -> pure sKey -deserialiseSigningKey ByronEra fp delSkey = +deserialiseSigningKey NonLegacyByronKeyFormat fp delSkey = case deserialiseFromBytes Crypto.fromCBORXPrv delSkey of Left deSerFail -> Left $ SigningKeyDeserialisationFailed fp deSerFail Right (_, sKey) -> Right $ SigningKey sKey @@ -123,12 +117,12 @@ prettyPublicKey vk = -- TODO: we need to support password-protected secrets. -- | Read signing key from a file. Throw an error if the file can't be read or -- fails to deserialise. -readEraSigningKey :: CardanoEra -> SigningKeyFile -> ExceptT ByronKeyFailure IO SigningKey -readEraSigningKey era (SigningKeyFile fp) = do +readEraSigningKey :: ByronKeyFormat -> SigningKeyFile -> ExceptT ByronKeyFailure IO SigningKey +readEraSigningKey bKeyFormat (SigningKeyFile fp) = do sK <- handleIOExceptT (ReadSigningKeyFailure fp . T.pack . displayException) $ LB.readFile fp -- Signing Key - hoistEither $ deserialiseSigningKey era fp sK + hoistEither $ deserialiseSigningKey bKeyFormat fp sK -- | Read verification key from a file. Throw an error if the file can't be read -- or the key fails to deserialise. @@ -141,12 +135,10 @@ readPaymentVerificationKey (VerificationKeyFile fp) = do firstExceptT (VerificationKeyDeserialisationFailed fp . T.pack . show) eVk -serialisePoorKey :: CardanoEra -> Genesis.PoorSecret +serialisePoorKey :: ByronKeyFormat -> Genesis.PoorSecret -> Either ByronKeyFailure LB.ByteString -serialisePoorKey ByronEraLegacy ps = - serialiseSigningKey ByronEraLegacy $ Genesis.poorSecretToKey ps -serialisePoorKey ByronEra ps = - serialiseSigningKey ByronEra $ Genesis.poorSecretToKey ps +serialisePoorKey bKeyFormat ps = + serialiseSigningKey bKeyFormat $ Genesis.poorSecretToKey ps -- | Generate a cryptographically random signing key, -- protected with a (potentially empty) passphrase. diff --git a/cardano-cli/src/Cardano/CLI/Byron/Parsers.hs b/cardano-cli/src/Cardano/CLI/Byron/Parsers.hs index dbb04b0e7f3..f507c5b103b 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Parsers.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Parsers.hs @@ -58,6 +58,7 @@ import Cardano.CLI.Byron.Key import Cardano.CLI.Byron.Tx import Cardano.CLI.Byron.UpdateProposal import Cardano.CLI.Run (ClientCommand (ByronCommand)) +import Cardano.CLI.Shelley.Commands (ByronKeyFormat (..)) import Cardano.CLI.Types command' :: String -> String -> Parser a -> Mod CommandFields a @@ -144,7 +145,7 @@ parseDelegationRelatedValues = \ delegator to sign blocks on behalf of the issuer" $ IssueDelegationCertificate <$> pNetworkId - <*> parseCardanoEra + <*> parseByronKeyFormat <*> ( EpochNumber <$> parseIntegral "since-epoch" @@ -210,7 +211,7 @@ parseGenesisRelatedValues = "genesis-output-dir" "Non-existent directory where genesis JSON file and secrets shall be placed." <*> parseGenesisParameters - <*> parseCardanoEra + <*> parseByronKeyFormat , command' "print-genesis-hash" "Compute hash of a genesis file." $ PrintGenesisHash <$> parseGenesisFile "genesis-json" @@ -223,14 +224,14 @@ parseKeyRelatedValues = mconcat [ command' "keygen" "Generate a signing key." $ Keygen - <$> parseCardanoEra + <$> parseByronKeyFormat <*> parseNewSigningKeyFile "secret" <*> parsePassword , command' "to-verification" "Extract a verification key in its base64 form." $ ToVerification - <$> parseCardanoEra + <$> parseByronKeyFormat <*> parseSigningKeyFile "secret" "Signing key file to extract the verification part from." @@ -239,7 +240,7 @@ parseKeyRelatedValues = "signing-key-public" "Pretty-print a signing key's verification key (not a secret)." $ PrettySigningKeyPublic - <$> parseCardanoEra + <$> parseByronKeyFormat <*> parseSigningKeyFile "secret" "Signing key to pretty-print." @@ -247,7 +248,7 @@ parseKeyRelatedValues = "signing-key-address" "Print address of a signing key." $ PrintSigningKeyAddress - <$> parseCardanoEra + <$> parseByronKeyFormat <*> pNetworkId <*> parseSigningKeyFile "secret" @@ -256,9 +257,9 @@ parseKeyRelatedValues = "migrate-delegate-key-from" "Migrate a delegate key from an older version." $ MigrateDelegateKeyFrom - <$> parseCardanoEra -- Old CardanoEra + <$> parseByronKeyFormat -- Old Byron key format <*> parseSigningKeyFile "from" "Signing key file to migrate." - <*> parseCardanoEra -- New CardanoEra + <*> parseByronKeyFormat -- New Byron key format <*> parseNewSigningKeyFile "to" ] @@ -341,7 +342,7 @@ parseTxRelatedValues = $ SpendGenesisUTxO <$> parseGenesisFile "genesis-json" <*> pNetworkId - <*> parseCardanoEra + <*> parseByronKeyFormat <*> parseNewTxFile "tx" <*> parseSigningKeyFile "wallet-key" @@ -356,7 +357,7 @@ parseTxRelatedValues = "Write a file with a signed transaction, spending normal UTxO." $ SpendUTxO <$> pNetworkId - <*> parseCardanoEra + <*> parseByronKeyFormat <*> parseNewTxFile "tx" <*> parseSigningKeyFile "wallet-key" @@ -619,19 +620,19 @@ parseAddress opt desc = option (cliParseBase58Address <$> str) $ long opt <> metavar "ADDR" <> help desc -parseCardanoEra :: Parser CardanoEra -parseCardanoEra = asum - [ flag' ByronEraLegacy $ +parseByronKeyFormat :: Parser ByronKeyFormat +parseByronKeyFormat = asum + [ flag' LegacyByronKeyFormat $ long "byron-legacy-formats" <> help "Byron/cardano-sl formats and compatibility" - , flag' ByronEra $ + , flag' NonLegacyByronKeyFormat $ long "byron-formats" <> help "Byron era formats and compatibility" -- And hidden compatibility flag aliases: - , flag' ByronEraLegacy $ hidden <> long "byron-legacy" - , flag' ByronEra $ hidden <> long "real-pbft" + , flag' LegacyByronKeyFormat $ hidden <> long "byron-legacy" + , flag' NonLegacyByronKeyFormat $ hidden <> long "real-pbft" ] parseCertificateFile :: String -> String -> Parser CertificateFile diff --git a/cardano-cli/src/Cardano/CLI/Byron/Run.hs b/cardano-cli/src/Cardano/CLI/Byron/Run.hs index feadf832a29..afabb62e921 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Run.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Run.hs @@ -7,9 +7,9 @@ module Cardano.CLI.Byron.Run import Cardano.Prelude import Control.Monad.Trans.Except.Extra (firstExceptT, hoistEither) +import qualified Data.ByteString.Char8 as BS import qualified Data.Text.Lazy.Builder as Builder import qualified Data.Text.Lazy.IO as TL -import qualified Data.ByteString.Char8 as BS import qualified Formatting as F import qualified Cardano.Chain.Common as Common @@ -34,8 +34,8 @@ import Cardano.CLI.Byron.UpdateProposal import Cardano.CLI.Byron.Vote import Cardano.CLI.Helpers +import Cardano.CLI.Shelley.Commands (ByronKeyFormat (..)) import Cardano.CLI.Types - -- | Data type that encompasses all the possible errors of the -- Byron client. data ByronClientCmdError @@ -65,18 +65,19 @@ runByronClientCommand :: ByronCommand -> ExceptT ByronClientCmdError IO () runByronClientCommand c = case c of NodeCmd bc -> runNodeCmd bc - Genesis outDir params era -> runGenesisCommand outDir params era + Genesis outDir params bKeyFormat -> runGenesisCommand outDir params bKeyFormat GetLocalNodeTip network -> firstExceptT ByronCmdQueryError $ runGetLocalNodeTip network ValidateCBOR cborObject fp -> runValidateCBOR cborObject fp PrettyPrintCBOR fp -> runPrettyPrintCBOR fp - PrettySigningKeyPublic era skF -> runPrettySigningKeyPublic era skF - MigrateDelegateKeyFrom oldEra oldKey newEra nskf -> runMigrateDelegateKeyFrom oldEra oldKey newEra nskf + PrettySigningKeyPublic bKeyFormat skF -> runPrettySigningKeyPublic bKeyFormat skF + MigrateDelegateKeyFrom oldKeyFormat oldKey newKeyFormat nskf -> + runMigrateDelegateKeyFrom oldKeyFormat oldKey newKeyFormat nskf PrintGenesisHash genFp -> runPrintGenesisHash genFp - PrintSigningKeyAddress era networkid skF -> runPrintSigningKeyAddress era networkid skF - Keygen era nskf passReq -> runKeygen era nskf passReq - ToVerification era skFp nvkFp -> runToVerification era skFp nvkFp - IssueDelegationCertificate nw era epoch issuerSK delVK cert -> - runIssueDelegationCertificate nw era epoch issuerSK delVK cert + PrintSigningKeyAddress bKeyFormat networkid skF -> runPrintSigningKeyAddress bKeyFormat networkid skF + Keygen bKeyFormat nskf passReq -> runKeygen bKeyFormat nskf passReq + ToVerification bKeyFormat skFp nvkFp -> runToVerification bKeyFormat skFp nvkFp + IssueDelegationCertificate nw bKeyFormat epoch issuerSK delVK cert -> + runIssueDelegationCertificate nw bKeyFormat epoch issuerSK delVK cert CheckDelegation nw cert issuerVF delegateVF -> runCheckDelegation nw cert issuerVF delegateVF SubmitTx network fp -> runSubmitTx network fp GetTxId fp -> runGetTxId fp @@ -101,10 +102,10 @@ runNodeCmd (UpdateProposal nw sKey pVer sVer sysTag insHash outputFp params) = firstExceptT ByronCmdUpdateProposalError $ runProposalCreation nw sKey pVer sVer sysTag insHash outputFp params -runGenesisCommand :: NewDirectory -> GenesisParameters -> CardanoEra -> ExceptT ByronClientCmdError IO () -runGenesisCommand outDir params era = do +runGenesisCommand :: NewDirectory -> GenesisParameters -> ByronKeyFormat -> ExceptT ByronClientCmdError IO () +runGenesisCommand outDir params bKeyFormat = do (genData, genSecrets) <- firstExceptT ByronCmdGenesisError $ mkGenesis params - firstExceptT ByronCmdGenesisError $ dumpGenesis era outDir genData genSecrets + firstExceptT ByronCmdGenesisError $ dumpGenesis bKeyFormat outDir genData genSecrets runValidateCBOR :: CBORObject -> FilePath -> ExceptT ByronClientCmdError IO () runValidateCBOR cborObject fp = do @@ -117,17 +118,17 @@ runPrettyPrintCBOR fp = do bs <- firstExceptT ByronCmdHelpersError $ readCBOR fp firstExceptT ByronCmdHelpersError $ pPrintCBOR bs -runPrettySigningKeyPublic :: CardanoEra -> SigningKeyFile -> ExceptT ByronClientCmdError IO () -runPrettySigningKeyPublic era skF = do - sK <- firstExceptT ByronCmdKeyFailure $ readEraSigningKey era skF +runPrettySigningKeyPublic :: ByronKeyFormat -> SigningKeyFile -> ExceptT ByronClientCmdError IO () +runPrettySigningKeyPublic bKeyFormat skF = do + sK <- firstExceptT ByronCmdKeyFailure $ readEraSigningKey bKeyFormat skF liftIO . putTextLn . prettyPublicKey $ Crypto.toVerification sK runMigrateDelegateKeyFrom - :: CardanoEra -> SigningKeyFile -> CardanoEra -> NewSigningKeyFile + :: ByronKeyFormat -> SigningKeyFile -> ByronKeyFormat -> NewSigningKeyFile -> ExceptT ByronClientCmdError IO () -runMigrateDelegateKeyFrom oldEra oldKey newEra (NewSigningKeyFile newKey) = do - sk <- firstExceptT ByronCmdKeyFailure $ readEraSigningKey oldEra oldKey - sDk <- hoistEither . first ByronCmdDelegationError $ serialiseDelegateKey newEra sk +runMigrateDelegateKeyFrom oldKeyformat oldKey newKeyFormat (NewSigningKeyFile newKey) = do + sk <- firstExceptT ByronCmdKeyFailure $ readEraSigningKey oldKeyformat oldKey + sDk <- hoistEither . first ByronCmdDelegationError $ serialiseDelegateKey newKeyFormat sk firstExceptT ByronCmdHelpersError $ ensureNewFileLBS newKey sDk runPrintGenesisHash :: GenesisFile -> ExceptT ByronClientCmdError IO () @@ -146,39 +147,39 @@ runPrintGenesisHash genFp = do . Genesis.unGenesisHash . Genesis.configGenesisHash -runPrintSigningKeyAddress :: CardanoEra -> NetworkId -> SigningKeyFile -> ExceptT ByronClientCmdError IO () -runPrintSigningKeyAddress era networkid skF = do - sK <- firstExceptT ByronCmdKeyFailure $ readEraSigningKey era skF +runPrintSigningKeyAddress :: ByronKeyFormat -> NetworkId -> SigningKeyFile -> ExceptT ByronClientCmdError IO () +runPrintSigningKeyAddress bKeyFormat networkid skF = do + sK <- firstExceptT ByronCmdKeyFailure $ readEraSigningKey bKeyFormat skF let sKeyAddress = prettyAddress . Common.makeVerKeyAddress (Typed.toByronNetworkMagic networkid) . Crypto.toVerification $ sK liftIO $ putTextLn sKeyAddress -runKeygen :: CardanoEra -> NewSigningKeyFile -> PasswordRequirement -> ExceptT ByronClientCmdError IO () -runKeygen era (NewSigningKeyFile skF) passReq = do +runKeygen :: ByronKeyFormat -> NewSigningKeyFile -> PasswordRequirement -> ExceptT ByronClientCmdError IO () +runKeygen bKeyFormat (NewSigningKeyFile skF) passReq = do pPhrase <- liftIO $ getPassphrase ("Enter password to encrypt '" <> skF <> "': ") passReq sK <- liftIO $ keygen pPhrase - serDk <- hoistEither . first ByronCmdDelegationError $ serialiseDelegateKey era sK + serDk <- hoistEither . first ByronCmdDelegationError $ serialiseDelegateKey bKeyFormat sK firstExceptT ByronCmdHelpersError $ ensureNewFileLBS skF serDk -runToVerification :: CardanoEra -> SigningKeyFile -> NewVerificationKeyFile -> ExceptT ByronClientCmdError IO () -runToVerification era skFp (NewVerificationKeyFile vkFp) = do - sk <- firstExceptT ByronCmdKeyFailure $ readEraSigningKey era skFp +runToVerification :: ByronKeyFormat -> SigningKeyFile -> NewVerificationKeyFile -> ExceptT ByronClientCmdError IO () +runToVerification bKeyFormat skFp (NewVerificationKeyFile vkFp) = do + sk <- firstExceptT ByronCmdKeyFailure $ readEraSigningKey bKeyFormat skFp let vKey = Builder.toLazyText . Crypto.formatFullVerificationKey $ Crypto.toVerification sk firstExceptT ByronCmdHelpersError $ ensureNewFile TL.writeFile vkFp vKey runIssueDelegationCertificate :: NetworkId - -> CardanoEra + -> ByronKeyFormat -> EpochNumber -> SigningKeyFile -> VerificationKeyFile -> NewCertificateFile -> ExceptT ByronClientCmdError IO () -runIssueDelegationCertificate nw era epoch issuerSK delegateVK cert = do +runIssueDelegationCertificate nw bKeyFormat epoch issuerSK delegateVK cert = do vk <- firstExceptT ByronCmdKeyFailure $ readPaymentVerificationKey delegateVK - sk <- firstExceptT ByronCmdKeyFailure $ readEraSigningKey era issuerSK + sk <- firstExceptT ByronCmdKeyFailure $ readEraSigningKey bKeyFormat issuerSK let byGenDelCert :: Delegation.Certificate byGenDelCert = issueByronGenesisDelegation (toByronProtocolMagicId nw) epoch sk vk sCert = serialiseDelegationCert byGenDelCert @@ -214,29 +215,29 @@ runGetTxId fp = firstExceptT ByronCmdTxError $ do runSpendGenesisUTxO :: GenesisFile -> NetworkId - -> CardanoEra + -> ByronKeyFormat -> NewTxFile -> SigningKeyFile -> Common.Address -> NonEmpty TxOut -> ExceptT ByronClientCmdError IO () -runSpendGenesisUTxO genesisFile nw era (NewTxFile ctTx) ctKey genRichAddr outs = do +runSpendGenesisUTxO genesisFile nw bKeyFormat (NewTxFile ctTx) ctKey genRichAddr outs = do genesis <- firstExceptT ByronCmdGenesisError $ readGenesis genesisFile nw - sk <- firstExceptT ByronCmdKeyFailure $ readEraSigningKey era ctKey + sk <- firstExceptT ByronCmdKeyFailure $ readEraSigningKey bKeyFormat ctKey let tx = txSpendGenesisUTxOByronPBFT genesis nw sk genRichAddr outs firstExceptT ByronCmdHelpersError $ ensureNewFileLBS ctTx $ toCborTxAux tx runSpendUTxO :: NetworkId - -> CardanoEra + -> ByronKeyFormat -> NewTxFile -> SigningKeyFile -> NonEmpty TxIn -> NonEmpty TxOut -> ExceptT ByronClientCmdError IO () -runSpendUTxO nw era (NewTxFile ctTx) ctKey ins outs = do - sk <- firstExceptT ByronCmdKeyFailure $ readEraSigningKey era ctKey +runSpendUTxO nw bKeyFormat (NewTxFile ctTx) ctKey ins outs = do + sk <- firstExceptT ByronCmdKeyFailure $ readEraSigningKey bKeyFormat ctKey let gTx = txSpendUTxOByronPBFT nw sk ins outs firstExceptT ByronCmdHelpersError . ensureNewFileLBS ctTx $ toCborTxAux gTx diff --git a/cardano-cli/src/Cardano/CLI/Byron/UpdateProposal.hs b/cardano-cli/src/Cardano/CLI/Byron/UpdateProposal.hs index 8f76cd59ba2..fbbd08955d6 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/UpdateProposal.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/UpdateProposal.hs @@ -34,10 +34,10 @@ import Ouroboros.Consensus.Util.Condense (condense) import Cardano.Api.Typed (NetworkId, toByronProtocolMagicId) import Cardano.CLI.Byron.Genesis (ByronGenesisError) -import Cardano.CLI.Byron.Key (ByronKeyFailure, CardanoEra (..), readEraSigningKey) +import Cardano.CLI.Byron.Key (ByronKeyFailure, readEraSigningKey) import Cardano.CLI.Byron.Tx (ByronTxError, nodeSubmitTx) +import Cardano.CLI.Shelley.Commands (ByronKeyFormat (..)) import Cardano.CLI.Types - data ByronUpdateProposalError = ByronReadUpdateProposalFileFailure !FilePath !Text | ByronUpdateProposalWriteError !HelpersError @@ -75,7 +75,7 @@ runProposalCreation -> ExceptT ByronUpdateProposalError IO () runProposalCreation nw sKey@(SigningKeyFile sKeyfp) pVer sVer sysTag insHash outputFp params = do - sK <- firstExceptT (ReadSigningKeyFailure sKeyfp) $ readEraSigningKey ByronEra sKey + sK <- firstExceptT (ReadSigningKeyFailure sKeyfp) $ readEraSigningKey NonLegacyByronKeyFormat sKey let proposal = createUpdateProposal nw sK pVer sVer sysTag insHash params firstExceptT ByronUpdateProposalWriteError $ ensureNewFileLBS outputFp (serialiseByronUpdateProposal proposal) diff --git a/cardano-cli/src/Cardano/CLI/Byron/Vote.hs b/cardano-cli/src/Cardano/CLI/Byron/Vote.hs index 58a39e4e4f7..c325714f88a 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Vote.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Vote.hs @@ -26,9 +26,10 @@ import Ouroboros.Consensus.Util.Condense (condense) import Cardano.Api.Typed (NetworkId, toByronProtocolMagicId) import Cardano.CLI.Byron.Genesis (ByronGenesisError) -import Cardano.CLI.Byron.Key (ByronKeyFailure, CardanoEra (..), readEraSigningKey) +import Cardano.CLI.Byron.Key (ByronKeyFailure, readEraSigningKey) import Cardano.CLI.Byron.Tx (ByronTxError, nodeSubmitTx) import Cardano.CLI.Helpers (HelpersError, ensureNewFileLBS) +import Cardano.CLI.Shelley.Commands (ByronKeyFormat (..)) import Cardano.CLI.Types @@ -62,7 +63,7 @@ runVoteCreation -> FilePath -> ExceptT ByronVoteError IO () runVoteCreation nw sKey upPropFp voteBool outputFp = do - sK <- firstExceptT ByronVoteKeyReadFailure $ readEraSigningKey ByronEra sKey + sK <- firstExceptT ByronVoteKeyReadFailure $ readEraSigningKey NonLegacyByronKeyFormat sKey -- TODO: readByronUpdateProposal & deserialiseByronUpdateProposal should be one function upProp <- firstExceptT ByronVoteUpdateProposalFailure $ readByronUpdateProposal upPropFp proposal <- hoistEither . first ByronVoteUpdateProposalFailure $ deserialiseByronUpdateProposal upProp diff --git a/cardano-cli/src/Cardano/CLI/Run.hs b/cardano-cli/src/Cardano/CLI/Run.hs index dc260a16ef1..26328fa4642 100644 --- a/cardano-cli/src/Cardano/CLI/Run.hs +++ b/cardano-cli/src/Cardano/CLI/Run.hs @@ -45,7 +45,6 @@ data ClientCommandErrors = ByronClientError ByronClientCmdError | ShelleyClientError ShelleyCommand ShelleyClientCmdError deriving Show - --TODO: We should include an AgnosticClientError runClientCommand :: ClientCommand -> ExceptT ClientCommandErrors IO () runClientCommand (ByronCommand c) = firstExceptT ByronClientError $ runByronClientCommand c diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Key.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Key.hs index f3122d5fc71..f988399603d 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Key.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Key.hs @@ -332,7 +332,7 @@ convertByronSigningKey mPwd byronFormat convert sk@(Crypto.SigningKey xprv) <- firstExceptT ShelleyKeyCmdByronKeyFailure - $ Byron.readEraSigningKey (toCarandoEra byronFormat) skeyPathOld + $ Byron.readEraSigningKey byronFormat skeyPathOld unprotectedSk <- case mPwd of -- Change password to empty string @@ -346,13 +346,6 @@ convertByronSigningKey mPwd byronFormat convert firstExceptT ShelleyKeyCmdWriteFileError . newExceptT $ writeFileTextEnvelope skeyPathNew Nothing sk' - where - -- TODO: merge these two types - toCarandoEra :: ByronKeyFormat -> Byron.CardanoEra - toCarandoEra NonLegacyByronKeyFormat = Byron.ByronEra - toCarandoEra LegacyByronKeyFormat = Byron.ByronEraLegacy - - convertByronVerificationKey :: forall keyrole. Key keyrole