-- | Bindings Authorization part of The OAuth 2.0 Authorization Framework
-- RFC6749 <https://www.rfc-editor.org/rfc/rfc6749>
module Network.OAuth.OAuth2.AuthorizationRequest where

import Data.Aeson
import Data.Function (on)
import Data.List qualified as List
import Data.Text (Text)
import Data.Text.Encoding qualified as T
import Lens.Micro (over)
import Network.OAuth.OAuth2.Internal
import URI.ByteString
import Prelude hiding (error)

--------------------------------------------------

-- * Authorization Request Errors

--------------------------------------------------

-- | Authorization Code Grant Error Responses https://tools.ietf.org/html/rfc6749#section-4.1.2.1
--
-- I found hard time to figure a way to test the authorization error flow
-- When anything wrong in @/authorize@ request, it will stuck at the Provider page
-- hence no way for this library to parse error response.
-- In other words, @/authorize@ ends up with 4xx or 5xx.
-- Revisit this whenever find a case OAuth2 provider redirects back to Relying party with errors.
data AuthorizationResponseError = AuthorizationResponseError
  { AuthorizationResponseError -> AuthorizationResponseErrorCode
authorizationResponseError :: AuthorizationResponseErrorCode
  , AuthorizationResponseError -> Maybe Text
authorizationResponseErrorDescription :: Maybe Text
  , AuthorizationResponseError -> Maybe (URIRef Absolute)
authorizationResponseErrorUri :: Maybe (URIRef Absolute)
  }
  deriving (Int -> AuthorizationResponseError -> ShowS
[AuthorizationResponseError] -> ShowS
AuthorizationResponseError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthorizationResponseError] -> ShowS
$cshowList :: [AuthorizationResponseError] -> ShowS
show :: AuthorizationResponseError -> String
$cshow :: AuthorizationResponseError -> String
showsPrec :: Int -> AuthorizationResponseError -> ShowS
$cshowsPrec :: Int -> AuthorizationResponseError -> ShowS
Show, AuthorizationResponseError -> AuthorizationResponseError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthorizationResponseError -> AuthorizationResponseError -> Bool
$c/= :: AuthorizationResponseError -> AuthorizationResponseError -> Bool
== :: AuthorizationResponseError -> AuthorizationResponseError -> Bool
$c== :: AuthorizationResponseError -> AuthorizationResponseError -> Bool
Eq)

data AuthorizationResponseErrorCode
  = InvalidRequest
  | UnauthorizedClient
  | AccessDenied
  | UnsupportedResponseType
  | InvalidScope
  | ServerError
  | TemporarilyUnavailable
  | UnknownErrorCode Text
  deriving (Int -> AuthorizationResponseErrorCode -> ShowS
[AuthorizationResponseErrorCode] -> ShowS
AuthorizationResponseErrorCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthorizationResponseErrorCode] -> ShowS
$cshowList :: [AuthorizationResponseErrorCode] -> ShowS
show :: AuthorizationResponseErrorCode -> String
$cshow :: AuthorizationResponseErrorCode -> String
showsPrec :: Int -> AuthorizationResponseErrorCode -> ShowS
$cshowsPrec :: Int -> AuthorizationResponseErrorCode -> ShowS
Show, AuthorizationResponseErrorCode
-> AuthorizationResponseErrorCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthorizationResponseErrorCode
-> AuthorizationResponseErrorCode -> Bool
$c/= :: AuthorizationResponseErrorCode
-> AuthorizationResponseErrorCode -> Bool
== :: AuthorizationResponseErrorCode
-> AuthorizationResponseErrorCode -> Bool
$c== :: AuthorizationResponseErrorCode
-> AuthorizationResponseErrorCode -> Bool
Eq)

instance FromJSON AuthorizationResponseErrorCode where
  parseJSON :: Value -> Parser AuthorizationResponseErrorCode
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"parseJSON AuthorizationResponseErrorCode" forall a b. (a -> b) -> a -> b
$ \Text
t ->
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Text
t of
      Text
"invalid_request" -> AuthorizationResponseErrorCode
InvalidRequest
      Text
"unauthorized_client" -> AuthorizationResponseErrorCode
UnauthorizedClient
      Text
"access_denied" -> AuthorizationResponseErrorCode
AccessDenied
      Text
"unsupported_response_type" -> AuthorizationResponseErrorCode
UnsupportedResponseType
      Text
"invalid_scope" -> AuthorizationResponseErrorCode
InvalidScope
      Text
"server_error" -> AuthorizationResponseErrorCode
ServerError
      Text
"temporarily_unavailable" -> AuthorizationResponseErrorCode
TemporarilyUnavailable
      Text
_ -> Text -> AuthorizationResponseErrorCode
UnknownErrorCode Text
t

instance FromJSON AuthorizationResponseError where
  parseJSON :: Value -> Parser AuthorizationResponseError
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"parseJSON AuthorizationResponseError" forall a b. (a -> b) -> a -> b
$ \Object
t -> do
    AuthorizationResponseErrorCode
authorizationResponseError <- Object
t forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"error"
    Maybe Text
authorizationResponseErrorDescription <- Object
t forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"error_description"
    Maybe (URIRef Absolute)
authorizationResponseErrorUri <- Object
t forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"error_uri"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure AuthorizationResponseError {Maybe Text
Maybe (URIRef Absolute)
AuthorizationResponseErrorCode
authorizationResponseErrorUri :: Maybe (URIRef Absolute)
authorizationResponseErrorDescription :: Maybe Text
authorizationResponseError :: AuthorizationResponseErrorCode
authorizationResponseErrorUri :: Maybe (URIRef Absolute)
authorizationResponseErrorDescription :: Maybe Text
authorizationResponseError :: AuthorizationResponseErrorCode
..}

--------------------------------------------------

-- * URLs

--------------------------------------------------

-- | See 'authorizationUrlWithParams'
authorizationUrl :: OAuth2 -> URI
authorizationUrl :: OAuth2 -> URIRef Absolute
authorizationUrl = QueryParams -> OAuth2 -> URIRef Absolute
authorizationUrlWithParams []

-- | Prepare the authorization URL.  Redirect to this URL
-- asking for user interactive authentication.
--
-- @since 2.6.0
authorizationUrlWithParams :: QueryParams -> OAuth2 -> URI
authorizationUrlWithParams :: QueryParams -> OAuth2 -> URIRef Absolute
authorizationUrlWithParams QueryParams
qs OAuth2
oa = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (forall a. Lens' (URIRef a) Query
queryL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Query QueryParams
queryPairsL) (forall a. [a] -> [a] -> [a]
++ QueryParams
queryParts) (OAuth2 -> URIRef Absolute
oauth2AuthorizeEndpoint OAuth2
oa)
  where
    queryParts :: QueryParams
queryParts =
      forall a. (a -> a -> Bool) -> [a] -> [a]
List.nubBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$
        QueryParams
qs
          forall a. [a] -> [a] -> [a]
++ [ (ByteString
"client_id", Text -> ByteString
T.encodeUtf8 forall a b. (a -> b) -> a -> b
$ OAuth2 -> Text
oauth2ClientId OAuth2
oa)
             , (ByteString
"response_type", ByteString
"code")
             , (ByteString
"redirect_uri", forall a. URIRef a -> ByteString
serializeURIRef' forall a b. (a -> b) -> a -> b
$ OAuth2 -> URIRef Absolute
oauth2RedirectUri OAuth2
oa)
             ]