improve blockfrost token error reporting

cardano-foundation · Mar 21, 2022 · e495446 · e495446
1 parent 91667ea
commit e495446
Show file tree

Hide file tree

Showing 3 changed files with 28 additions and 24 deletions.
diff --git a/lib/shelley/exe/cardano-wallet.hs b/lib/shelley/exe/cardano-wallet.hs
@@ -236,12 +236,17 @@ 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
-                        `catch` \(Blockfrost.TokenFileException fp) -> do
-                            logError tr (MsgBlockfrostTokenError fp)
+                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
@@ -284,6 +289,7 @@ data MainLog
     | MsgSigInt
     | MsgShutdownHandler ShutdownHandlerLog
     | MsgFailedToParseGenesis Text
+    | MsgBlockfrostTokenFileError FilePath
     | MsgBlockfrostTokenError FilePath
     deriving (Show)
 
@@ -316,9 +322,14 @@ 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
+            , "'" <> T.pack tokenFile <> "'"
             , "specified in the --blockfrost-token-file\
             \ argument doesn't contain a valid Blockfrost API token."
             ]

diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Launch/Blockfrost.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Launch/Blockfrost.hs
@@ -8,7 +8,6 @@ module Cardano.Wallet.Shelley.Launch.Blockfrost
     , readToken
     , tokenFileOption
     , TokenException(..)
-    , TokenFileException(..)
     ) where
 
 import Prelude
@@ -30,11 +29,10 @@ import qualified Data.Text.IO as T
 newtype TokenFile = TokenFile FilePath
     deriving newtype (Eq, Show)
 
-data TokenException = EmptyToken FilePath | InvalidToken FilePath
-    deriving stock (Eq, Show)
-    deriving anyclass (Exception)
-
-newtype TokenFileException = TokenFileException FilePath
+data TokenException
+    = EmptyToken FilePath
+    | InvalidToken FilePath
+    | BadTokenFile FilePath
     deriving stock (Eq, Show)
     deriving anyclass (Exception)
 
@@ -50,15 +48,14 @@ tokenFileOption = option (TokenFile <$> str) $ mconcat
     ]
 
 readToken :: TokenFile -> IO Project
-readToken (TokenFile fp) = do
+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 fp `catch` \(_ :: IOException) ->
-        throw $ TokenFileException fp
+    line <- T.readFile f `catch` \(_ :: IOException) -> throw $ BadTokenFile f
     let tokenSrc = T.strip line
-    when (T.null tokenSrc) $ throw $ EmptyToken fp
+    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 fp
+      Left _ -> throw $ InvalidToken f
       Right project -> pure project
diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/Launch/BlockfrostSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/Launch/BlockfrostSpec.hs
@@ -12,11 +12,7 @@ import Blockfrost.Env
 import Cardano.Wallet.Shelley.Launch
     ( Mode (Light, Normal), modeOption )
 import Cardano.Wallet.Shelley.Launch.Blockfrost
-    ( TokenException (..)
-    , TokenFile (TokenFile)
-    , TokenFileException (TokenFileException)
-    , readToken
-    )
+    ( TokenException (..), TokenFile (TokenFile), readToken )
 import Options.Applicative
     ( ParserFailure (execFailure)
     , ParserResult (CompletionInvoked, Failure, Success)
@@ -76,7 +72,7 @@ spec = describe "Blockfrost CLI options" $ do
 
     it "readToken throws in case of a non-existing token file" $ do
         readToken (TokenFile "non-existing-file")
-            `shouldThrow` \(TokenFileException _) -> True
+            `shouldThrow` \(BadTokenFile _) -> True
 
     it "readToken throws in case of an empty token file" $
         withSystemTempFile "blockfrost.token" $ \f h -> do