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)
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
(Int -> AuthorizationResponseError -> ShowS)
-> (AuthorizationResponseError -> String)
-> ([AuthorizationResponseError] -> ShowS)
-> Show AuthorizationResponseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AuthorizationResponseError -> ShowS
showsPrec :: Int -> AuthorizationResponseError -> ShowS
$cshow :: AuthorizationResponseError -> String
show :: AuthorizationResponseError -> String
$cshowList :: [AuthorizationResponseError] -> ShowS
showList :: [AuthorizationResponseError] -> ShowS
Show, AuthorizationResponseError -> AuthorizationResponseError -> Bool
(AuthorizationResponseError -> AuthorizationResponseError -> Bool)
-> (AuthorizationResponseError
-> AuthorizationResponseError -> Bool)
-> Eq AuthorizationResponseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AuthorizationResponseError -> AuthorizationResponseError -> Bool
== :: AuthorizationResponseError -> AuthorizationResponseError -> Bool
$c/= :: AuthorizationResponseError -> AuthorizationResponseError -> Bool
/= :: AuthorizationResponseError -> AuthorizationResponseError -> Bool
Eq)
data AuthorizationResponseErrorCode
= InvalidRequest
| UnauthorizedClient
| AccessDenied
| UnsupportedResponseType
| InvalidScope
| ServerError
| TemporarilyUnavailable
| UnknownErrorCode Text
deriving (Int -> AuthorizationResponseErrorCode -> ShowS
[AuthorizationResponseErrorCode] -> ShowS
AuthorizationResponseErrorCode -> String
(Int -> AuthorizationResponseErrorCode -> ShowS)
-> (AuthorizationResponseErrorCode -> String)
-> ([AuthorizationResponseErrorCode] -> ShowS)
-> Show AuthorizationResponseErrorCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AuthorizationResponseErrorCode -> ShowS
showsPrec :: Int -> AuthorizationResponseErrorCode -> ShowS
$cshow :: AuthorizationResponseErrorCode -> String
show :: AuthorizationResponseErrorCode -> String
$cshowList :: [AuthorizationResponseErrorCode] -> ShowS
showList :: [AuthorizationResponseErrorCode] -> ShowS
Show, AuthorizationResponseErrorCode
-> AuthorizationResponseErrorCode -> Bool
(AuthorizationResponseErrorCode
-> AuthorizationResponseErrorCode -> Bool)
-> (AuthorizationResponseErrorCode
-> AuthorizationResponseErrorCode -> Bool)
-> Eq AuthorizationResponseErrorCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AuthorizationResponseErrorCode
-> AuthorizationResponseErrorCode -> Bool
== :: AuthorizationResponseErrorCode
-> AuthorizationResponseErrorCode -> Bool
$c/= :: AuthorizationResponseErrorCode
-> AuthorizationResponseErrorCode -> Bool
/= :: AuthorizationResponseErrorCode
-> AuthorizationResponseErrorCode -> Bool
Eq)
instance FromJSON AuthorizationResponseErrorCode where
parseJSON :: Value -> Parser AuthorizationResponseErrorCode
parseJSON = String
-> (Text -> Parser AuthorizationResponseErrorCode)
-> Value
-> Parser AuthorizationResponseErrorCode
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"parseJSON AuthorizationResponseErrorCode" ((Text -> Parser AuthorizationResponseErrorCode)
-> Value -> Parser AuthorizationResponseErrorCode)
-> (Text -> Parser AuthorizationResponseErrorCode)
-> Value
-> Parser AuthorizationResponseErrorCode
forall a b. (a -> b) -> a -> b
$ \Text
t ->
AuthorizationResponseErrorCode
-> Parser AuthorizationResponseErrorCode
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AuthorizationResponseErrorCode
-> Parser AuthorizationResponseErrorCode)
-> AuthorizationResponseErrorCode
-> Parser AuthorizationResponseErrorCode
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 = String
-> (Object -> Parser AuthorizationResponseError)
-> Value
-> Parser AuthorizationResponseError
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"parseJSON AuthorizationResponseError" ((Object -> Parser AuthorizationResponseError)
-> Value -> Parser AuthorizationResponseError)
-> (Object -> Parser AuthorizationResponseError)
-> Value
-> Parser AuthorizationResponseError
forall a b. (a -> b) -> a -> b
$ \Object
t -> do
AuthorizationResponseErrorCode
authorizationResponseError <- Object
t Object -> Key -> Parser AuthorizationResponseErrorCode
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"error"
Maybe Text
authorizationResponseErrorDescription <- Object
t Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"error_description"
Maybe (URIRef Absolute)
authorizationResponseErrorUri <- Object
t Object -> Key -> Parser (Maybe (URIRef Absolute))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"error_uri"
AuthorizationResponseError -> Parser AuthorizationResponseError
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AuthorizationResponseError {Maybe Text
Maybe (URIRef Absolute)
AuthorizationResponseErrorCode
authorizationResponseError :: AuthorizationResponseErrorCode
authorizationResponseErrorDescription :: Maybe Text
authorizationResponseErrorUri :: Maybe (URIRef Absolute)
authorizationResponseError :: AuthorizationResponseErrorCode
authorizationResponseErrorDescription :: Maybe Text
authorizationResponseErrorUri :: Maybe (URIRef Absolute)
..}
authorizationUrl :: OAuth2 -> URI
authorizationUrl :: OAuth2 -> URIRef Absolute
authorizationUrl = QueryParams -> OAuth2 -> URIRef Absolute
authorizationUrlWithParams []
authorizationUrlWithParams :: QueryParams -> OAuth2 -> URI
authorizationUrlWithParams :: QueryParams -> OAuth2 -> URIRef Absolute
authorizationUrlWithParams QueryParams
qs OAuth2
oa = ASetter (URIRef Absolute) (URIRef Absolute) QueryParams QueryParams
-> (QueryParams -> QueryParams)
-> URIRef Absolute
-> URIRef Absolute
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((Query -> Identity Query)
-> URIRef Absolute -> Identity (URIRef Absolute)
forall a (f :: * -> *).
Functor f =>
(Query -> f Query) -> URIRef a -> f (URIRef a)
queryL ((Query -> Identity Query)
-> URIRef Absolute -> Identity (URIRef Absolute))
-> ((QueryParams -> Identity QueryParams)
-> Query -> Identity Query)
-> ASetter
(URIRef Absolute) (URIRef Absolute) QueryParams QueryParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QueryParams -> Identity QueryParams) -> Query -> Identity Query
Lens' Query QueryParams
queryPairsL) (QueryParams -> QueryParams -> QueryParams
forall a. [a] -> [a] -> [a]
++ QueryParams
queryParts) (OAuth2 -> URIRef Absolute
oauth2AuthorizeEndpoint OAuth2
oa)
where
queryParts :: QueryParams
queryParts =
((ByteString, ByteString) -> (ByteString, ByteString) -> Bool)
-> QueryParams -> QueryParams
forall a. (a -> a -> Bool) -> [a] -> [a]
List.nubBy (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
(==) (ByteString -> ByteString -> Bool)
-> ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString)
-> (ByteString, ByteString)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst) (QueryParams -> QueryParams) -> QueryParams -> QueryParams
forall a b. (a -> b) -> a -> b
$
QueryParams
qs
QueryParams -> QueryParams -> QueryParams
forall a. [a] -> [a] -> [a]
++ [ (ByteString
"client_id", Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ OAuth2 -> Text
oauth2ClientId OAuth2
oa)
, (ByteString
"response_type", ByteString
"code")
, (ByteString
"redirect_uri", URIRef Absolute -> ByteString
forall a. URIRef a -> ByteString
serializeURIRef' (URIRef Absolute -> ByteString) -> URIRef Absolute -> ByteString
forall a b. (a -> b) -> a -> b
$ OAuth2 -> URIRef Absolute
oauth2RedirectUri OAuth2
oa)
]