    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE RankNTypes #-}

    module Network.OAuth2.Experiment.Types where

    import Data.Default (Default (def))
    import Data.Map.Strict (Map)
    import Data.Map.Strict qualified as Map
    import Data.Set (Set)
    import Data.Set qualified as Set
    import Data.String
    import Data.Text.Lazy (Text)
    import Data.Text.Lazy qualified as TL
    import Network.OAuth.OAuth2 hiding (RefreshToken)
    import Network.OAuth.OAuth2 qualified as OAuth2
    import Network.OAuth2.Experiment.Pkce
    import Network.OAuth2.Experiment.Utils
    import URI.ByteString (URI, serializeURIRef')

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

    -- * Idp App

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

    -- TODO: Distinct type per endpoint
    -- Because I made mistake at passing to Authorize and Token Request

    -- | @Idp i@ consists various endpoints endpoints.
    --
    -- The @i@ is actually phantom type for information only (Idp name) at this moment.
    -- And it is PolyKinds.
    --
    -- Hence whenever @Idp i@ or @IdpApplication i a@ is used as function parameter,
    -- PolyKinds need to be enabled.
    data Idp (i :: k) = Idp
      { forall k (i :: k). Idp i -> URI
    idpUserInfoEndpoint :: URI
      -- ^ Userinfo Endpoint
      , forall k (i :: k). Idp i -> URI
    idpAuthorizeEndpoint :: URI
      -- ^ Authorization Endpoint
      , forall k (i :: k). Idp i -> URI
    idpTokenEndpoint :: URI
      -- ^ Token Endpoint
      , forall k (i :: k). Idp i -> Maybe URI
    idpDeviceAuthorizationEndpoint :: Maybe URI
      -- ^ Apparently not all IdP support device code flow
      }

    -- | An OAuth2 Application "a" of IdP "i".
    -- "a" can be one of following type:
    --
    -- * `Network.OAuth2.Experiment.AuthorizationCodeApplication`
    -- * `Network.OAuth2.Experiment.DeviceAuthorizationApplication`
    -- * `Network.OAuth2.Experiment.ClientCredentialsApplication`
    -- * `Network.OAuth2.Experiment.ResourceOwnerPasswordApplication`
    -- * `Network.OAuth2.Experiment.JwtBearerApplication`
    data IdpApplication (i :: k) a = IdpApplication
      { forall k (i :: k) a. IdpApplication i a -> Idp i
    idp :: Idp i
      , forall k (i :: k) a. IdpApplication i a -> a
    application :: a
      }

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

    -- * Scope

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

    -- TODO: What's best type for Scope?
    -- Use 'Text' isn't super type safe. All cannot specify some standard scopes like openid, email etc.
    -- But Following data type is not ideal as Idp would have lots of 'Custom Text'
    --
    -- @
    -- data Scope = OPENID | PROFILE | EMAIL | OFFLINE_ACCESS | Custom Text
    -- @
    --
    -- Would be nice to define Enum for standard Scope, plus allow user to define their own define (per Idp) and plugin somehow.
    newtype Scope = Scope {Scope -> Text
    unScope :: Text}
      deriving (Scope -> Scope -> Bool
    (Scope -> Scope -> Bool) -> (Scope -> Scope -> Bool) -> Eq Scope
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Scope -> Scope -> Bool
    == :: Scope -> Scope -> Bool
    $c/= :: Scope -> Scope -> Bool
    /= :: Scope -> Scope -> Bool
    Eq, Eq Scope
    Eq Scope =>
    (Scope -> Scope -> Ordering)
    -> (Scope -> Scope -> Bool)
    -> (Scope -> Scope -> Bool)
    -> (Scope -> Scope -> Bool)
    -> (Scope -> Scope -> Bool)
    -> (Scope -> Scope -> Scope)
    -> (Scope -> Scope -> Scope)
    -> Ord Scope
    Scope -> Scope -> Bool
    Scope -> Scope -> Ordering
    Scope -> Scope -> Scope
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Scope -> Scope -> Ordering
    compare :: Scope -> Scope -> Ordering
    $c< :: Scope -> Scope -> Bool
    < :: Scope -> Scope -> Bool
    $c<= :: Scope -> Scope -> Bool
    <= :: Scope -> Scope -> Bool
    $c> :: Scope -> Scope -> Bool
    > :: Scope -> Scope -> Bool
    $c>= :: Scope -> Scope -> Bool
    >= :: Scope -> Scope -> Bool
    $cmax :: Scope -> Scope -> Scope
    max :: Scope -> Scope -> Scope
    $cmin :: Scope -> Scope -> Scope
    min :: Scope -> Scope -> Scope
    Ord)

    instance IsString Scope where
      fromString :: String -> Scope
      fromString :: String -> Scope
    fromString = Text -> Scope
    Scope (Text -> Scope) -> (String -> Text) -> String -> Scope
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    TL.pack

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

    -- * Grant Type value

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

    -- | Grant type query parameter has association with different GrantType flows but not completely strict.
    --
    -- e.g. Both AuthorizationCode and ResourceOwnerPassword flow could support refresh token flow.
    data GrantTypeValue
      = GTAuthorizationCode
      | GTPassword
      | GTClientCredentials
      | GTRefreshToken
      | GTJwtBearer
      | GTDeviceCode
      deriving (GrantTypeValue -> GrantTypeValue -> Bool
    (GrantTypeValue -> GrantTypeValue -> Bool)
    -> (GrantTypeValue -> GrantTypeValue -> Bool) -> Eq GrantTypeValue
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: GrantTypeValue -> GrantTypeValue -> Bool
    == :: GrantTypeValue -> GrantTypeValue -> Bool
    $c/= :: GrantTypeValue -> GrantTypeValue -> Bool
    /= :: GrantTypeValue -> GrantTypeValue -> Bool
    Eq, Int -> GrantTypeValue -> ShowS
    [GrantTypeValue] -> ShowS
    GrantTypeValue -> String
    (Int -> GrantTypeValue -> ShowS)
    -> (GrantTypeValue -> String)
    -> ([GrantTypeValue] -> ShowS)
    -> Show GrantTypeValue
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> GrantTypeValue -> ShowS
    showsPrec :: Int -> GrantTypeValue -> ShowS
    $cshow :: GrantTypeValue -> String
    show :: GrantTypeValue -> String
    $cshowList :: [GrantTypeValue] -> ShowS
    showList :: [GrantTypeValue] -> ShowS
    Show)

    -------------------------------------------------------------------------------
    --                               Response Type                               --
    -------------------------------------------------------------------------------
    data ResponseType = Code

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

    -- * Credentials

    -------------------------------------------------------------------------------
    newtype ClientId = ClientId {ClientId -> Text
    unClientId :: Text}
      deriving (Int -> ClientId -> ShowS
    [ClientId] -> ShowS
    ClientId -> String
    (Int -> ClientId -> ShowS)
    -> (ClientId -> String) -> ([ClientId] -> ShowS) -> Show ClientId
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ClientId -> ShowS
    showsPrec :: Int -> ClientId -> ShowS
    $cshow :: ClientId -> String
    show :: ClientId -> String
    $cshowList :: [ClientId] -> ShowS
    showList :: [ClientId] -> ShowS
    Show, ClientId -> ClientId -> Bool
    (ClientId -> ClientId -> Bool)
    -> (ClientId -> ClientId -> Bool) -> Eq ClientId
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ClientId -> ClientId -> Bool
    == :: ClientId -> ClientId -> Bool
    $c/= :: ClientId -> ClientId -> Bool
    /= :: ClientId -> ClientId -> Bool
    Eq, String -> ClientId
    (String -> ClientId) -> IsString ClientId
    forall a. (String -> a) -> IsString a
    $cfromString :: String -> ClientId
    fromString :: String -> ClientId
    IsString)

    -- | Can be either "Client Secret" or JWT base on client authentication method
    newtype ClientSecret = ClientSecret {ClientSecret -> Text
    unClientSecret :: Text}
      deriving (ClientSecret -> ClientSecret -> Bool
    (ClientSecret -> ClientSecret -> Bool)
    -> (ClientSecret -> ClientSecret -> Bool) -> Eq ClientSecret
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ClientSecret -> ClientSecret -> Bool
    == :: ClientSecret -> ClientSecret -> Bool
    $c/= :: ClientSecret -> ClientSecret -> Bool
    /= :: ClientSecret -> ClientSecret -> Bool
    Eq, String -> ClientSecret
    (String -> ClientSecret) -> IsString ClientSecret
    forall a. (String -> a) -> IsString a
    $cfromString :: String -> ClientSecret
    fromString :: String -> ClientSecret
    IsString)

    -- | In order to reuse some methods from legacy "Network.OAuth.OAuth2".
    -- Will be removed when Experiment module becomes default.
    toOAuth2Key :: ClientId -> ClientSecret -> OAuth2
    toOAuth2Key :: ClientId -> ClientSecret -> OAuth2
    toOAuth2Key ClientId
    cid ClientSecret
    csecret =
      OAuth2
    forall a. Default a => a
    def
        { oauth2ClientId = TL.toStrict $ unClientId cid
        , oauth2ClientSecret = TL.toStrict $ unClientSecret csecret
        }

    newtype RedirectUri = RedirectUri {RedirectUri -> URI
    unRedirectUri :: URI}
      deriving (RedirectUri -> RedirectUri -> Bool
    (RedirectUri -> RedirectUri -> Bool)
    -> (RedirectUri -> RedirectUri -> Bool) -> Eq RedirectUri
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: RedirectUri -> RedirectUri -> Bool
    == :: RedirectUri -> RedirectUri -> Bool
    $c/= :: RedirectUri -> RedirectUri -> Bool
    /= :: RedirectUri -> RedirectUri -> Bool
    Eq)

    newtype AuthorizeState = AuthorizeState {AuthorizeState -> Text
    unAuthorizeState :: Text}
      deriving (AuthorizeState -> AuthorizeState -> Bool
    (AuthorizeState -> AuthorizeState -> Bool)
    -> (AuthorizeState -> AuthorizeState -> Bool) -> Eq AuthorizeState
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: AuthorizeState -> AuthorizeState -> Bool
    == :: AuthorizeState -> AuthorizeState -> Bool
    $c/= :: AuthorizeState -> AuthorizeState -> Bool
    /= :: AuthorizeState -> AuthorizeState -> Bool
    Eq)

    instance IsString AuthorizeState where
      fromString :: String -> AuthorizeState
      fromString :: String -> AuthorizeState
    fromString = Text -> AuthorizeState
    AuthorizeState (Text -> AuthorizeState)
    -> (String -> Text) -> String -> AuthorizeState
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    TL.pack

    newtype Username = Username {Username -> Text
    unUsername :: Text}
      deriving (Username -> Username -> Bool
    (Username -> Username -> Bool)
    -> (Username -> Username -> Bool) -> Eq Username
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Username -> Username -> Bool
    == :: Username -> Username -> Bool
    $c/= :: Username -> Username -> Bool
    /= :: Username -> Username -> Bool
    Eq)

    instance IsString Username where
      fromString :: String -> Username
      fromString :: String -> Username
    fromString = Text -> Username
    Username (Text -> Username) -> (String -> Text) -> String -> Username
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    TL.pack

    newtype Password = Password {Password -> Text
    unPassword :: Text}
      deriving (Password -> Password -> Bool
    (Password -> Password -> Bool)
    -> (Password -> Password -> Bool) -> Eq Password
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Password -> Password -> Bool
    == :: Password -> Password -> Bool
    $c/= :: Password -> Password -> Bool
    /= :: Password -> Password -> Bool
    Eq)

    instance IsString Password where
      fromString :: String -> Password
      fromString :: String -> Password
    fromString = Text -> Password
    Password (Text -> Password) -> (String -> Text) -> String -> Password
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    TL.pack

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

    -- * Query parameters

    -------------------------------------------------------------------------------
    class ToQueryParam a where
      toQueryParam :: a -> Map Text Text

    instance ToQueryParam a => ToQueryParam (Maybe a) where
      toQueryParam :: ToQueryParam a => Maybe a -> Map Text Text
      toQueryParam :: ToQueryParam a => Maybe a -> Map Text Text
    toQueryParam Maybe a
    Nothing = Map Text Text
    forall k a. Map k a
    Map.empty
      toQueryParam (Just a
    a) = a -> Map Text Text
    forall a. ToQueryParam a => a -> Map Text Text
    toQueryParam a
    a

    instance ToQueryParam GrantTypeValue where
      toQueryParam :: GrantTypeValue -> Map Text Text
      toQueryParam :: GrantTypeValue -> Map Text Text
    toQueryParam GrantTypeValue
    x = Text -> Text -> Map Text Text
    forall k a. k -> a -> Map k a
    Map.singleton Text
    "grant_type" (GrantTypeValue -> Text
    val GrantTypeValue
    x)
        where
          val :: GrantTypeValue -> Text
          val :: GrantTypeValue -> Text
    val GrantTypeValue
    GTAuthorizationCode = Text
    "authorization_code"
          val GrantTypeValue
    GTPassword = Text
    "password"
          val GrantTypeValue
    GTClientCredentials = Text
    "client_credentials"
          val GrantTypeValue
    GTRefreshToken = Text
    "refresh_token"
          val GrantTypeValue
    GTJwtBearer = Text
    "urn:ietf:params:oauth:grant-type:jwt-bearer"
          val GrantTypeValue
    GTDeviceCode = Text
    "urn:ietf:params:oauth:grant-type:device_code"

    instance ToQueryParam ClientId where
      toQueryParam :: ClientId -> Map Text Text
      toQueryParam :: ClientId -> Map Text Text
    toQueryParam (ClientId Text
    i) = Text -> Text -> Map Text Text
    forall k a. k -> a -> Map k a
    Map.singleton Text
    "client_id" Text
    i

    instance ToQueryParam ClientSecret where
      toQueryParam :: ClientSecret -> Map Text Text
      toQueryParam :: ClientSecret -> Map Text Text
    toQueryParam (ClientSecret Text
    x) = Text -> Text -> Map Text Text
    forall k a. k -> a -> Map k a
    Map.singleton Text
    "client_secret" Text
    x

    instance ToQueryParam Username where
      toQueryParam :: Username -> Map Text Text
      toQueryParam :: Username -> Map Text Text
    toQueryParam (Username Text
    x) = Text -> Text -> Map Text Text
    forall k a. k -> a -> Map k a
    Map.singleton Text
    "username" Text
    x

    instance ToQueryParam Password where
      toQueryParam :: Password -> Map Text Text
      toQueryParam :: Password -> Map Text Text
    toQueryParam (Password Text
    x) = Text -> Text -> Map Text Text
    forall k a. k -> a -> Map k a
    Map.singleton Text
    "password" Text
    x

    instance ToQueryParam AuthorizeState where
      toQueryParam :: AuthorizeState -> Map Text Text
      toQueryParam :: AuthorizeState -> Map Text Text
    toQueryParam (AuthorizeState Text
    x) = Text -> Text -> Map Text Text
    forall k a. k -> a -> Map k a
    Map.singleton Text
    "state" Text
    x

    instance ToQueryParam RedirectUri where
      toQueryParam :: RedirectUri -> Map Text Text
    toQueryParam (RedirectUri URI
    uri) = Text -> Text -> Map Text Text
    forall k a. k -> a -> Map k a
    Map.singleton Text
    "redirect_uri" (ByteString -> Text
    bs8ToLazyText (ByteString -> Text) -> ByteString -> Text
    forall a b. (a -> b) -> a -> b
    $ URI -> ByteString
    forall a. URIRef a -> ByteString
    serializeURIRef' URI
    uri)

    instance ToQueryParam (Set Scope) where
      toQueryParam :: Set Scope -> Map Text Text
      toQueryParam :: Set Scope -> Map Text Text
    toQueryParam = Set Text -> Map Text Text
    forall a. IsString a => Set Text -> Map a Text
    toScopeParam (Set Text -> Map Text Text)
    -> (Set Scope -> Set Text) -> Set Scope -> Map Text Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Scope -> Text) -> Set Scope -> Set Text
    forall b a. Ord b => (a -> b) -> Set a -> Set b
    Set.map Scope -> Text
    unScope
        where
          toScopeParam :: IsString a => Set Text -> Map a Text
          toScopeParam :: forall a. IsString a => Set Text -> Map a Text
    toScopeParam Set Text
    scope = a -> Text -> Map a Text
    forall k a. k -> a -> Map k a
    Map.singleton a
    "scope" (Text -> [Text] -> Text
    TL.intercalate Text
    " " ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ Set Text -> [Text]
    forall a. Set a -> [a]
    Set.toList Set Text
    scope)

    instance ToQueryParam CodeVerifier where
      toQueryParam :: CodeVerifier -> Map Text Text
      toQueryParam :: CodeVerifier -> Map Text Text
    toQueryParam (CodeVerifier Text
    x) = Text -> Text -> Map Text Text
    forall k a. k -> a -> Map k a
    Map.singleton Text
    "code_verifier" (Text -> Text
    TL.fromStrict Text
    x)

    instance ToQueryParam CodeChallenge where
      toQueryParam :: CodeChallenge -> Map Text Text
      toQueryParam :: CodeChallenge -> Map Text Text
    toQueryParam (CodeChallenge Text
    x) = Text -> Text -> Map Text Text
    forall k a. k -> a -> Map k a
    Map.singleton Text
    "code_challenge" (Text -> Text
    TL.fromStrict Text
    x)

    instance ToQueryParam CodeChallengeMethod where
      toQueryParam :: CodeChallengeMethod -> Map Text Text
      toQueryParam :: CodeChallengeMethod -> Map Text Text
    toQueryParam CodeChallengeMethod
    x = Text -> Text -> Map Text Text
    forall k a. k -> a -> Map k a
    Map.singleton Text
    "code_challenge_method" (String -> Text
    TL.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ CodeChallengeMethod -> String
    forall a. Show a => a -> String
    show CodeChallengeMethod
    x)

    instance ToQueryParam ExchangeToken where
      toQueryParam :: ExchangeToken -> Map Text Text
      toQueryParam :: ExchangeToken -> Map Text Text
    toQueryParam (ExchangeToken Text
    x) = Text -> Text -> Map Text Text
    forall k a. k -> a -> Map k a
    Map.singleton Text
    "code" (Text -> Text
    TL.fromStrict Text
    x)

    instance ToQueryParam OAuth2.RefreshToken where
      toQueryParam :: OAuth2.RefreshToken -> Map Text Text
      toQueryParam :: RefreshToken -> Map Text Text
    toQueryParam (OAuth2.RefreshToken Text
    x) = Text -> Text -> Map Text Text
    forall k a. k -> a -> Map k a
    Map.singleton Text
    "refresh_token" (Text -> Text
    TL.fromStrict Text
    x)

    instance ToQueryParam ResponseType where
      toQueryParam :: ResponseType -> Map Text Text
      toQueryParam :: ResponseType -> Map Text Text
    toQueryParam ResponseType
    Code = Text -> Text -> Map Text Text
    forall k a. k -> a -> Map k a
    Map.singleton Text
    "response_type" Text
    "code"

    -------------------------------------------------------------------------------
    --                                HasOAuth2Key                               --
    --                                                                           --
    -- Find a way to reuse some methods from old implementation                  --
    -- Probably will be removed when Experiment module becomes default           --
    -------------------------------------------------------------------------------

    class HasOAuth2Key a where
      mkOAuth2Key :: a -> OAuth2