{-# LANGUAGE OverloadedStrings #-}
module Yesod.Auth.OAuth2.ErrorResponse
( ErrorResponse(..)
, erUserMessage
, ErrorName(..)
, onErrorResponse
, unknownError
) 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
erUserMessage :: ErrorResponse -> Text
erUserMessage err = case erName err of
InvalidRequest -> "Invalid request"
UnauthorizedClient -> "Unauthorized client"
AccessDenied -> "Access denied"
UnsupportedResponseType -> "Unsupported response type"
InvalidScope -> "Invalid scope"
ServerError -> "Server error"
TemporarilyUnavailable -> "Temporarily unavailable"
Unknown _ -> "Unknown error"
unknownError :: Text -> ErrorResponse
unknownError x = ErrorResponse
{ erName = Unknown x
, erDescription = Nothing
, erURI = Nothing
}
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