{-# LANGUAGE OverloadedStrings #-}
-- | OAuth callback error response
--
-- <https://tools.ietf.org/html/rfc6749#section-4.1.2.1>
--
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

-- | Check query parameters for an error, if found run the given action
--
-- The action is expected to use a short-circuit response function like
-- @'permissionDenied'@, hence this returning @()@.
--
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