    module Network.OAuth2.Experiment.Flows.AuthorizationRequest where

    import Control.Monad.IO.Class (MonadIO (..))
    import Data.Bifunctor
    import Data.Map.Strict (Map)
    import Data.Map.Strict qualified as Map
    import Data.Set (Set)
    import Data.Text.Lazy (Text)
    import Network.OAuth.OAuth2 hiding (RefreshToken)
    import Network.OAuth2.Experiment.Pkce
    import Network.OAuth2.Experiment.Types
    import Network.OAuth2.Experiment.Utils
    import URI.ByteString hiding (UserInfo)

    -------------------------------------------------------------------------------
    --                           Authorization Request                           --
    -------------------------------------------------------------------------------

    data AuthorizationRequestParam = AuthorizationRequestParam
      { AuthorizationRequestParam -> Set Scope
    arScope :: Set Scope
      , AuthorizationRequestParam -> AuthorizeState
    arState :: AuthorizeState
      , AuthorizationRequestParam -> ClientId
    arClientId :: ClientId
      , AuthorizationRequestParam -> Maybe RedirectUri
    arRedirectUri :: Maybe RedirectUri
      , AuthorizationRequestParam -> ResponseType
    arResponseType :: ResponseType
      -- ^ It could be optional there is only one redirect_uri registered.
      -- See: https://www.rfc-editor.org/rfc/rfc6749#section-3.1.2.3
      , AuthorizationRequestParam -> Map Text Text
    arExtraParams :: Map Text Text
      }

    instance ToQueryParam AuthorizationRequestParam where
      toQueryParam :: AuthorizationRequestParam -> Map Text Text
    toQueryParam AuthorizationRequestParam {Maybe RedirectUri
    Map Text Text
    Set Scope
    AuthorizeState
    ClientId
    ResponseType
    arScope :: AuthorizationRequestParam -> Set Scope
    arState :: AuthorizationRequestParam -> AuthorizeState
    arClientId :: AuthorizationRequestParam -> ClientId
    arRedirectUri :: AuthorizationRequestParam -> Maybe RedirectUri
    arResponseType :: AuthorizationRequestParam -> ResponseType
    arExtraParams :: AuthorizationRequestParam -> Map Text Text
    arScope :: Set Scope
    arState :: AuthorizeState
    arClientId :: ClientId
    arRedirectUri :: Maybe RedirectUri
    arResponseType :: ResponseType
    arExtraParams :: Map Text Text
    ..} =
        [Map Text Text] -> Map Text Text
    forall (f :: * -> *) k a.
    (Foldable f, Ord k) =>
    f (Map k a) -> Map k a
    Map.unions
          [ ResponseType -> Map Text Text
    forall a. ToQueryParam a => a -> Map Text Text
    toQueryParam ResponseType
    arResponseType
          , Set Scope -> Map Text Text
    forall a. ToQueryParam a => a -> Map Text Text
    toQueryParam Set Scope
    arScope
          , ClientId -> Map Text Text
    forall a. ToQueryParam a => a -> Map Text Text
    toQueryParam ClientId
    arClientId
          , AuthorizeState -> Map Text Text
    forall a. ToQueryParam a => a -> Map Text Text
    toQueryParam AuthorizeState
    arState
          , Maybe RedirectUri -> Map Text Text
    forall a. ToQueryParam a => a -> Map Text Text
    toQueryParam Maybe RedirectUri
    arRedirectUri
          , Map Text Text
    arExtraParams
          ]

    class HasAuthorizeRequest a where
      -- | Constructs Authorization Code request parameters
      -- | https://www.rfc-editor.org/rfc/rfc6749#section-4.1.1
      mkAuthorizationRequestParam :: a -> AuthorizationRequestParam

    -- | Constructs Authorization Code request URI
    -- https://www.rfc-editor.org/rfc/rfc6749#section-4.1.1
    mkAuthorizationRequest :: HasAuthorizeRequest a => IdpApplication i a -> URI
    mkAuthorizationRequest :: forall {k} a (i :: k).
    HasAuthorizeRequest a =>
    IdpApplication i a -> URI
    mkAuthorizationRequest IdpApplication i a
    idpApp =
      let req :: AuthorizationRequestParam
    req = a -> AuthorizationRequestParam
    forall a. HasAuthorizeRequest a => a -> AuthorizationRequestParam
    mkAuthorizationRequestParam (IdpApplication i a -> a
    forall k (i :: k) a. IdpApplication i a -> a
    application IdpApplication i a
    idpApp)
          allParams :: [(ByteString, ByteString)]
    allParams =
            ((Text, Text) -> (ByteString, ByteString))
    -> [(Text, Text)] -> [(ByteString, ByteString)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Text -> ByteString)
    -> (Text -> ByteString) -> (Text, Text) -> (ByteString, ByteString)
    forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
    forall (p :: * -> * -> *) a b c d.
    Bifunctor p =>
    (a -> b) -> (c -> d) -> p a c -> p b d
    bimap Text -> ByteString
    tlToBS Text -> ByteString
    tlToBS) ([(Text, Text)] -> [(ByteString, ByteString)])
    -> [(Text, Text)] -> [(ByteString, ByteString)]
    forall a b. (a -> b) -> a -> b
    $
              Map Text Text -> [(Text, Text)]
    forall k a. Map k a -> [(k, a)]
    Map.toList (Map Text Text -> [(Text, Text)])
    -> Map Text Text -> [(Text, Text)]
    forall a b. (a -> b) -> a -> b
    $
                AuthorizationRequestParam -> Map Text Text
    forall a. ToQueryParam a => a -> Map Text Text
    toQueryParam AuthorizationRequestParam
    req
       in [(ByteString, ByteString)] -> URI -> URI
    forall a. [(ByteString, ByteString)] -> URIRef a -> URIRef a
    appendQueryParams [(ByteString, ByteString)]
    allParams (URI -> URI) -> URI -> URI
    forall a b. (a -> b) -> a -> b
    $
            Idp i -> URI
    forall k (i :: k). Idp i -> URI
    idpAuthorizeEndpoint (IdpApplication i a -> Idp i
    forall k (i :: k) a. IdpApplication i a -> Idp i
    idp IdpApplication i a
    idpApp)

    -------------------------------------------------------------------------------
    --                                    PKCE                                   --
    -------------------------------------------------------------------------------

    -- | https://datatracker.ietf.org/doc/html/rfc7636
    class HasAuthorizeRequest a => HasPkceAuthorizeRequest a where
      mkPkceAuthorizeRequestParam :: MonadIO m => a -> m (AuthorizationRequestParam, CodeVerifier)

    -- | Constructs Authorization Code (PKCE) request URI and the Code Verifier.
    -- https://datatracker.ietf.org/doc/html/rfc7636
    mkPkceAuthorizeRequest ::
      (MonadIO m, HasPkceAuthorizeRequest a) =>
      IdpApplication i a ->
      m (URI, CodeVerifier)
    mkPkceAuthorizeRequest :: forall {k} (m :: * -> *) a (i :: k).
    (MonadIO m, HasPkceAuthorizeRequest a) =>
    IdpApplication i a -> m (URI, CodeVerifier)
    mkPkceAuthorizeRequest IdpApplication {a
    Idp i
    application :: forall k (i :: k) a. IdpApplication i a -> a
    idp :: forall k (i :: k) a. IdpApplication i a -> Idp i
    idp :: Idp i
    application :: a
    ..} = do
      (AuthorizationRequestParam
    req, CodeVerifier
    codeVerifier) <- a -> m (AuthorizationRequestParam, CodeVerifier)
    forall a (m :: * -> *).
    (HasPkceAuthorizeRequest a, MonadIO m) =>
    a -> m (AuthorizationRequestParam, CodeVerifier)
    forall (m :: * -> *).
    MonadIO m =>
    a -> m (AuthorizationRequestParam, CodeVerifier)
    mkPkceAuthorizeRequestParam a
    application
      let allParams :: [(ByteString, ByteString)]
    allParams = ((Text, Text) -> (ByteString, ByteString))
    -> [(Text, Text)] -> [(ByteString, ByteString)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Text -> ByteString)
    -> (Text -> ByteString) -> (Text, Text) -> (ByteString, ByteString)
    forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
    forall (p :: * -> * -> *) a b c d.
    Bifunctor p =>
    (a -> b) -> (c -> d) -> p a c -> p b d
    bimap Text -> ByteString
    tlToBS Text -> ByteString
    tlToBS) ([(Text, Text)] -> [(ByteString, ByteString)])
    -> [(Text, Text)] -> [(ByteString, ByteString)]
    forall a b. (a -> b) -> a -> b
    $ Map Text Text -> [(Text, Text)]
    forall k a. Map k a -> [(k, a)]
    Map.toList (Map Text Text -> [(Text, Text)])
    -> Map Text Text -> [(Text, Text)]
    forall a b. (a -> b) -> a -> b
    $ AuthorizationRequestParam -> Map Text Text
    forall a. ToQueryParam a => a -> Map Text Text
    toQueryParam AuthorizationRequestParam
    req
      let url :: URI
    url =
            [(ByteString, ByteString)] -> URI -> URI
    forall a. [(ByteString, ByteString)] -> URIRef a -> URIRef a
    appendQueryParams [(ByteString, ByteString)]
    allParams (URI -> URI) -> URI -> URI
    forall a b. (a -> b) -> a -> b
    $
              Idp i -> URI
    forall k (i :: k). Idp i -> URI
    idpAuthorizeEndpoint Idp i
    idp
      (URI, CodeVerifier) -> m (URI, CodeVerifier)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (URI
    url, CodeVerifier
    codeVerifier)