Merge #3184

3184: Rework CLI error reporting for the --blockfrost-token-file r=Unisay a=Unisay

- [x] I have changed the way token parsing errors are reported.

### Comments

Example:
```
[cardano-wallet.main:Error:4] [2022-03-18 17:44:51.47 UTC] File /nix/store/7mxbly45mn9x8lijmigk3k25wlzvcn3a-cardano-node-deployments/testnet/genesis-byron.json specified in the --blockfrost-token-file argument doesn't contain a valid Blockfrost API token.
[cardano-wallet.main:Debug:4] [2022-03-18 17:44:51.47 UTC] Logging shutdown.
```

### Issue Number

ADP-1426


Co-authored-by: Yuriy Lazaryev <[email protected]>
Co-authored-by: IOHK <[email protected]>

lib/shelley/cardano-wallet.cabal

@@ -36,8 +36,9 @@ library
     , bech32
     , bech32-th
     , binary
-    , blockfrost-client >=0.3.1.0 && <0.4
-    , blockfrost-client-core >=0.2.0.0 && <0.3
+    , blockfrost-api
+    , blockfrost-client
+    , blockfrost-client-core
     , bytestring
     , cardano-addresses
     , cardano-api

lib/shelley/exe/cardano-wallet.hs

@@ -143,7 +143,7 @@ import System.Environment
 import System.Exit
     ( ExitCode (..), exitWith )
 import UnliftIO.Exception
-    ( withException )
+    ( catch, withException )
 
 import qualified Cardano.BM.Backend.EKGView as EKG
 import qualified Cardano.Wallet.Shelley.Launch.Blockfrost as Blockfrost
@@ -236,10 +236,18 @@ cmdServe = command "serve" $ info (helper <*> helper' <*> cmd) $
                 setupDirectory (logInfo tr . MsgSetupDatabases)
 
             blockchainSource <- case mode of
-                Normal conn ->
-                    pure $ NodeSource conn vData
-                Light token ->
-                    BlockfrostSource <$> Blockfrost.readToken token
+                Normal conn -> pure $ NodeSource conn vData
+                Light token -> BlockfrostSource <$> Blockfrost.readToken token
+                    `catch` \case
+                        Blockfrost.BadTokenFile f -> do
+                            logError tr $ MsgBlockfrostTokenFileError f
+                            exitWith $ ExitFailure 1
+                        Blockfrost.EmptyToken f -> do
+                            logError tr $ MsgBlockfrostTokenError f
+                            exitWith $ ExitFailure 1
+                        Blockfrost.InvalidToken f -> do
+                            logError tr $ MsgBlockfrostTokenError f
+                            exitWith $ ExitFailure 1
 
             exitWith =<< serveWallet
                 blockchainSource
@@ -265,6 +273,7 @@ cmdServe = command "serve" $ info (helper <*> helper' <*> cmd) $
     withShutdownHandlerMaybe tr True = void . withShutdownHandler trShutdown
       where
         trShutdown = trMessage $ contramap (second (fmap MsgShutdownHandler)) tr
+
 {-------------------------------------------------------------------------------
                                     Logging
 -------------------------------------------------------------------------------}
@@ -280,6 +289,8 @@ data MainLog
     | MsgSigInt
     | MsgShutdownHandler ShutdownHandlerLog
     | MsgFailedToParseGenesis Text
+    | MsgBlockfrostTokenFileError FilePath
+    | MsgBlockfrostTokenError FilePath
     deriving (Show)
 
 instance ToText MainLog where
@@ -311,6 +322,17 @@ instance ToText MainLog where
             , "parameters."
             , "Here's (perhaps) some helpful hint:", hint
             ]
+        MsgBlockfrostTokenFileError tokenFile -> T.unwords
+            [ "File"
+            , "'" <> T.pack tokenFile <> "'"
+            , "specified in the --blockfrost-token-file can't be read."
+            ]
+        MsgBlockfrostTokenError tokenFile -> T.unwords
+            [ "File"
+            , "'" <> T.pack tokenFile <> "'"
+            , "specified in the --blockfrost-token-file\
+            \ argument doesn't contain a valid Blockfrost API token."
+            ]
 
 withTracers
     :: LoggingOptions TracerSeverities

lib/shelley/src/Cardano/Wallet/Shelley/Launch/Blockfrost.hs

@@ -1,24 +1,41 @@
+{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Cardano.Wallet.Shelley.Launch.Blockfrost
-    ( TokenFile
+    ( TokenFile (..)
     , readToken
     , tokenFileOption
+    , TokenException(..)
     ) where
 
 import Prelude
 
-import Blockfrost.Client.Core
-    ( projectFromFile )
 import Blockfrost.Client.Types
     ( Project (..) )
+import Blockfrost.Env
+    ( parseEnv )
+import Control.Exception
+    ( Exception, IOException, catch, throw )
+import Control.Monad
+    ( when )
 import Options.Applicative
     ( Parser, help, long, metavar, option, str )
 
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+
 newtype TokenFile = TokenFile FilePath
     deriving newtype (Eq, Show)
 
+data TokenException
+    = EmptyToken FilePath
+    | InvalidToken FilePath
+    | BadTokenFile FilePath
+    deriving stock (Eq, Show)
+    deriving anyclass (Exception)
+
 -- | --blockfrost-token-file FILE
 tokenFileOption :: Parser TokenFile
 tokenFileOption = option (TokenFile <$> str) $ mconcat
@@ -31,4 +48,14 @@ tokenFileOption = option (TokenFile <$> str) $ mconcat
     ]
 
 readToken :: TokenFile -> IO Project
-readToken (TokenFile fp) = projectFromFile fp
+readToken (TokenFile f) = do
+    -- Can't use `Blockfrost.Client.Core.projectFromFile` as it uses `error`
+    -- and it leads to an unnecessary output that pollutes stdout.
+    line <- T.readFile f `catch` \(_ :: IOException) -> throw $ BadTokenFile f
+    let tokenSrc = T.strip line
+    when (T.null tokenSrc) $ throw $ EmptyToken f
+    let tEnv = T.dropEnd 32 tokenSrc
+        token = T.drop (T.length tEnv) tokenSrc
+    case Project <$> parseEnv tEnv <*> pure token of
+      Left _ -> throw $ InvalidToken f
+      Right project -> pure project

lib/shelley/test/unit/Cardano/Wallet/Shelley/Launch/BlockfrostSpec.hs

@@ -12,7 +12,7 @@ import Blockfrost.Env
 import Cardano.Wallet.Shelley.Launch
     ( Mode (Light, Normal), modeOption )
 import Cardano.Wallet.Shelley.Launch.Blockfrost
-    ( readToken )
+    ( TokenException (..), TokenFile (TokenFile), readToken )
 import Options.Applicative
     ( ParserFailure (execFailure)
     , ParserResult (CompletionInvoked, Failure, Success)
@@ -22,7 +22,14 @@ import Options.Applicative
     , info
     )
 import Test.Hspec
-    ( Spec, describe, expectationFailure, it, shouldBe, shouldReturn )
+    ( Spec
+    , describe
+    , expectationFailure
+    , it
+    , shouldReturn
+    , shouldStartWith
+    , shouldThrow
+    )
 import Test.Utils.Platform
     ( isWindows )
 import UnliftIO
@@ -60,14 +67,22 @@ spec = describe "Blockfrost CLI options" $ do
             args = ["--blockfrost-token-file", mockSocketOrPipe]
         case execParserPure defaultPrefs parserInfo args of
             Failure pf | (help, _code, _int) <- execFailure pf "" ->
-                show help `shouldBe`
-                    "Missing: --light\n\n\
-                    \Usage:  (--node-socket " <> nodeSocketMetavar <> " | \
-                    \--light --blockfrost-token-file FILE)"
+                show help `shouldStartWith` "Missing: --light"
             result -> expectationFailure $ show result
 
-nodeSocketMetavar :: String
-nodeSocketMetavar = if isWindows then "PIPENAME" else "FILE"
+    it "readToken throws in case of a non-existing token file" $ do
+        readToken (TokenFile "non-existing-file")
+            `shouldThrow` \(BadTokenFile _) -> True
+
+    it "readToken throws in case of an empty token file" $
+        withSystemTempFile "blockfrost.token" $ \f h -> do
+            hClose h
+            readToken (TokenFile f) `shouldThrow` \(EmptyToken _) -> True
+
+    it "readToken throws in case of an invalid token file content" $
+        withSystemTempFile "blockfrost.token" $ \f h -> do
+            hClose h *> writeFile f "invalid"
+            readToken (TokenFile f) `shouldThrow` \(InvalidToken _) -> True
 
 mockSocketOrPipe :: String
 mockSocketOrPipe = if isWindows then "\\\\.\\pipe\\test" else "/tmp/pipe"