{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

module Network.OAuth.OAuth2.AuthorizationRequest where

import Data.Aeson
import qualified Data.Text.Encoding as T
import GHC.Generics
import Lens.Micro
import Network.OAuth.OAuth2.Internal
import URI.ByteString

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

-- * Errors

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

instance FromJSON Errors where
  parseJSON :: Value -> Parser Errors
parseJSON = Options -> Value -> Parser Errors
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions {constructorTagModifier :: String -> String
constructorTagModifier = Char -> String -> String
camelTo2 Char
'_', allNullaryToStringTag :: Bool
allNullaryToStringTag = Bool
True}

instance ToJSON Errors where
  toEncoding :: Errors -> Encoding
toEncoding = Options -> Errors -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions {constructorTagModifier :: String -> String
constructorTagModifier = Char -> String -> String
camelTo2 Char
'_', allNullaryToStringTag :: Bool
allNullaryToStringTag = Bool
True}

-- | Authorization Code Grant Error Responses https://tools.ietf.org/html/rfc6749#section-4.1.2.1
-- Implicit Grant Error Responses https://tools.ietf.org/html/rfc6749#section-4.2.2.1
data Errors
  = InvalidRequest
  | UnauthorizedClient
  | AccessDenied
  | UnsupportedResponseType
  | InvalidScope
  | ServerError
  | TemporarilyUnavailable
  deriving (Int -> Errors -> String -> String
[Errors] -> String -> String
Errors -> String
(Int -> Errors -> String -> String)
-> (Errors -> String)
-> ([Errors] -> String -> String)
-> Show Errors
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Errors] -> String -> String
$cshowList :: [Errors] -> String -> String
show :: Errors -> String
$cshow :: Errors -> String
showsPrec :: Int -> Errors -> String -> String
$cshowsPrec :: Int -> Errors -> String -> String
Show, Errors -> Errors -> Bool
(Errors -> Errors -> Bool)
-> (Errors -> Errors -> Bool) -> Eq Errors
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Errors -> Errors -> Bool
$c/= :: Errors -> Errors -> Bool
== :: Errors -> Errors -> Bool
$c== :: Errors -> Errors -> Bool
Eq, (forall x. Errors -> Rep Errors x)
-> (forall x. Rep Errors x -> Errors) -> Generic Errors
forall x. Rep Errors x -> Errors
forall x. Errors -> Rep Errors x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Errors x -> Errors
$cfrom :: forall x. Errors -> Rep Errors x
Generic)

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

-- * URLs

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

-- | Prepare the authorization URL.  Redirect to this URL
-- asking for user interactive authentication.
authorizationUrl :: OAuth2 -> URI
authorizationUrl :: OAuth2 -> URI
authorizationUrl OAuth2
oa = ASetter
  URI URI [(ByteString, ByteString)] [(ByteString, ByteString)]
-> ([(ByteString, ByteString)] -> [(ByteString, ByteString)])
-> URI
-> URI
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((Query -> Identity Query) -> URI -> Identity URI
forall a. Lens' (URIRef a) Query
queryL ((Query -> Identity Query) -> URI -> Identity URI)
-> (([(ByteString, ByteString)]
     -> Identity [(ByteString, ByteString)])
    -> Query -> Identity Query)
-> ASetter
     URI URI [(ByteString, ByteString)] [(ByteString, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(ByteString, ByteString)] -> Identity [(ByteString, ByteString)])
-> Query -> Identity Query
Lens' Query [(ByteString, ByteString)]
queryPairsL) ([(ByteString, ByteString)]
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. [a] -> [a] -> [a]
++ [(ByteString, ByteString)]
queryParts) (OAuth2 -> URI
oauth2AuthorizeEndpoint OAuth2
oa)
  where
    queryParts :: [(ByteString, ByteString)]
queryParts =
      [ (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", URI -> ByteString
forall a. URIRef a -> ByteString
serializeURIRef' (URI -> ByteString) -> URI -> ByteString
forall a b. (a -> b) -> a -> b
$ OAuth2 -> URI
oauth2RedirectUri OAuth2
oa)
      ]