mirror of
https://github.com/freckle/yesod-auth-oauth2.git
synced 2026-01-24 09:51:58 +01:00
Prior to this commit, some errors would be thrown (missing parameter, invalid state, incorrect approot) while others would be handled via the set-message-redirect approach (handshake failure, fetch-token failure, etc). This commit consolidates all of these cases into a single DispatchError type, and then uses MonadError (concretely ExceptT) to capture them all and handle them in one place ourselves. It then updates that handling to: - Use onErrorHtml onErrorHtml will, by default, set-message-redirect. That make this behavior neutral for users running defaults. For users that have customized this, it will be an improvement that all our error cases now respect it. - Provided a JSON representation of errors - Attach a random correlation identifier The last two were just nice-to-haves that were cheap to add once the code was in this state. Note that the use of MonadError requires a potentially "bad" orphan MonadUnliftIO instance for ExceptT, but I'd like to see that instance become a reality and think it needs some real-world experimentation to get there, so here I am.
13 lines
347 B
Haskell
13 lines
347 B
Haskell
{-# OPTIONS_GHC -Wno-orphans #-}
|
|
|
|
module UnliftIO.Except
|
|
() where
|
|
|
|
import Control.Monad.Except
|
|
import UnliftIO
|
|
|
|
instance (MonadUnliftIO m, Exception e) => MonadUnliftIO (ExceptT e m) where
|
|
withRunInIO exceptToIO = ExceptT $ try $ do
|
|
withRunInIO $ \runInIO ->
|
|
exceptToIO (runInIO . (either throwIO pure <=< runExceptT))
|