diff --git a/lib/cli/src/Cardano/CLI.hs b/lib/cli/src/Cardano/CLI.hs index 9fade9245d0..1f3a8301a6e 100644 --- a/lib/cli/src/Cardano/CLI.hs +++ b/lib/cli/src/Cardano/CLI.hs @@ -120,6 +120,7 @@ import Cardano.Wallet.Primitive.AddressDerivation ( FromMnemonic (..) , Passphrase (..) , PassphraseMaxLength + , FromMnemonicError (..) , keyToHexText , PassphraseMinLength , WalletKey (..) @@ -295,37 +296,9 @@ runCli = join . customExecParser preferences preferences = prefs showHelpOnEmpty {------------------------------------------------------------------------------- - Commands - 'mnemonic' + Commands - 'HD Derivation' -------------------------------------------------------------------------------} -cmdMnemonic :: Mod CommandFields (IO ()) -cmdMnemonic = command "mnemonic" $ info (helper <*> cmds) $ mempty - <> progDesc "Manage mnemonic phrases." - where - cmds = subparser $ mempty - <> cmdMnemonicGenerate - <> cmdMnemonicRewardCredentials - --- | Arguments for 'mnemonic generate' command -newtype MnemonicGenerateArgs = MnemonicGenerateArgs - { _size :: MnemonicSize - } - -cmdMnemonicGenerate :: Mod CommandFields (IO ()) -cmdMnemonicGenerate = command "generate" $ info (helper <*> cmd) $ mempty - <> progDesc "Generate English BIP-0039 compatible mnemonic words." - where - cmd = exec . MnemonicGenerateArgs <$> sizeOption - exec (MnemonicGenerateArgs n) = do - m <- case n of - MS_9 -> mnemonicToText @9 . entropyToMnemonic <$> genEntropy - MS_12 -> mnemonicToText @12 . entropyToMnemonic <$> genEntropy - MS_15 -> mnemonicToText @15 . entropyToMnemonic <$> genEntropy - MS_18 -> mnemonicToText @18 . entropyToMnemonic <$> genEntropy - MS_21 -> mnemonicToText @21 . entropyToMnemonic <$> genEntropy - MS_24 -> mnemonicToText @24 . entropyToMnemonic <$> genEntropy - TIO.putStrLn $ T.unwords m - cmdKey :: Mod CommandFields (IO ()) cmdKey = command "key" $ info (helper <*> cmds) $ mempty <> progDesc "Derive keys from mnemonics" @@ -333,16 +306,15 @@ cmdKey = command "key" $ info (helper <*> cmds) $ mempty cmds = subparser $ mempty <> cmdRootKey -data KeyType = Icarus | Trezor | Ledger | Byron +data KeyType = Byron | Icarus | Trezor | Ledger deriving (Show, Eq, Generic, Bounded, Enum) deriving (ToText, FromText) via (BoundedEnum 'KebabLowerCase KeyType) - parseKeyType :: Parser (IO KeyType) parseKeyType = toIO . fromText <$> strOption ( long "type" <> metavar "KEYTYPE" - <> help "Shelley / Icarus" + <> help "Byron / Icarus / Trezor / Ledger" ) where toIO :: Either TextDecodingError KeyType -> IO KeyType @@ -351,15 +323,17 @@ parseKeyType = toIO . fromText <$> strOption toIO (Left (TextDecodingError e)) = hPutStrLn stderr e >> exitFailure -parseSeedFromMnemonic :: Parser (Passphrase "seed") +parseSeedFromMnemonic :: Parser (IO (Passphrase "seed")) parseSeedFromMnemonic = toSeed <$> parseWords where parseWords = some (argument str (metavar "WORDS...")) toSeed ws = - -- TODO: Handle errors -- TODO: Make sure we allow the right lengths for each key type! -- Maybe that this matches the API. - let Right seed = fromMnemonic @'[15,18,21,24] @"seed" ws in seed + case fromMnemonic @'[15,18,21,24] @"seed" ws of + Right s -> return s + Left (FromMnemonicError e) -> hPutStrLn stderr e >> exitFailure + cmdRootKey :: Mod CommandFields (IO ()) cmdRootKey = @@ -371,7 +345,7 @@ cmdRootKey = keyType <- parseKeyType seed <- parseSeedFromMnemonic return $ do - TIO.putStrLn =<< (generateKeyFromSeed <$> (pure seed) <*> keyType) + TIO.putStrLn =<< (generateKeyFromSeed <$> seed <*> keyType) generateKeyFromSeed :: Passphrase "seed" @@ -388,9 +362,37 @@ generateKeyFromSeed seed = \case keyToHexText $ Icarus.generateKeyFromSeed seed mempty {------------------------------------------------------------------------------- - Commands - 'HD Derivation' + Commands - 'mnemonic' -------------------------------------------------------------------------------} +cmdMnemonic :: Mod CommandFields (IO ()) +cmdMnemonic = command "mnemonic" $ info (helper <*> cmds) $ mempty + <> progDesc "Manage mnemonic phrases." + where + cmds = subparser $ mempty + <> cmdMnemonicGenerate + <> cmdMnemonicRewardCredentials + +-- | Arguments for 'mnemonic generate' command +newtype MnemonicGenerateArgs = MnemonicGenerateArgs + { _size :: MnemonicSize + } + +cmdMnemonicGenerate :: Mod CommandFields (IO ()) +cmdMnemonicGenerate = command "generate" $ info (helper <*> cmd) $ mempty + <> progDesc "Generate English BIP-0039 compatible mnemonic words." + where + cmd = exec . MnemonicGenerateArgs <$> sizeOption + exec (MnemonicGenerateArgs n) = do + m <- case n of + MS_9 -> mnemonicToText @9 . entropyToMnemonic <$> genEntropy + MS_12 -> mnemonicToText @12 . entropyToMnemonic <$> genEntropy + MS_15 -> mnemonicToText @15 . entropyToMnemonic <$> genEntropy + MS_18 -> mnemonicToText @18 . entropyToMnemonic <$> genEntropy + MS_21 -> mnemonicToText @21 . entropyToMnemonic <$> genEntropy + MS_24 -> mnemonicToText @24 . entropyToMnemonic <$> genEntropy + TIO.putStrLn $ T.unwords m + cmdMnemonicRewardCredentials :: Mod CommandFields (IO ()) cmdMnemonicRewardCredentials = command "reward-credentials" $ info (helper <*> cmd) $ mempty