{-# LANGUAGE OverloadedStrings #-}
module Yesod.Auth.OAuth2.ErrorResponse
( ErrorResponse(..)
, ErrorName(..)
, onErrorResponse
) where
import Data.Foldable (traverse_)
import Data.Text (Text)
import Data.Traversable (for)
import Yesod.Core (MonadHandler, lookupGetParam)
data ErrorName
= InvalidRequest
| UnauthorizedClient
| AccessDenied
| UnsupportedResponseType
| InvalidScope
| ServerError
| TemporarilyUnavailable
| Unknown Text
deriving Show
data ErrorResponse = ErrorResponse
{ erName :: ErrorName
, erDescription :: Maybe Text
, erURI :: Maybe Text
}
deriving Show
onErrorResponse :: MonadHandler m => (ErrorResponse -> m a) -> m ()
onErrorResponse f = traverse_ f =<< checkErrorResponse
checkErrorResponse :: MonadHandler m => m (Maybe ErrorResponse)
checkErrorResponse = do
merror <- lookupGetParam "error"
for merror $ \err -> ErrorResponse
<$> pure (readErrorName err)
<*> lookupGetParam "error_description"
<*> lookupGetParam "error_uri"
readErrorName :: Text -> ErrorName
readErrorName "invalid_request" = InvalidRequest
readErrorName "unauthorized_client" = UnauthorizedClient
readErrorName "access_denied" = AccessDenied
readErrorName "unsupported_response_type" = UnsupportedResponseType
readErrorName "invalid_scope" = InvalidScope
readErrorName "server_error" = ServerError
readErrorName "temporarily_unavailable" = TemporarilyUnavailable
readErrorName x = Unknown x