Rework CLI error reporting for the --blockfrost-token-file

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
@@ -240,6 +240,9 @@ cmdServe = command "serve" $ info (helper <*> helper' <*> cmd) $
                     pure $ NodeSource conn vData
                 Light token ->
                     BlockfrostSource <$> Blockfrost.readToken token
+                        `catch` \(Blockfrost.TokenFileException fp) -> do
+                            logError tr (MsgBlockfrostTokenError fp)
+                            exitWith $ ExitFailure 1
 
             exitWith =<< serveWallet
                 blockchainSource
@@ -265,6 +268,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 +284,7 @@ data MainLog
     | MsgSigInt
     | MsgShutdownHandler ShutdownHandlerLog
     | MsgFailedToParseGenesis Text
+    | MsgBlockfrostTokenError FilePath
     deriving (Show)
 
 instance ToText MainLog where
@@ -311,6 +316,12 @@ instance ToText MainLog where
             , "parameters."
             , "Here's (perhaps) some helpful hint:", hint
             ]
+        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,38 @@
+{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Cardano.Wallet.Shelley.Launch.Blockfrost
-    ( TokenFile
+    ( TokenFile (..)
     , readToken
     , tokenFileOption
+    , TokenFileException(..)
     ) where
 
 import Prelude
 
-import Blockfrost.Client.Core
-    ( projectFromFile )
 import Blockfrost.Client.Types
     ( Project (..) )
+import Blockfrost.Env
+    ( parseEnv )
+import Control.Exception
+    ( Exception, throw )
+import Data.Text
+    ( Text )
 import Options.Applicative
     ( Parser, help, long, metavar, option, str )
 
+import qualified Data.Text as Text
+import qualified Data.Text.IO as Text
+
 newtype TokenFile = TokenFile FilePath
     deriving newtype (Eq, Show)
 
+newtype TokenFileException = TokenFileException FilePath
+    deriving stock (Eq, Show)
+    deriving anyclass (Exception)
+
 -- | --blockfrost-token-file FILE
 tokenFileOption :: Parser TokenFile
 tokenFileOption = option (TokenFile <$> str) $ mconcat
@@ -31,4 +45,14 @@ tokenFileOption = option (TokenFile <$> str) $ mconcat
     ]
 
 readToken :: TokenFile -> IO Project
-readToken (TokenFile fp) = projectFromFile fp
+readToken (TokenFile fp) = Text.readFile fp >>=
+    either (throw (TokenFileException fp) . const) pure . mkProject
+  where
+    -- Can't use `Blockfrost.Client.Core.projectFromFile` as it uses `error`
+    -- and it leads to an unnecessary output that pollutes stdout.
+    mkProject :: Text -> Either Text Project
+    mkProject t =
+      let st = Text.strip t
+          tEnv = Text.dropEnd 32 st
+          token = Text.drop (Text.length tEnv) st
+      in Project <$> parseEnv tEnv <*> pure token