In-line tryFetchCreds

This commit is contained in:
patrick brisbin 2021-02-26 14:46:07 -05:00
parent b6f1a70e5d
commit abb0ab557a
No known key found for this signature in database
GPG Key ID: 20299C6982D938FB

View File

@ -89,19 +89,16 @@ dispatchCallback name oauth2 getToken getCreds = do
token <-
errLeft OAuth2ResultError $ getToken manager oauth2' $ ExchangeToken
code
creds <- errLeft id $ tryFetchCreds $ getCreds manager token
creds <-
liftIO (getCreds manager token)
`catch` (throwError . FetchCredsIOException)
`catch` (throwError . FetchCredsYesodOAuth2Exception)
setCredsRedirect creds
where
errLeft
:: (MonadIO m, MonadError e m) => (e' -> e) -> IO (Either e' a) -> m a
errLeft f = either (throwError . f) pure <=< liftIO
tryFetchCreds :: IO a -> IO (Either DispatchError a)
tryFetchCreds f =
(Right <$> f)
`catch` (pure . Left . FetchCredsIOException)
`catch` (pure . Left . FetchCredsYesodOAuth2Exception)
withCallbackAndState
:: (MonadError DispatchError m, MonadAuthHandler site m)
=> Text