Tweak help text and add error for mnemoni parsing

cardano-foundation · Feb 3, 2020 · 57fad60 · 57fad60
1 parent dcf21a6
commit 57fad60
Showing 1 changed file with 39 additions and 37 deletions.
diff --git a/lib/cli/src/Cardano/CLI.hs b/lib/cli/src/Cardano/CLI.hs
@@ -123,6 +123,7 @@ import Cardano.Wallet.Primitive.AddressDerivation
     ( FromMnemonic (..)
     , Passphrase (..)
     , PassphraseMaxLength
+    , FromMnemonicError (..)
     , keyToHexText
     , PassphraseMinLength
     , WalletKey (..)
@@ -304,54 +305,25 @@ 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"
   where
     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
@@ -360,15 +332,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 =
@@ -380,7 +354,7 @@ cmdRootKey =
         keyType <- parseKeyType
         seed <- parseSeedFromMnemonic
         return $ do
-            TIO.putStrLn =<< (generateKeyFromSeed <$> (pure seed) <*> keyType)
+            TIO.putStrLn =<< (generateKeyFromSeed <$> seed <*> keyType)
 
 generateKeyFromSeed
     :: Passphrase "seed"
@@ -397,9 +371,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