on develop help sign in
Improving error reporting when attempting to parse JSON credentials

Quality of life improvement for #6.

commit2affd92e6e6bc8b84e73c62f6a13c6c70fc967ea authorBrendan Hay <brendan.g.hay@gmail.com> dateMon 26 Oct 2015, 11:46 (11 years ago) parent1ac3df7
1 file changed+26−13
gogol/src/Network/Google/Auth.hs+26−13
gogol/src/Network/Google/Auth.hs+26−13
@@ -236,10 +236,25 @@ fromFile l m = do
236236 x <- cloudSDKConfigPath
237237 fromFilePath x l m
238238
239−data Parse = SA !ServiceAccount | AU !AuthorisedUser
240−
241−instance FromJSON Parse where
242− parseJSON o = SA <$> parseJSON o <|> AU <$> parseJSON o
239+-- | An internal type inhabited by the supported JSON formats
240+-- for Application Default Credentials.
241+data AccountJSON
242+ = ParsedService !ServiceAccount
243+ | ParsedUser !AuthorisedUser
244+
245+-- The following instance accumulates all error messages if all parsers fail.
246+-- If there is a success, the entire parse succeeds with the single
247+-- successful parse.
248+instance FromJSON AccountJSON where
249+ parseJSON o =
250+ let x = ParsedService <$> parseEither parseJSON o
251+ y = ParsedUser <$> parseEither parseJSON o
252+ in either fail pure $
253+ case (x, y) of
254+ (Left e, Left e') -> Left $
255+ "Failed parsing service_account: " ++ e ++
256+ ", Failed parsing authorized_user: " ++ e'
257+ _ -> x <|> y
243258
244259-- | Attempt to load either a @service_account@ or @authorized_user@ formatted
245260-- file to obtain the credentials neccessary to perform a token refresh from
@@ -250,14 +265,15 @@ fromFilePath :: (MonadIO m, MonadCatch m)
250265 -> Manager
251266 -> m Auth
252267fromFilePath f l m = do
268+ logDebug l $ "Trying to read credentials from " <> build f
253269 p <- liftIO (doesFileExist f)
254270 unless p $
255271 throwM (MissingFileError f)
256272 e <- liftIO (LBS.readFile f) >>=
257273 either (throwM . InvalidFileError f) pure . parseLBS
258274 case e of
259− SA a -> refresh a l m >>= fmap AuthSign . liftIO . newMVar
260− AU u -> refresh u l m >>= fmap AuthUser . liftIO . newMVar
275+ ParsedService a -> refresh a l m >>= fmap AuthSign . liftIO . newMVar
276+ ParsedUser u -> refresh u l m >>= fmap AuthUser . liftIO . newMVar
261277
262278-- | Lookup the @GOOGLE_APPLICATION_CREDENTIALS@ environment variable for the
263279-- default application credentials filepath.
@@ -389,18 +405,15 @@ data ServiceAccount = ServiceAccount
389405
390406instance FromJSON ServiceAccount where
391407 parseJSON = withObject "service_account" $ \o -> do
392− bs <- Text.encodeUtf8 <$> o .: "private_key_id"
408+ bs <- Text.encodeUtf8 <$> o .: "private_key"
393409 ServiceAccount
394410 <$> o .: "client_id"
395411 <*> o .: "client_email"
396− <*> o .: "private_key"
397− <*> parseKey bs
398− where
399− parseKey bs =
400− case listToMaybe (readKeyFileFromMemory bs) of
412+ <*> o .: "private_key_id"
413+ <*> case listToMaybe (readKeyFileFromMemory bs) of
401414 Just (PrivKeyRSA k) -> pure k
402415 _ ->
403− fail "Unable to parse key contents from 'private_key_id'"
416+ fail "Unable to parse key contents from \"private_key\""
404417
405418-- {
406419-- "client_id": "32555940559.apps.googleusercontent.com",