haskell/yesod-auth-oauth2
1
0
Fork 0
mirror of https://github.com/freckle/yesod-auth-oauth2.git synced 2026-02-27 18:07:55 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

In-line tryFetchCreds

Browse Source
This commit is contained in:
patrick brisbin 2021-02-26 14:46:07 -05:00
parent b71ae8f60d
commit 65694e10d7
1 changed files with 4 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/Yesod/Auth/OAuth2/Dispatch.hs
View File

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