From 9dd73013d092008c6abe15950549200a5e2cd776 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Wed, 27 Nov 2024 17:52:18 +0100 Subject: [PATCH] Move mnemonic-specific functionality to separate module --- cardano-cli/cardano-cli.cabal | 1 + cardano-cli/src/Cardano/CLI/Run/Key.hs | 149 +--------------- cardano-cli/src/Cardano/CLI/Run/Mnemonic.hs | 184 ++++++++++++++++++++ 3 files changed, 194 insertions(+), 140 deletions(-) create mode 100644 cardano-cli/src/Cardano/CLI/Run/Mnemonic.hs diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 7da4bdf71f..8724c7081a 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -147,6 +147,7 @@ library Cardano.CLI.Run.Debug.TransactionView Cardano.CLI.Run.Hash Cardano.CLI.Run.Key + Cardano.CLI.Run.Mnemonic Cardano.CLI.Run.Node Cardano.CLI.Run.Ping Cardano.CLI.TopHandler diff --git a/cardano-cli/src/Cardano/CLI/Run/Key.hs b/cardano-cli/src/Cardano/CLI/Run/Key.hs index 901efcb27f..93aa0218a0 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Key.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Key.hs @@ -1,9 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} module Cardano.CLI.Run.Key @@ -39,6 +37,7 @@ import qualified Cardano.Api.Ledger as L import qualified Cardano.CLI.Byron.Key as Byron import qualified Cardano.CLI.Commands.Key as Cmd +import Cardano.CLI.Run.Mnemonic (extendedSigningKeyFromMnemonicImpl, generateMnemonicImpl) import Cardano.CLI.Types.Common import Cardano.CLI.Types.Errors.CardanoAddressSigningKeyConversionError import Cardano.CLI.Types.Errors.ItnKeyConversionError @@ -49,23 +48,16 @@ import qualified Cardano.Crypto.Signing as Byron import qualified Cardano.Crypto.Signing as Byron.Crypto import qualified Cardano.Crypto.Signing as Crypto import qualified Cardano.Crypto.Wallet as Crypto -import Cardano.Prelude (isSpace) import qualified Codec.Binary.Bech32 as Bech32 import qualified Control.Exception as Exception -import Control.Monad (when) import Data.Bifunctor (Bifunctor (..)) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Data.Function import Data.Text (Text) -import qualified Data.Text as T import qualified Data.Text as Text import qualified Data.Text.Encoding as Text -import System.Console.Haskeline (Completion, InputT, Settings (..), completeWord', - defaultBehavior, defaultPrefs, getInputLineWithInitial, - runInputTBehaviorWithPrefs, simpleCompletion) -import System.Console.Haskeline.Completion (CompletionFunc) import System.Exit (exitFailure) -- Note on these constants: @@ -218,25 +210,7 @@ runGenerateMnemonicCmd Cmd.KeyGenerateMnemonicCmdArgs { mnemonicOutputFormat , mnemonicWords - } = do - mnemonic <- firstExceptT KeyCmdMnemonicError $ generateMnemonic mnemonicWords - let expectedNumOfMnemonicWords = mnemonicSizeToInt mnemonicWords - obtainedNumOfMnemonicWords = length mnemonic - when (obtainedNumOfMnemonicWords /= expectedNumOfMnemonicWords) $ - left $ - KeyCmdWrongNumOfMnemonics expectedNumOfMnemonicWords obtainedNumOfMnemonicWords - case mnemonicOutputFormat of - Just outFile -> - firstExceptT KeyCmdWriteFileError . newExceptT $ - writeTextFile outFile (T.unwords mnemonic) - Nothing -> liftIO $ putStrLn $ T.unpack (T.unwords mnemonic) - where - mnemonicSizeToInt :: MnemonicSize -> Int - mnemonicSizeToInt MS12 = 12 - mnemonicSizeToInt MS15 = 15 - mnemonicSizeToInt MS18 = 18 - mnemonicSizeToInt MS21 = 21 - mnemonicSizeToInt MS24 = 24 + } = generateMnemonicImpl mnemonicWords mnemonicOutputFormat readExtendedVerificationKeyFile :: VerificationKeyFile In @@ -278,118 +252,13 @@ runExtendedSigningKeyFromMnemonicCmd , derivationAccountNo , mnemonicSource , signingKeyFileOut - } = do - let writeKeyToFile - :: (HasTextEnvelope (SigningKey a), SerialiseAsBech32 (SigningKey a)) - => SigningKey a -> ExceptT KeyCmdError IO () - writeKeyToFile = writeSigningKeyFile keyOutputFormat signingKeyFileOut - - wrapException :: Either MnemonicToSigningKeyError a -> ExceptT KeyCmdError IO a - wrapException = except . first KeyCmdMnemonicError - - mnemonicWords <- readMnemonic mnemonicSource - - case derivedExtendedSigningKeyType of - Cmd.ExtendedSigningPaymentKey paymentKeyNo -> - writeKeyToFile - =<< wrapException - ( signingKeyFromMnemonicWithPaymentKeyIndex - AsPaymentExtendedKey - mnemonicWords - derivationAccountNo - paymentKeyNo - ) - Cmd.ExtendedSigningStakeKey paymentKeyNo -> - writeKeyToFile - =<< wrapException - ( signingKeyFromMnemonicWithPaymentKeyIndex - AsStakeExtendedKey - mnemonicWords - derivationAccountNo - paymentKeyNo - ) - Cmd.ExtendedSigningDRepKey -> - writeKeyToFile - =<< wrapException (signingKeyFromMnemonic AsDRepExtendedKey mnemonicWords derivationAccountNo) - Cmd.ExtendedSigningCCColdKey -> - writeKeyToFile - =<< wrapException - (signingKeyFromMnemonic AsCommitteeColdExtendedKey mnemonicWords derivationAccountNo) - Cmd.ExtendedSigningCCHotKey -> - writeKeyToFile - =<< wrapException - (signingKeyFromMnemonic AsCommitteeHotExtendedKey mnemonicWords derivationAccountNo) - where - writeSigningKeyFile - :: (HasTextEnvelope (SigningKey a), SerialiseAsBech32 (SigningKey a)) - => KeyOutputFormat -> SigningKeyFile Out -> SigningKey a -> ExceptT KeyCmdError IO () - writeSigningKeyFile fmt sKeyPath skey = - firstExceptT KeyCmdWriteFileError $ - case fmt of - KeyOutputFormatTextEnvelope -> - newExceptT $ - writeLazyByteStringFile sKeyPath $ - textEnvelopeToJSON Nothing skey - KeyOutputFormatBech32 -> - newExceptT $ - writeTextFile sKeyPath $ - serialiseToBech32 skey - - readMnemonic :: Cmd.MnemonicSource -> ExceptT KeyCmdError IO [Text] - readMnemonic (Cmd.MnemonicFromFile filePath) = do - fileText <- firstExceptT KeyCmdReadMnemonicFileError $ except =<< readTextFile filePath - return $ map T.pack $ words $ T.unpack fileText - readMnemonic Cmd.MnemonicFromInteractivePrompt = - liftIO $ do - putStrLn $ - unlines - [ "" - , "Please enter your mnemonic sentence." - , "" - , " - It should consist of either: 12, 15, 18, 21, or 24 words." - , " - To terminate, press enter on an empty line." - , " - To abort you can press CTRL+C." - , "" - , "(If your terminal supports it, you can use the TAB key for word completion.)" - , "" - ] - runInputTBehaviorWithPrefs defaultBehavior defaultPrefs settings (inputT ("", "") []) - where - settings :: Monad m => Settings m - settings = - Settings - { complete = completionFunc - , historyFile = Nothing - , autoAddHistory = False - } - - completionFunc :: Monad m => CompletionFunc m - completionFunc = completeWord' Nothing isSpace completeMnemonicWord - - completeMnemonicWord :: Monad m => String -> m [Completion] - completeMnemonicWord prefix = return $ map (simpleCompletion . T.unpack . fst) $ findMnemonicWordsWithPrefix (T.pack prefix) - - inputT :: (String, String) -> [Text] -> InputT IO [Text] - inputT prefill mnemonic = do - minput <- getInputLineWithInitial (show (length mnemonic + 1) <> ". ") prefill - case minput of - Nothing -> return $ reverse mnemonic - Just "" -> return $ reverse mnemonic - Just input -> - let newWords = map (T.toLower . T.pack) $ filter (not . null) $ words input - in case span isValidMnemonicWord newWords of - (allWords, []) -> inputT ("", "") (reverse allWords ++ mnemonic) - (validWords, invalidWord : notValidatedWords) -> do - liftIO $ putStrLn $ "The word \"" <> T.unpack invalidWord <> "\" is not in the memonic dictionary" - let textBeforeCursor = unwords (map T.unpack validWords <> [T.unpack invalidWord]) - textAfterCursor = - if null notValidatedWords - then "" - else ' ' : unwords (map T.unpack notValidatedWords) - inputT (textBeforeCursor, textAfterCursor) mnemonic - - isValidMnemonicWord :: Text -> Bool - isValidMnemonicWord word = word `elem` map fst (findMnemonicWordsWithPrefix word) + } = + extendedSigningKeyFromMnemonicImpl + keyOutputFormat + derivedExtendedSigningKeyType + derivationAccountNo + mnemonicSource + signingKeyFileOut runConvertByronKeyCmd :: Cmd.KeyConvertByronKeyCmdArgs diff --git a/cardano-cli/src/Cardano/CLI/Run/Mnemonic.hs b/cardano-cli/src/Cardano/CLI/Run/Mnemonic.hs new file mode 100644 index 0000000000..50b2ec086e --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Run/Mnemonic.hs @@ -0,0 +1,184 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} + +module Cardano.CLI.Run.Mnemonic (generateMnemonicImpl, extendedSigningKeyFromMnemonicImpl) where + +import Cardano.Api + (AsType (AsCommitteeColdExtendedKey, AsCommitteeHotExtendedKey, AsDRepExtendedKey, AsPaymentExtendedKey, AsStakeExtendedKey), + ExceptT, File, FileDirection (Out), HasTextEnvelope, Key (SigningKey), + MnemonicSize (..), MnemonicToSigningKeyError, MonadIO (..), SerialiseAsBech32, + except, findMnemonicWordsWithPrefix, firstExceptT, generateMnemonic, left, + newExceptT, readTextFile, serialiseToBech32, signingKeyFromMnemonic, + signingKeyFromMnemonicWithPaymentKeyIndex, textEnvelopeToJSON, + writeLazyByteStringFile, writeTextFile) + +import qualified Cardano.CLI.Commands.Key as Cmd +import Cardano.CLI.Types.Common (KeyOutputFormat (..), SigningKeyFile) +import Cardano.CLI.Types.Errors.KeyCmdError + (KeyCmdError (KeyCmdMnemonicError, KeyCmdReadMnemonicFileError, KeyCmdWriteFileError, KeyCmdWrongNumOfMnemonics)) +import Cardano.Prelude (isSpace) + +import Control.Monad (when) +import Data.Bifunctor (Bifunctor (..)) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Word (Word32) +import System.Console.Haskeline (Completion, InputT, Settings (..), completeWord', + defaultBehavior, defaultPrefs, getInputLineWithInitial, + runInputTBehaviorWithPrefs, simpleCompletion) +import System.Console.Haskeline.Completion (CompletionFunc) + +-- | Generate a mnemonic and write it to a file or stdout. +generateMnemonicImpl + :: MonadIO m + => MnemonicSize + -- ^ The number of words in the mnemonic. + -> Maybe (File () Out) + -- ^ The file to write the mnemonic to. If 'Nothing', write to stdout. + -> ExceptT KeyCmdError m () +generateMnemonicImpl mnemonicWords mnemonicOutputFormat = do + mnemonic <- firstExceptT KeyCmdMnemonicError $ generateMnemonic mnemonicWords + let expectedNumOfMnemonicWords = mnemonicSizeToInt mnemonicWords + obtainedNumOfMnemonicWords = length mnemonic + when (obtainedNumOfMnemonicWords /= expectedNumOfMnemonicWords) $ + left $ + KeyCmdWrongNumOfMnemonics expectedNumOfMnemonicWords obtainedNumOfMnemonicWords + case mnemonicOutputFormat of + Just outFile -> + firstExceptT KeyCmdWriteFileError . newExceptT $ + writeTextFile outFile (T.unwords mnemonic) + Nothing -> liftIO $ putStrLn $ T.unpack (T.unwords mnemonic) + where + mnemonicSizeToInt :: MnemonicSize -> Int + mnemonicSizeToInt MS12 = 12 + mnemonicSizeToInt MS15 = 15 + mnemonicSizeToInt MS18 = 18 + mnemonicSizeToInt MS21 = 21 + mnemonicSizeToInt MS24 = 24 + +-- | Derive an extended signing key from a mnemonic and write it to a file. +extendedSigningKeyFromMnemonicImpl + :: KeyOutputFormat + -- ^ The format in which to write the signing key. + -> Cmd.ExtendedSigningType + -- ^ The type of the extended signing key to derive with an optional payment key index. + -> Word32 + -- ^ The account index. + -> Cmd.MnemonicSource + -- ^ The source of the mnemonic (either file or stdin). + -> SigningKeyFile Out + -- ^ The file to write the signing key to. + -> ExceptT KeyCmdError IO () +extendedSigningKeyFromMnemonicImpl keyOutputFormat derivedExtendedSigningKeyType derivationAccountNo mnemonicSource signingKeyFileOut = + do + let writeKeyToFile + :: (HasTextEnvelope (SigningKey a), SerialiseAsBech32 (SigningKey a)) + => SigningKey a -> ExceptT KeyCmdError IO () + writeKeyToFile = writeSigningKeyFile keyOutputFormat signingKeyFileOut + + wrapException :: Either MnemonicToSigningKeyError a -> ExceptT KeyCmdError IO a + wrapException = except . first KeyCmdMnemonicError + + mnemonicWords <- readMnemonic mnemonicSource + + case derivedExtendedSigningKeyType of + Cmd.ExtendedSigningPaymentKey paymentKeyNo -> + writeKeyToFile + =<< wrapException + ( signingKeyFromMnemonicWithPaymentKeyIndex + AsPaymentExtendedKey + mnemonicWords + derivationAccountNo + paymentKeyNo + ) + Cmd.ExtendedSigningStakeKey paymentKeyNo -> + writeKeyToFile + =<< wrapException + ( signingKeyFromMnemonicWithPaymentKeyIndex + AsStakeExtendedKey + mnemonicWords + derivationAccountNo + paymentKeyNo + ) + Cmd.ExtendedSigningDRepKey -> + writeKeyToFile + =<< wrapException (signingKeyFromMnemonic AsDRepExtendedKey mnemonicWords derivationAccountNo) + Cmd.ExtendedSigningCCColdKey -> + writeKeyToFile + =<< wrapException + (signingKeyFromMnemonic AsCommitteeColdExtendedKey mnemonicWords derivationAccountNo) + Cmd.ExtendedSigningCCHotKey -> + writeKeyToFile + =<< wrapException + (signingKeyFromMnemonic AsCommitteeHotExtendedKey mnemonicWords derivationAccountNo) + where + writeSigningKeyFile + :: (HasTextEnvelope (SigningKey a), SerialiseAsBech32 (SigningKey a)) + => KeyOutputFormat -> SigningKeyFile Out -> SigningKey a -> ExceptT KeyCmdError IO () + writeSigningKeyFile fmt sKeyPath skey = + firstExceptT KeyCmdWriteFileError $ + case fmt of + KeyOutputFormatTextEnvelope -> + newExceptT $ + writeLazyByteStringFile sKeyPath $ + textEnvelopeToJSON Nothing skey + KeyOutputFormatBech32 -> + newExceptT $ + writeTextFile sKeyPath $ + serialiseToBech32 skey + + readMnemonic :: Cmd.MnemonicSource -> ExceptT KeyCmdError IO [Text] + readMnemonic (Cmd.MnemonicFromFile filePath) = do + fileText <- firstExceptT KeyCmdReadMnemonicFileError $ except =<< readTextFile filePath + return $ map T.pack $ words $ T.unpack fileText + readMnemonic Cmd.MnemonicFromInteractivePrompt = + liftIO $ do + putStrLn $ + unlines + [ "" + , "Please enter your mnemonic sentence." + , "" + , " - It should consist of either: 12, 15, 18, 21, or 24 words." + , " - To terminate, press enter on an empty line." + , " - To abort you can press CTRL+C." + , "" + , "(If your terminal supports it, you can use the TAB key for word completion.)" + , "" + ] + runInputTBehaviorWithPrefs defaultBehavior defaultPrefs settings (inputT ("", "") []) + where + settings :: Monad m => Settings m + settings = + Settings + { complete = completionFunc + , historyFile = Nothing + , autoAddHistory = False + } + + completionFunc :: Monad m => CompletionFunc m + completionFunc = completeWord' Nothing isSpace completeMnemonicWord + + completeMnemonicWord :: Monad m => String -> m [Completion] + completeMnemonicWord prefix = return $ map (simpleCompletion . T.unpack . fst) $ findMnemonicWordsWithPrefix (T.pack prefix) + + inputT :: (String, String) -> [Text] -> InputT IO [Text] + inputT prefill mnemonic = do + minput <- getInputLineWithInitial (show (length mnemonic + 1) <> ". ") prefill + case minput of + Nothing -> return $ reverse mnemonic + Just "" -> return $ reverse mnemonic + Just input -> + let newWords = map (T.toLower . T.pack) $ filter (not . null) $ words input + in case span isValidMnemonicWord newWords of + (allWords, []) -> inputT ("", "") (reverse allWords ++ mnemonic) + (validWords, invalidWord : notValidatedWords) -> do + liftIO $ putStrLn $ "The word \"" <> T.unpack invalidWord <> "\" is not in the memonic dictionary" + let textBeforeCursor = unwords (map T.unpack validWords <> [T.unpack invalidWord]) + textAfterCursor = + if null notValidatedWords + then "" + else ' ' : unwords (map T.unpack notValidatedWords) + inputT (textBeforeCursor, textAfterCursor) mnemonic + + isValidMnemonicWord :: Text -> Bool + isValidMnemonicWord word = word `elem` map fst (findMnemonicWordsWithPrefix word)