haskell/yesod-auth-oauth2
1
0
Fork 0
mirror of https://github.com/freckle/yesod-auth-oauth2.git synced 2026-04-21 10:17:43 +02:00
Code Issues Actions Packages Projects Releases Wiki Activity

In-line errLeft

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

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

@ -86,18 +86,13 @@ dispatchCallback name oauth2 getToken getCreds = do
code <- requireGetParam "code" code <- requireGetParam "code"
manager <- authHttpManager manager <- authHttpManager
oauth2' <- withCallbackAndState name oauth2 csrf oauth2' <- withCallbackAndState name oauth2 csrf
token <- token <- either (throwError . OAuth2ResultError) pure
errLeft OAuth2ResultError $ getToken manager oauth2' $ ExchangeToken =<< liftIO (getToken manager oauth2' $ ExchangeToken code)
code
creds <- creds <-
liftIO (getCreds manager token) liftIO (getCreds manager token)
`catch` (throwError . FetchCredsIOException) `catch` (throwError . FetchCredsIOException)
`catch` (throwError . FetchCredsYesodOAuth2Exception) `catch` (throwError . FetchCredsYesodOAuth2Exception)
setCredsRedirect creds setCredsRedirect creds
where
errLeft
:: (MonadIO m, MonadError e m) => (e' -> e) -> IO (Either e' a) -> m a
errLeft f = either (throwError . f) pure <=< liftIO
withCallbackAndState withCallbackAndState
:: (MonadError DispatchError m, MonadAuthHandler site m) :: (MonadError DispatchError m, MonadAuthHandler site m)