[cli] Improve decryption error

Author: paolino

cli/anti.cabal

@@ -171,6 +171,7 @@ library
     , directory
     , exceptions
     , github
+    , haskeline
     , http-client
     , http-client-tls
     , http-types

cli/src/Core/Encryption.hs

@@ -148,7 +148,7 @@ decrypt
     -- ^ passphrase
     -> ByteString
     -- ^ encrypted message
-    -> IO ByteString
+    -> Either String ByteString
 decrypt passphrase encrypted = do
     case parseEncrypted encrypted of
         Nothing -> error "Failed to parse encrypted message iv"
@@ -178,12 +178,14 @@ decryptText
     -- ^ passphrase
     -> Text
     -- ^ encrypted message
-    -> IO Text
+    -> Either String Text
     -- ^ decrypted message
 decryptText passphrase encrypted = do
     let encryptedBS = convertFromBase Base16 (encodeUtf8 encrypted)
     case encryptedBS of
-        Left err -> error $ "Failed to decode encrypted message: " ++ err
+        Left _err -> Left "Decryption failed: invalid base16 message"
         Right encBS -> do
             decrypted <- decrypt (encodeUtf8 passphrase) encBS
-            pure $ decodeUtf8 decrypted
+            case decodeUtf8' decrypted of
+                Left _err -> Left "Decryption failed: invalid UTF8 decrypted"
+                Right txt -> pure txt

cli/src/Core/Types/Mnemonics/Options.hs

@@ -12,21 +12,27 @@ import Data.Aeson
 import Data.Aeson qualified as Aeson
 import Data.ByteString.Lazy qualified as BL
 import Data.Text (Text)
+import Data.Text qualified as T
 import OptEnvConf
     ( Alternative ((<|>))
-    , Builder
     , Parser
+    , checkEither
     , checkMapIO
     , conf
     , env
     , help
+    , long
     , mapIO
     , metavar
+    , option
     , reader
     , setting
+    , short
     , str
+    , switch
     , withConfig
     )
+import System.Console.Haskeline
 
 mnemonicsClearTextOption :: Parser Text
 mnemonicsClearTextOption =
@@ -43,33 +49,48 @@ mnemonicsEncryptedOption =
         , conf "encryptedMnemonics"
         , metavar "ENCRYPTED_MNEMONICS"
         ]
-walletPassphraseCommon :: [Builder a]
+
+walletPassphraseCommon :: Parser Text
 walletPassphraseCommon =
-    [ env "ANTI_WALLET_PASSPHRASE"
-    , metavar "PASSPHRASE"
-    , help "The passphrase for the encrypted mnemonics"
-    ]
-walletPassphraseOption
-    :: Parser (Text -> IO Text)
-walletPassphraseOption =
-    fmap decryptText
+    mapIO id
         $ setting
-        $ reader str : walletPassphraseCommon
+            [ help "Prompt for the passphrase for the encrypted mnemonics"
+            , long "interactive-wallet-passphrase"
+            , switch $ queryConsole "Enter passphrase for encrypted mnemonics"
+            ]
+        <|> setting
+            [ env "ANTI_WALLET_PASSPHRASE"
+            , metavar "PASSPHRASE"
+            , help "The passphrase for the encrypted mnemonics"
+            , reader $ fmap (pure . T.pack) str
+            ]
+
+queryConsole :: String -> IO Text
+queryConsole prompt = runInputT defaultSettings $ do
+    pw <- getPassword (Just '*') (prompt <> ": ")
+    case pw of
+        Nothing -> pure ""
+        Just pw' -> pure $ T.pack pw'
 
 walletFileOption :: Parser FilePath
 walletFileOption =
     setting
         [ env "ANTI_WALLET_FILE"
         , metavar "FILEPATH"
-        , help "The file path to the wallet secrets mnemonics"
+        , help "The file path to the wallet secret mnemonics"
+        , long "wallet"
+        , short 'w'
         , reader str
+        , option
         ]
 
 coreMnemonicsParser :: Parser (Mnemonics 'DecryptedS)
 coreMnemonicsParser =
     fmap ClearText
         $ mnemonicsClearTextOption
-        <|> mapIO id (walletPassphraseOption <*> mnemonicsEncryptedOption)
+        <|> checkEither
+            id
+            (decryptText <$> walletPassphraseCommon <*> mnemonicsEncryptedOption)
 
 mnemonicsObject :: Parser Object
 mnemonicsObject =

cli/src/Wallet/Cli.hs

@@ -30,20 +30,18 @@ instance (ToJSON m a, Monad m) => ToJSON m (Either WalletError a) where
 data WalletInfo = WalletInfo
     { address :: Address
     , owner :: Owner
-    , filePath :: FilePath
     }
 
 instance Monad m => ToJSON m WalletInfo where
-    toJSON WalletInfo{address, owner, filePath} =
+    toJSON WalletInfo{address, owner} =
         object
             [ "address" .= address
             , "owner" .= owner
-            , "filePath" .= filePath
             ]
 
 data WalletCommand a where
     Info
-        :: Wallet -> FilePath -> WalletCommand (Either WalletError WalletInfo)
+        :: Wallet -> WalletCommand (Either WalletError WalletInfo)
     Create
         :: FilePath
         -> Maybe Text
@@ -53,13 +51,12 @@ deriving instance Show (WalletCommand a)
 deriving instance Eq (WalletCommand a)
 
 walletCmd :: WalletCommand a -> IO a
-walletCmd (Info wallet filePath) =
+walletCmd (Info wallet) =
     pure
         $ Right
         $ WalletInfo
             { address = wallet.address
             , owner = wallet.owner
-            , filePath = filePath
             }
 walletCmd (Create walletFile passphrase) = do
     w12 <- replicateM 12 $ element englishWords
@@ -72,7 +69,6 @@ walletCmd (Create walletFile passphrase) = do
                 $ WalletInfo
                     { address = wallet.address
                     , owner = wallet.owner
-                    , filePath = walletFile
                     }
 
 element :: [a] -> IO a

cli/src/Wallet/Options.hs

@@ -26,15 +26,9 @@ walletCommandParser =
         , command
             "info"
             "Get the wallet information"
-            $ fmap Box . Info
+            $ Box . Info
                 <$> walletOption
-                <*> walletFileOption
         ]
 
 passphraseOption :: Parser (Maybe Text)
-passphraseOption =
-    setting
-        $ walletPassphraseCommon
-            <> [ reader $ Just <$> str
-               , value Nothing
-               ]
+passphraseOption = optional walletPassphraseCommon

cli/test/Core/EncryptionSpec.hs

@@ -33,11 +33,11 @@ spec = do
             $ forAll gen
             $ \(message, passphrase, runs) -> do
                 encrypted <- encrypt passphrase runs message
-                decrypted <- decrypt passphrase encrypted
-                decrypted `shouldBe` message
+                let decrypted = decrypt passphrase encrypted
+                decrypted `shouldBe` Right message
         it "should encrypt and decrypt a Text message correctly"
             $ forAll genText
             $ \(message, passphrase, runs) -> do
                 encrypted <- encryptText passphrase runs message
-                decrypted <- decryptText passphrase encrypted
-                decrypted `shouldBe` message
+                let decrypted = decryptText passphrase encrypted
+                decrypted `shouldBe` Right message