{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Network.OAuth2.Experiment.Types where

import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Trans.Except (ExceptT (..), throwE)
import Data.Aeson (FromJSON)
import Data.Bifunctor
import Data.ByteString qualified as BS
import Data.ByteString.Lazy.Char8 qualified as BSL
import Data.Default (Default (def))
import Data.Kind
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.Encoding qualified as T
import Data.Text.Lazy (Text)
import Data.Text.Lazy qualified as TL
import Network.HTTP.Conduit
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 hiding (UserInfo)

{- NOTE
  1. shall I lift the constrain of all 'a :: GrantTypeFlow' so that user has max customization/flexibility?
-}

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

-- * Grant Type

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

data GrantTypeFlow
  = -- | https://www.rfc-editor.org/rfc/rfc6749#section-4.1
    AuthorizationCode
  | -- | https://www.rfc-editor.org/rfc/rfc6749#section-4.3
    ResourceOwnerPassword
  | -- | https://www.rfc-editor.org/rfc/rfc6749#section-4.4
    ClientCredentials
  | -- | https://www.rfc-editor.org/rfc/rfc7523.html#section-2.1
    JwtBearer

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

-- * Response Type value

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

class ToResponseTypeValue (a :: GrantTypeFlow) where
  toResponseTypeValue :: IsString b => b

instance ToResponseTypeValue 'AuthorizationCode where
  -- https://www.rfc-editor.org/rfc/rfc6749#section-3.1.1
  -- Only support "authorization code" flow
  toResponseTypeValue :: IsString b => b
  toResponseTypeValue :: forall b. IsString b => b
toResponseTypeValue = b
"code"

toResponseTypeParam :: forall a b req. (ToResponseTypeValue a, IsString b) => req a -> Map b b
toResponseTypeParam :: forall (a :: GrantTypeFlow) b (req :: GrantTypeFlow -> *).
(ToResponseTypeValue a, IsString b) =>
req a -> Map b b
toResponseTypeParam req a
_ = forall k a. k -> a -> Map k a
Map.singleton b
"response_type" (forall (a :: GrantTypeFlow) b.
(ToResponseTypeValue a, IsString b) =>
b
toResponseTypeValue @a)

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

-- * Grant Type value

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

newtype UrnOAuthParam a = UrnOAuthParam a

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

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

-- * Scope

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

-- TODO: 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 (Int -> Scope -> ShowS
[Scope] -> ShowS
Scope -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scope] -> ShowS
$cshowList :: [Scope] -> ShowS
show :: Scope -> String
$cshow :: Scope -> String
showsPrec :: Int -> Scope -> ShowS
$cshowsPrec :: Int -> Scope -> ShowS
Show, Scope -> Scope -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scope -> Scope -> Bool
$c/= :: Scope -> Scope -> Bool
== :: Scope -> Scope -> Bool
$c== :: Scope -> Scope -> Bool
Eq, Eq 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
min :: Scope -> Scope -> Scope
$cmin :: Scope -> Scope -> Scope
max :: Scope -> Scope -> Scope
$cmax :: Scope -> Scope -> Scope
>= :: Scope -> Scope -> Bool
$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
compare :: Scope -> Scope -> Ordering
$ccompare :: Scope -> Scope -> Ordering
Ord)

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

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

-- * Credentials

-------------------------------------------------------------------------------
newtype ClientId = ClientId {ClientId -> Text
unClientId :: Text}
  deriving (Int -> ClientId -> ShowS
[ClientId] -> ShowS
ClientId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientId] -> ShowS
$cshowList :: [ClientId] -> ShowS
show :: ClientId -> String
$cshow :: ClientId -> String
showsPrec :: Int -> ClientId -> ShowS
$cshowsPrec :: Int -> ClientId -> ShowS
Show, ClientId -> ClientId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientId -> ClientId -> Bool
$c/= :: ClientId -> ClientId -> Bool
== :: ClientId -> ClientId -> Bool
$c== :: ClientId -> ClientId -> Bool
Eq, String -> ClientId
forall a. (String -> a) -> IsString a
fromString :: String -> ClientId
$cfromString :: 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientSecret -> ClientSecret -> Bool
$c/= :: ClientSecret -> ClientSecret -> Bool
== :: ClientSecret -> ClientSecret -> Bool
$c== :: ClientSecret -> ClientSecret -> Bool
Eq, String -> ClientSecret
forall a. (String -> a) -> IsString a
fromString :: String -> ClientSecret
$cfromString :: 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 =
  forall a. Default a => a
def
    { oauth2ClientId :: Text
oauth2ClientId = Text -> Text
TL.toStrict forall a b. (a -> b) -> a -> b
$ ClientId -> Text
unClientId ClientId
cid
    , oauth2ClientSecret :: Text
oauth2ClientSecret = Text -> Text
TL.toStrict forall a b. (a -> b) -> a -> b
$ ClientSecret -> Text
unClientSecret ClientSecret
csecret
    }

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

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

instance IsString AuthorizeState where
  fromString :: String -> AuthorizeState
  fromString :: String -> AuthorizeState
fromString = Text -> AuthorizeState
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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Username -> Username -> Bool
$c/= :: Username -> Username -> Bool
== :: Username -> Username -> Bool
$c== :: Username -> Username -> Bool
Eq)

instance IsString Username where
  fromString :: String -> Username
  fromString :: String -> Username
fromString = Text -> Username
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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Password -> Password -> Bool
$c/= :: Password -> Password -> Bool
== :: Password -> Password -> Bool
$c== :: Password -> Password -> Bool
Eq)

instance IsString Password where
  fromString :: String -> Password
  fromString :: String -> Password
fromString = Text -> Password
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 = forall k a. Map k a
Map.empty
  toQueryParam (Just a
a) = 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 = 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"

instance ToQueryParam ClientId where
  toQueryParam :: ClientId -> Map Text Text
  toQueryParam :: ClientId -> Map Text Text
toQueryParam (ClientId Text
i) = 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) = 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) = 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) = 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) = 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) = forall k a. k -> a -> Map k a
Map.singleton Text
"redirect_uri" (ByteString -> Text
bs8ToLazyText forall a b. (a -> b) -> a -> b
$ 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 = forall a. IsString a => Set Text -> Map a Text
toScopeParam forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall k a. k -> a -> Map k a
Map.singleton a
"scope" (Text -> [Text] -> Text
TL.intercalate Text
" " forall a b. (a -> b) -> a -> b
$ 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) = 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) = 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 = forall k a. k -> a -> Map k a
Map.singleton Text
"code_challenge_method" (String -> Text
TL.pack forall a b. (a -> b) -> a -> b
$ 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) = 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) = forall k a. k -> a -> Map k a
Map.singleton Text
"refresh_token" (Text -> Text
TL.fromStrict Text
x)

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

-- * Authorization and Token Requests types

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

class HasAuthorizeRequest (a :: GrantTypeFlow) where
  data AuthorizationRequest a
  type MkAuthorizationRequestResponse a
  mkAuthorizeRequestParameter :: IdpApplication a i -> AuthorizationRequest a
  mkAuthorizeRequest :: IdpApplication a i -> MkAuthorizationRequestResponse a

class HasTokenRequest (a :: GrantTypeFlow) where
  -- | Each GrantTypeFlow has slightly different request parameter to /token endpoint.
  data TokenRequest a

  -- | Only 'AuthorizationCode flow (but not resource owner password nor client credentials) will use 'ExchangeToken' in the token request
  -- create type family to be explicit on it.
  -- with 'type instance WithExchangeToken a b = b' implies no exchange token
  -- v.s. 'type instance WithExchangeToken a b = ExchangeToken -> b' implies needing an exchange token
  type WithExchangeToken a b

  mkTokenRequest ::
    IdpApplication a i ->
    WithExchangeToken a (TokenRequest a)

  conduitTokenRequest ::
    (MonadIO m) =>
    IdpApplication a i ->
    Manager ->
    WithExchangeToken a (ExceptT TokenRequestError m OAuth2Token)

class HasPkceAuthorizeRequest (a :: GrantTypeFlow) where
  mkPkceAuthorizeRequest :: MonadIO m => IdpApplication a i -> m (TL.Text, CodeVerifier)

class HasPkceTokenRequest (b :: GrantTypeFlow) where
  conduitPkceTokenRequest ::
    (MonadIO m) =>
    IdpApplication b i ->
    Manager ->
    (ExchangeToken, CodeVerifier) ->
    ExceptT TokenRequestError m OAuth2Token

class HasRefreshTokenRequest (a :: GrantTypeFlow) where
  -- | https://www.rfc-editor.org/rfc/rfc6749#page-47
  data RefreshTokenRequest a

  mkRefreshTokenRequest :: IdpApplication a i -> OAuth2.RefreshToken -> RefreshTokenRequest a
  conduitRefreshTokenRequest ::
    (MonadIO m) =>
    IdpApplication a i ->
    Manager ->
    OAuth2.RefreshToken ->
    ExceptT TokenRequestError m OAuth2Token

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

-- * User Info types

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

type family IdpUserInfo a

class HasUserInfoRequest (a :: GrantTypeFlow) where
  conduitUserInfoRequest ::
    FromJSON (IdpUserInfo i) =>
    IdpApplication a i ->
    Manager ->
    AccessToken ->
    ExceptT BSL.ByteString IO (IdpUserInfo i)

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

-- * Idp App

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

-- | Shall IdpApplication has a field of 'Idp a'??
data Idp a = Idp
  { forall a. Idp a -> URI
idpUserInfoEndpoint :: URI
  , -- NOTE: maybe worth data type to distinguish authorize and token endpoint
    -- as I made mistake at passing to Authorize and Token Request
    forall a. Idp a -> URI
idpAuthorizeEndpoint :: URI
  , forall a. Idp a -> URI
idpTokenEndpoint :: URI
  , forall a.
Idp a
-> forall (m :: * -> *).
   (FromJSON (IdpUserInfo a), MonadIO m) =>
   Manager
   -> AccessToken -> URI -> ExceptT ByteString m (IdpUserInfo a)
idpFetchUserInfo ::
      forall m.
      (FromJSON (IdpUserInfo a), MonadIO m) =>
      Manager ->
      AccessToken ->
      URI ->
      ExceptT BSL.ByteString m (IdpUserInfo a)
  }

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

-- * Idp App Config

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

data family IdpApplication (a :: GrantTypeFlow) (i :: Type)

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

-- * Authorization Code flow

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

-- | An Application that supports "Authorization code" flow
data instance IdpApplication 'AuthorizationCode i = AuthorizationCodeIdpApplication
  { forall i. IdpApplication 'AuthorizationCode i -> Text
idpAppName :: Text
  , forall i. IdpApplication 'AuthorizationCode i -> ClientId
idpAppClientId :: ClientId
  , forall i. IdpApplication 'AuthorizationCode i -> ClientSecret
idpAppClientSecret :: ClientSecret
  , forall i. IdpApplication 'AuthorizationCode i -> Set Scope
idpAppScope :: Set Scope
  , forall i. IdpApplication 'AuthorizationCode i -> URI
idpAppRedirectUri :: URI
  , forall i. IdpApplication 'AuthorizationCode i -> AuthorizeState
idpAppAuthorizeState :: AuthorizeState
  , forall i. IdpApplication 'AuthorizationCode i -> Map Text Text
idpAppAuthorizeExtraParams :: Map Text Text
  -- ^ Though technically one key can have multiple value in query, but who actually does it?!
  , forall i.
IdpApplication 'AuthorizationCode i -> ClientAuthenticationMethod
idpAppTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
  , forall i. IdpApplication 'AuthorizationCode i -> Idp i
idp :: Idp i
  }

-- NOTE: maybe add function for parase authorization response
-- though seems overkill. https://github.com/freizl/hoauth2/issues/149
-- parseAuthorizationResponse :: String -> AuthorizationResponse
-- parseAuthorizationResponse :: ( String, String ) -> AuthorizationResponse

instance HasAuthorizeRequest 'AuthorizationCode where
  -- \| https://www.rfc-editor.org/rfc/rfc6749#section-4.1.1
  data AuthorizationRequest 'AuthorizationCode = AuthorizationCodeAuthorizationRequest
    { AuthorizationRequest 'AuthorizationCode -> Set Scope
scope :: Set Scope
    , AuthorizationRequest 'AuthorizationCode -> AuthorizeState
state :: AuthorizeState
    , AuthorizationRequest 'AuthorizationCode -> ClientId
clientId :: ClientId
    , AuthorizationRequest 'AuthorizationCode -> Maybe RedirectUri
redirectUri :: Maybe RedirectUri
    }
  type MkAuthorizationRequestResponse 'AuthorizationCode = Text

  mkAuthorizeRequestParameter :: IdpApplication 'AuthorizationCode i -> AuthorizationRequest 'AuthorizationCode
  mkAuthorizeRequestParameter :: forall i.
IdpApplication 'AuthorizationCode i
-> AuthorizationRequest 'AuthorizationCode
mkAuthorizeRequestParameter AuthorizationCodeIdpApplication {Map Text Text
Text
Set Scope
URI
ClientAuthenticationMethod
Idp i
AuthorizeState
ClientSecret
ClientId
idp :: Idp i
idpAppTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
idpAppAuthorizeExtraParams :: Map Text Text
idpAppAuthorizeState :: AuthorizeState
idpAppRedirectUri :: URI
idpAppScope :: Set Scope
idpAppClientSecret :: ClientSecret
idpAppClientId :: ClientId
idpAppName :: Text
$sel:idp:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Idp i
$sel:idpAppTokenRequestAuthenticationMethod:AuthorizationCodeIdpApplication :: forall i.
IdpApplication 'AuthorizationCode i -> ClientAuthenticationMethod
$sel:idpAppAuthorizeExtraParams:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Map Text Text
$sel:idpAppAuthorizeState:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> AuthorizeState
$sel:idpAppRedirectUri:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> URI
$sel:idpAppScope:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Set Scope
$sel:idpAppClientSecret:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientSecret
$sel:idpAppClientId:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientId
$sel:idpAppName:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Text
..} =
    AuthorizationCodeAuthorizationRequest
      { $sel:scope:AuthorizationCodeAuthorizationRequest :: Set Scope
scope = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set Scope
idpAppScope then forall a. Set a
Set.empty else Set Scope
idpAppScope
      , $sel:state:AuthorizationCodeAuthorizationRequest :: AuthorizeState
state = AuthorizeState
idpAppAuthorizeState
      , $sel:clientId:AuthorizationCodeAuthorizationRequest :: ClientId
clientId = ClientId
idpAppClientId
      , $sel:redirectUri:AuthorizationCodeAuthorizationRequest :: Maybe RedirectUri
redirectUri = forall a. a -> Maybe a
Just (URI -> RedirectUri
RedirectUri URI
idpAppRedirectUri)
      }

  mkAuthorizeRequest :: IdpApplication 'AuthorizationCode i -> Text
  mkAuthorizeRequest :: forall i. IdpApplication 'AuthorizationCode i -> Text
mkAuthorizeRequest idpAppConfig :: IdpApplication 'AuthorizationCode i
idpAppConfig@AuthorizationCodeIdpApplication {Map Text Text
Text
Set Scope
URI
ClientAuthenticationMethod
Idp i
AuthorizeState
ClientSecret
ClientId
idp :: Idp i
idpAppTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
idpAppAuthorizeExtraParams :: Map Text Text
idpAppAuthorizeState :: AuthorizeState
idpAppRedirectUri :: URI
idpAppScope :: Set Scope
idpAppClientSecret :: ClientSecret
idpAppClientId :: ClientId
idpAppName :: Text
$sel:idp:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Idp i
$sel:idpAppTokenRequestAuthenticationMethod:AuthorizationCodeIdpApplication :: forall i.
IdpApplication 'AuthorizationCode i -> ClientAuthenticationMethod
$sel:idpAppAuthorizeExtraParams:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Map Text Text
$sel:idpAppAuthorizeState:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> AuthorizeState
$sel:idpAppRedirectUri:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> URI
$sel:idpAppScope:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Set Scope
$sel:idpAppClientSecret:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientSecret
$sel:idpAppClientId:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientId
$sel:idpAppName:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Text
..} =
    let req :: AuthorizationRequest 'AuthorizationCode
req = forall (a :: GrantTypeFlow) i.
HasAuthorizeRequest a =>
IdpApplication a i -> AuthorizationRequest a
mkAuthorizeRequestParameter IdpApplication 'AuthorizationCode i
idpAppConfig
        allParams :: [(ByteString, ByteString)]
allParams =
          forall a b. (a -> b) -> [a] -> [b]
map (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) forall a b. (a -> b) -> a -> b
$
            forall k a. Map k a -> [(k, a)]
Map.toList forall a b. (a -> b) -> a -> b
$
              forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions [Map Text Text
idpAppAuthorizeExtraParams, forall a. ToQueryParam a => a -> Map Text Text
toQueryParam AuthorizationRequest 'AuthorizationCode
req]
     in Text -> Text
TL.fromStrict forall a b. (a -> b) -> a -> b
$
          ByteString -> Text
T.decodeUtf8 forall a b. (a -> b) -> a -> b
$
            forall a. URIRef a -> ByteString
serializeURIRef' forall a b. (a -> b) -> a -> b
$
              forall a. [(ByteString, ByteString)] -> URIRef a -> URIRef a
appendQueryParams [(ByteString, ByteString)]
allParams forall a b. (a -> b) -> a -> b
$
                forall a. Idp a -> URI
idpAuthorizeEndpoint Idp i
idp

instance HasTokenRequest 'AuthorizationCode where
  -- \| https://www.rfc-editor.org/rfc/rfc6749#section-4.1.3
  data TokenRequest 'AuthorizationCode = AuthorizationCodeTokenRequest
    { TokenRequest 'AuthorizationCode -> ExchangeToken
code :: ExchangeToken
    , TokenRequest 'AuthorizationCode -> ClientId
clientId :: ClientId
    , TokenRequest 'AuthorizationCode -> GrantTypeValue
grantType :: GrantTypeValue
    , TokenRequest 'AuthorizationCode -> RedirectUri
redirectUri :: RedirectUri
    }
  type WithExchangeToken 'AuthorizationCode a = ExchangeToken -> a

  mkTokenRequest ::
    IdpApplication 'AuthorizationCode i ->
    ExchangeToken ->
    TokenRequest 'AuthorizationCode
  mkTokenRequest :: forall i.
IdpApplication 'AuthorizationCode i
-> ExchangeToken -> TokenRequest 'AuthorizationCode
mkTokenRequest AuthorizationCodeIdpApplication {Map Text Text
Text
Set Scope
URI
ClientAuthenticationMethod
Idp i
AuthorizeState
ClientSecret
ClientId
idp :: Idp i
idpAppTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
idpAppAuthorizeExtraParams :: Map Text Text
idpAppAuthorizeState :: AuthorizeState
idpAppRedirectUri :: URI
idpAppScope :: Set Scope
idpAppClientSecret :: ClientSecret
idpAppClientId :: ClientId
idpAppName :: Text
$sel:idp:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Idp i
$sel:idpAppTokenRequestAuthenticationMethod:AuthorizationCodeIdpApplication :: forall i.
IdpApplication 'AuthorizationCode i -> ClientAuthenticationMethod
$sel:idpAppAuthorizeExtraParams:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Map Text Text
$sel:idpAppAuthorizeState:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> AuthorizeState
$sel:idpAppRedirectUri:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> URI
$sel:idpAppScope:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Set Scope
$sel:idpAppClientSecret:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientSecret
$sel:idpAppClientId:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientId
$sel:idpAppName:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Text
..} ExchangeToken
authCode =
    AuthorizationCodeTokenRequest
      { $sel:code:AuthorizationCodeTokenRequest :: ExchangeToken
code = ExchangeToken
authCode
      , $sel:clientId:AuthorizationCodeTokenRequest :: ClientId
clientId = ClientId
idpAppClientId
      , $sel:grantType:AuthorizationCodeTokenRequest :: GrantTypeValue
grantType = GrantTypeValue
GTAuthorizationCode
      , $sel:redirectUri:AuthorizationCodeTokenRequest :: RedirectUri
redirectUri = URI -> RedirectUri
RedirectUri URI
idpAppRedirectUri
      }
  conduitTokenRequest ::
    forall m i.
    (MonadIO m) =>
    IdpApplication 'AuthorizationCode i ->
    Manager ->
    ExchangeToken ->
    ExceptT TokenRequestError m OAuth2Token
  conduitTokenRequest :: forall (m :: * -> *) i.
MonadIO m =>
IdpApplication 'AuthorizationCode i
-> Manager
-> ExchangeToken
-> ExceptT TokenRequestError m OAuth2Token
conduitTokenRequest idpAppConfig :: IdpApplication 'AuthorizationCode i
idpAppConfig@AuthorizationCodeIdpApplication {Map Text Text
Text
Set Scope
URI
ClientAuthenticationMethod
Idp i
AuthorizeState
ClientSecret
ClientId
idp :: Idp i
idpAppTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
idpAppAuthorizeExtraParams :: Map Text Text
idpAppAuthorizeState :: AuthorizeState
idpAppRedirectUri :: URI
idpAppScope :: Set Scope
idpAppClientSecret :: ClientSecret
idpAppClientId :: ClientId
idpAppName :: Text
$sel:idp:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Idp i
$sel:idpAppTokenRequestAuthenticationMethod:AuthorizationCodeIdpApplication :: forall i.
IdpApplication 'AuthorizationCode i -> ClientAuthenticationMethod
$sel:idpAppAuthorizeExtraParams:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Map Text Text
$sel:idpAppAuthorizeState:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> AuthorizeState
$sel:idpAppRedirectUri:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> URI
$sel:idpAppScope:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Set Scope
$sel:idpAppClientSecret:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientSecret
$sel:idpAppClientId:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientId
$sel:idpAppName:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Text
..} Manager
mgr ExchangeToken
exchangeToken =
    let req :: TokenRequest 'AuthorizationCode
req = forall (a :: GrantTypeFlow) i.
HasTokenRequest a =>
IdpApplication a i -> WithExchangeToken a (TokenRequest a)
mkTokenRequest IdpApplication 'AuthorizationCode i
idpAppConfig ExchangeToken
exchangeToken
        key :: OAuth2
key = ClientId -> ClientSecret -> OAuth2
toOAuth2Key ClientId
idpAppClientId ClientSecret
idpAppClientSecret
        body :: [(ByteString, ByteString)]
body =
          [Map Text Text] -> [(ByteString, ByteString)]
mapsToParams
            [ forall a. ToQueryParam a => a -> Map Text Text
toQueryParam TokenRequest 'AuthorizationCode
req
            , forall a. ToQueryParam a => a -> Map Text Text
toQueryParam
                ( if ClientAuthenticationMethod
idpAppTokenRequestAuthenticationMethod forall a. Eq a => a -> a -> Bool
== ClientAuthenticationMethod
ClientSecretPost
                    then forall a. a -> Maybe a
Just ClientSecret
idpAppClientSecret
                    else forall a. Maybe a
Nothing
                )
            ]
     in forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Manager
-> OAuth2
-> URI
-> [(ByteString, ByteString)]
-> ExceptT TokenRequestError m a
doJSONPostRequest Manager
mgr OAuth2
key (forall a. Idp a -> URI
idpTokenEndpoint Idp i
idp) [(ByteString, ByteString)]
body

instance HasPkceAuthorizeRequest 'AuthorizationCode where
  mkPkceAuthorizeRequest :: MonadIO m => IdpApplication 'AuthorizationCode i -> m (Text, CodeVerifier)
  mkPkceAuthorizeRequest :: forall (m :: * -> *) i.
MonadIO m =>
IdpApplication 'AuthorizationCode i -> m (Text, CodeVerifier)
mkPkceAuthorizeRequest idpAppConfig :: IdpApplication 'AuthorizationCode i
idpAppConfig@AuthorizationCodeIdpApplication {Map Text Text
Text
Set Scope
URI
ClientAuthenticationMethod
Idp i
AuthorizeState
ClientSecret
ClientId
idp :: Idp i
idpAppTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
idpAppAuthorizeExtraParams :: Map Text Text
idpAppAuthorizeState :: AuthorizeState
idpAppRedirectUri :: URI
idpAppScope :: Set Scope
idpAppClientSecret :: ClientSecret
idpAppClientId :: ClientId
idpAppName :: Text
$sel:idp:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Idp i
$sel:idpAppTokenRequestAuthenticationMethod:AuthorizationCodeIdpApplication :: forall i.
IdpApplication 'AuthorizationCode i -> ClientAuthenticationMethod
$sel:idpAppAuthorizeExtraParams:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Map Text Text
$sel:idpAppAuthorizeState:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> AuthorizeState
$sel:idpAppRedirectUri:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> URI
$sel:idpAppScope:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Set Scope
$sel:idpAppClientSecret:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientSecret
$sel:idpAppClientId:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientId
$sel:idpAppName:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Text
..} = do
    PkceRequestParam {CodeChallengeMethod
CodeVerifier
CodeChallenge
codeChallengeMethod :: PkceRequestParam -> CodeChallengeMethod
codeChallenge :: PkceRequestParam -> CodeChallenge
codeVerifier :: PkceRequestParam -> CodeVerifier
codeChallengeMethod :: CodeChallengeMethod
codeChallenge :: CodeChallenge
codeVerifier :: CodeVerifier
..} <- forall (m :: * -> *). MonadIO m => m PkceRequestParam
mkPkceParam
    let req :: AuthorizationRequest 'AuthorizationCode
req = forall (a :: GrantTypeFlow) i.
HasAuthorizeRequest a =>
IdpApplication a i -> AuthorizationRequest a
mkAuthorizeRequestParameter IdpApplication 'AuthorizationCode i
idpAppConfig
    let allParams :: [(ByteString, ByteString)]
allParams =
          [Map Text Text] -> [(ByteString, ByteString)]
mapsToParams
            [ Map Text Text
idpAppAuthorizeExtraParams
            , forall a. ToQueryParam a => a -> Map Text Text
toQueryParam AuthorizationRequest 'AuthorizationCode
req
            , forall a. ToQueryParam a => a -> Map Text Text
toQueryParam CodeChallenge
codeChallenge
            , forall a. ToQueryParam a => a -> Map Text Text
toQueryParam CodeChallengeMethod
codeChallengeMethod
            ]

    let url :: Text
url =
          Text -> Text
TL.fromStrict forall a b. (a -> b) -> a -> b
$
            ByteString -> Text
T.decodeUtf8 forall a b. (a -> b) -> a -> b
$
              forall a. URIRef a -> ByteString
serializeURIRef' forall a b. (a -> b) -> a -> b
$
                forall a. [(ByteString, ByteString)] -> URIRef a -> URIRef a
appendQueryParams [(ByteString, ByteString)]
allParams forall a b. (a -> b) -> a -> b
$
                  forall a. Idp a -> URI
idpAuthorizeEndpoint Idp i
idp
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
url, CodeVerifier
codeVerifier)

instance HasPkceTokenRequest 'AuthorizationCode where
  conduitPkceTokenRequest ::
    MonadIO m =>
    IdpApplication 'AuthorizationCode i ->
    Manager ->
    (ExchangeToken, CodeVerifier) ->
    ExceptT TokenRequestError m OAuth2Token
  conduitPkceTokenRequest :: forall (m :: * -> *) i.
MonadIO m =>
IdpApplication 'AuthorizationCode i
-> Manager
-> (ExchangeToken, CodeVerifier)
-> ExceptT TokenRequestError m OAuth2Token
conduitPkceTokenRequest idpAppConfig :: IdpApplication 'AuthorizationCode i
idpAppConfig@AuthorizationCodeIdpApplication {Map Text Text
Text
Set Scope
URI
ClientAuthenticationMethod
Idp i
AuthorizeState
ClientSecret
ClientId
idp :: Idp i
idpAppTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
idpAppAuthorizeExtraParams :: Map Text Text
idpAppAuthorizeState :: AuthorizeState
idpAppRedirectUri :: URI
idpAppScope :: Set Scope
idpAppClientSecret :: ClientSecret
idpAppClientId :: ClientId
idpAppName :: Text
$sel:idp:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Idp i
$sel:idpAppTokenRequestAuthenticationMethod:AuthorizationCodeIdpApplication :: forall i.
IdpApplication 'AuthorizationCode i -> ClientAuthenticationMethod
$sel:idpAppAuthorizeExtraParams:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Map Text Text
$sel:idpAppAuthorizeState:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> AuthorizeState
$sel:idpAppRedirectUri:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> URI
$sel:idpAppScope:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Set Scope
$sel:idpAppClientSecret:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientSecret
$sel:idpAppClientId:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientId
$sel:idpAppName:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Text
..} Manager
mgr (ExchangeToken
exchangeToken, CodeVerifier
codeVerifier) =
    let req :: TokenRequest 'AuthorizationCode
req = forall (a :: GrantTypeFlow) i.
HasTokenRequest a =>
IdpApplication a i -> WithExchangeToken a (TokenRequest a)
mkTokenRequest IdpApplication 'AuthorizationCode i
idpAppConfig ExchangeToken
exchangeToken
        key :: OAuth2
key = ClientId -> ClientSecret -> OAuth2
toOAuth2Key ClientId
idpAppClientId ClientSecret
idpAppClientSecret
        body :: [(ByteString, ByteString)]
body =
          [Map Text Text] -> [(ByteString, ByteString)]
mapsToParams
            [ forall a. ToQueryParam a => a -> Map Text Text
toQueryParam TokenRequest 'AuthorizationCode
req
            , forall a. ToQueryParam a => a -> Map Text Text
toQueryParam CodeVerifier
codeVerifier
            , forall a. ToQueryParam a => a -> Map Text Text
toQueryParam (if ClientAuthenticationMethod
idpAppTokenRequestAuthenticationMethod forall a. Eq a => a -> a -> Bool
== ClientAuthenticationMethod
ClientSecretPost then forall a. a -> Maybe a
Just ClientSecret
idpAppClientSecret else forall a. Maybe a
Nothing)
            ]
     in forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Manager
-> OAuth2
-> URI
-> [(ByteString, ByteString)]
-> ExceptT TokenRequestError m a
doJSONPostRequest Manager
mgr OAuth2
key (forall a. Idp a -> URI
idpTokenEndpoint Idp i
idp) [(ByteString, ByteString)]
body

instance HasRefreshTokenRequest 'AuthorizationCode where
  data RefreshTokenRequest 'AuthorizationCode = AuthorizationCodeTokenRefreshRequest
    { RefreshTokenRequest 'AuthorizationCode -> RefreshToken
refreshToken :: OAuth2.RefreshToken
    , RefreshTokenRequest 'AuthorizationCode -> GrantTypeValue
grantType :: GrantTypeValue
    , RefreshTokenRequest 'AuthorizationCode -> Set Scope
scope :: Set Scope
    }

  mkRefreshTokenRequest :: IdpApplication 'AuthorizationCode i -> OAuth2.RefreshToken -> RefreshTokenRequest 'AuthorizationCode
  mkRefreshTokenRequest :: forall i.
IdpApplication 'AuthorizationCode i
-> RefreshToken -> RefreshTokenRequest 'AuthorizationCode
mkRefreshTokenRequest AuthorizationCodeIdpApplication {Map Text Text
Text
Set Scope
URI
ClientAuthenticationMethod
Idp i
AuthorizeState
ClientSecret
ClientId
idp :: Idp i
idpAppTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
idpAppAuthorizeExtraParams :: Map Text Text
idpAppAuthorizeState :: AuthorizeState
idpAppRedirectUri :: URI
idpAppScope :: Set Scope
idpAppClientSecret :: ClientSecret
idpAppClientId :: ClientId
idpAppName :: Text
$sel:idp:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Idp i
$sel:idpAppTokenRequestAuthenticationMethod:AuthorizationCodeIdpApplication :: forall i.
IdpApplication 'AuthorizationCode i -> ClientAuthenticationMethod
$sel:idpAppAuthorizeExtraParams:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Map Text Text
$sel:idpAppAuthorizeState:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> AuthorizeState
$sel:idpAppRedirectUri:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> URI
$sel:idpAppScope:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Set Scope
$sel:idpAppClientSecret:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientSecret
$sel:idpAppClientId:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientId
$sel:idpAppName:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Text
..} RefreshToken
rt =
    AuthorizationCodeTokenRefreshRequest
      { $sel:scope:AuthorizationCodeTokenRefreshRequest :: Set Scope
scope = Set Scope
idpAppScope
      , $sel:grantType:AuthorizationCodeTokenRefreshRequest :: GrantTypeValue
grantType = GrantTypeValue
GTRefreshToken
      , $sel:refreshToken:AuthorizationCodeTokenRefreshRequest :: RefreshToken
refreshToken = RefreshToken
rt
      }
  conduitRefreshTokenRequest ::
    (MonadIO m) =>
    IdpApplication 'AuthorizationCode i ->
    Manager ->
    OAuth2.RefreshToken ->
    ExceptT TokenRequestError m OAuth2Token
  conduitRefreshTokenRequest :: forall (m :: * -> *) i.
MonadIO m =>
IdpApplication 'AuthorizationCode i
-> Manager
-> RefreshToken
-> ExceptT TokenRequestError m OAuth2Token
conduitRefreshTokenRequest idpAppConfig :: IdpApplication 'AuthorizationCode i
idpAppConfig@AuthorizationCodeIdpApplication {Map Text Text
Text
Set Scope
URI
ClientAuthenticationMethod
Idp i
AuthorizeState
ClientSecret
ClientId
idp :: Idp i
idpAppTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
idpAppAuthorizeExtraParams :: Map Text Text
idpAppAuthorizeState :: AuthorizeState
idpAppRedirectUri :: URI
idpAppScope :: Set Scope
idpAppClientSecret :: ClientSecret
idpAppClientId :: ClientId
idpAppName :: Text
$sel:idp:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Idp i
$sel:idpAppTokenRequestAuthenticationMethod:AuthorizationCodeIdpApplication :: forall i.
IdpApplication 'AuthorizationCode i -> ClientAuthenticationMethod
$sel:idpAppAuthorizeExtraParams:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Map Text Text
$sel:idpAppAuthorizeState:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> AuthorizeState
$sel:idpAppRedirectUri:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> URI
$sel:idpAppScope:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Set Scope
$sel:idpAppClientSecret:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientSecret
$sel:idpAppClientId:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientId
$sel:idpAppName:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Text
..} Manager
mgr RefreshToken
rt =
    let req :: RefreshTokenRequest 'AuthorizationCode
req = forall (a :: GrantTypeFlow) i.
HasRefreshTokenRequest a =>
IdpApplication a i -> RefreshToken -> RefreshTokenRequest a
mkRefreshTokenRequest IdpApplication 'AuthorizationCode i
idpAppConfig RefreshToken
rt
        key :: OAuth2
key = ClientId -> ClientSecret -> OAuth2
toOAuth2Key ClientId
idpAppClientId ClientSecret
idpAppClientSecret
        body :: [(ByteString, ByteString)]
body =
          [Map Text Text] -> [(ByteString, ByteString)]
mapsToParams
            [ forall a. ToQueryParam a => a -> Map Text Text
toQueryParam RefreshTokenRequest 'AuthorizationCode
req
            , forall a. ToQueryParam a => a -> Map Text Text
toQueryParam (if ClientAuthenticationMethod
idpAppTokenRequestAuthenticationMethod forall a. Eq a => a -> a -> Bool
== ClientAuthenticationMethod
ClientSecretPost then forall a. a -> Maybe a
Just ClientSecret
idpAppClientSecret else forall a. Maybe a
Nothing)
            ]
     in forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Manager
-> OAuth2
-> URI
-> [(ByteString, ByteString)]
-> ExceptT TokenRequestError m a
doJSONPostRequest Manager
mgr OAuth2
key (forall a. Idp a -> URI
idpTokenEndpoint Idp i
idp) [(ByteString, ByteString)]
body

instance HasUserInfoRequest 'AuthorizationCode where
  conduitUserInfoRequest ::
    FromJSON (IdpUserInfo i) =>
    IdpApplication 'AuthorizationCode i ->
    Manager ->
    AccessToken ->
    ExceptT BSL.ByteString IO (IdpUserInfo i)
  conduitUserInfoRequest :: forall i.
FromJSON (IdpUserInfo i) =>
IdpApplication 'AuthorizationCode i
-> Manager -> AccessToken -> ExceptT ByteString IO (IdpUserInfo i)
conduitUserInfoRequest AuthorizationCodeIdpApplication {Map Text Text
Text
Set Scope
URI
ClientAuthenticationMethod
Idp i
AuthorizeState
ClientSecret
ClientId
idp :: Idp i
idpAppTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
idpAppAuthorizeExtraParams :: Map Text Text
idpAppAuthorizeState :: AuthorizeState
idpAppRedirectUri :: URI
idpAppScope :: Set Scope
idpAppClientSecret :: ClientSecret
idpAppClientId :: ClientId
idpAppName :: Text
$sel:idp:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Idp i
$sel:idpAppTokenRequestAuthenticationMethod:AuthorizationCodeIdpApplication :: forall i.
IdpApplication 'AuthorizationCode i -> ClientAuthenticationMethod
$sel:idpAppAuthorizeExtraParams:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Map Text Text
$sel:idpAppAuthorizeState:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> AuthorizeState
$sel:idpAppRedirectUri:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> URI
$sel:idpAppScope:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Set Scope
$sel:idpAppClientSecret:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientSecret
$sel:idpAppClientId:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientId
$sel:idpAppName:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Text
..} Manager
mgr AccessToken
at = do
    forall a.
Idp a
-> forall (m :: * -> *).
   (FromJSON (IdpUserInfo a), MonadIO m) =>
   Manager
   -> AccessToken -> URI -> ExceptT ByteString m (IdpUserInfo a)
idpFetchUserInfo Idp i
idp Manager
mgr AccessToken
at (forall a. Idp a -> URI
idpUserInfoEndpoint Idp i
idp)

instance ToQueryParam (AuthorizationRequest 'AuthorizationCode) where
  toQueryParam :: AuthorizationRequest 'AuthorizationCode -> Map Text Text
  toQueryParam :: AuthorizationRequest 'AuthorizationCode -> Map Text Text
toQueryParam req :: AuthorizationRequest 'AuthorizationCode
req@AuthorizationCodeAuthorizationRequest {Maybe RedirectUri
Set Scope
AuthorizeState
ClientId
redirectUri :: Maybe RedirectUri
clientId :: ClientId
state :: AuthorizeState
scope :: Set Scope
$sel:redirectUri:AuthorizationCodeAuthorizationRequest :: AuthorizationRequest 'AuthorizationCode -> Maybe RedirectUri
$sel:clientId:AuthorizationCodeAuthorizationRequest :: AuthorizationRequest 'AuthorizationCode -> ClientId
$sel:state:AuthorizationCodeAuthorizationRequest :: AuthorizationRequest 'AuthorizationCode -> AuthorizeState
$sel:scope:AuthorizationCodeAuthorizationRequest :: AuthorizationRequest 'AuthorizationCode -> Set Scope
..} =
    forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions
      [ forall (a :: GrantTypeFlow) b (req :: GrantTypeFlow -> *).
(ToResponseTypeValue a, IsString b) =>
req a -> Map b b
toResponseTypeParam AuthorizationRequest 'AuthorizationCode
req
      , forall a. ToQueryParam a => a -> Map Text Text
toQueryParam Set Scope
scope
      , forall a. ToQueryParam a => a -> Map Text Text
toQueryParam ClientId
clientId
      , forall a. ToQueryParam a => a -> Map Text Text
toQueryParam AuthorizeState
state
      , forall a. ToQueryParam a => a -> Map Text Text
toQueryParam Maybe RedirectUri
redirectUri
      ]

instance ToQueryParam (TokenRequest 'AuthorizationCode) where
  toQueryParam :: TokenRequest 'AuthorizationCode -> Map Text Text
  toQueryParam :: TokenRequest 'AuthorizationCode -> Map Text Text
toQueryParam AuthorizationCodeTokenRequest {ExchangeToken
RedirectUri
ClientId
GrantTypeValue
redirectUri :: RedirectUri
grantType :: GrantTypeValue
clientId :: ClientId
code :: ExchangeToken
$sel:redirectUri:AuthorizationCodeTokenRequest :: TokenRequest 'AuthorizationCode -> RedirectUri
$sel:grantType:AuthorizationCodeTokenRequest :: TokenRequest 'AuthorizationCode -> GrantTypeValue
$sel:clientId:AuthorizationCodeTokenRequest :: TokenRequest 'AuthorizationCode -> ClientId
$sel:code:AuthorizationCodeTokenRequest :: TokenRequest 'AuthorizationCode -> ExchangeToken
..} =
    forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions
      [ forall a. ToQueryParam a => a -> Map Text Text
toQueryParam GrantTypeValue
grantType
      , forall a. ToQueryParam a => a -> Map Text Text
toQueryParam ExchangeToken
code
      , forall a. ToQueryParam a => a -> Map Text Text
toQueryParam RedirectUri
redirectUri
      ]

instance ToQueryParam (RefreshTokenRequest 'AuthorizationCode) where
  toQueryParam :: RefreshTokenRequest 'AuthorizationCode -> Map Text Text
  toQueryParam :: RefreshTokenRequest 'AuthorizationCode -> Map Text Text
toQueryParam AuthorizationCodeTokenRefreshRequest {Set Scope
RefreshToken
GrantTypeValue
scope :: Set Scope
grantType :: GrantTypeValue
refreshToken :: RefreshToken
$sel:scope:AuthorizationCodeTokenRefreshRequest :: RefreshTokenRequest 'AuthorizationCode -> Set Scope
$sel:grantType:AuthorizationCodeTokenRefreshRequest :: RefreshTokenRequest 'AuthorizationCode -> GrantTypeValue
$sel:refreshToken:AuthorizationCodeTokenRefreshRequest :: RefreshTokenRequest 'AuthorizationCode -> RefreshToken
..} =
    forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions
      [ forall a. ToQueryParam a => a -> Map Text Text
toQueryParam GrantTypeValue
grantType
      , forall a. ToQueryParam a => a -> Map Text Text
toQueryParam Set Scope
scope
      , forall a. ToQueryParam a => a -> Map Text Text
toQueryParam RefreshToken
refreshToken
      ]

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

-- * JWTBearer

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

-- | An Application that supports "Authorization code" flow
data instance IdpApplication 'JwtBearer i = JwtBearerIdpApplication
  { forall i. IdpApplication 'JwtBearer i -> Text
idpAppName :: Text
  , forall i. IdpApplication 'JwtBearer i -> ByteString
idpAppJwt :: BS.ByteString
  , forall i. IdpApplication 'JwtBearer i -> Idp i
idp :: Idp i
  }

instance HasTokenRequest 'JwtBearer where
  data TokenRequest 'JwtBearer = JwtBearerTokenRequest
    { TokenRequest 'JwtBearer -> GrantTypeValue
grantType :: GrantTypeValue -- \| 'GTJwtBearer'
    , TokenRequest 'JwtBearer -> ByteString
assertion :: BS.ByteString -- \| The the signed JWT token
    }
  type WithExchangeToken 'JwtBearer a = a

  mkTokenRequest ::
    IdpApplication 'JwtBearer i ->
    TokenRequest 'JwtBearer
  mkTokenRequest :: forall i. IdpApplication 'JwtBearer i -> TokenRequest 'JwtBearer
mkTokenRequest JwtBearerIdpApplication {ByteString
Text
Idp i
idp :: Idp i
idpAppJwt :: ByteString
idpAppName :: Text
$sel:idp:JwtBearerIdpApplication :: forall i. IdpApplication 'JwtBearer i -> Idp i
$sel:idpAppJwt:JwtBearerIdpApplication :: forall i. IdpApplication 'JwtBearer i -> ByteString
$sel:idpAppName:JwtBearerIdpApplication :: forall i. IdpApplication 'JwtBearer i -> Text
..} =
    JwtBearerTokenRequest
      { $sel:grantType:JwtBearerTokenRequest :: GrantTypeValue
grantType = GrantTypeValue
GTJwtBearer
      , $sel:assertion:JwtBearerTokenRequest :: ByteString
assertion = ByteString
idpAppJwt
      }

  conduitTokenRequest ::
    forall m i.
    (MonadIO m) =>
    IdpApplication 'JwtBearer i ->
    Manager ->
    ExceptT TokenRequestError m OAuth2Token
  conduitTokenRequest :: forall (m :: * -> *) i.
MonadIO m =>
IdpApplication 'JwtBearer i
-> Manager -> ExceptT TokenRequestError m OAuth2Token
conduitTokenRequest idpAppConfig :: IdpApplication 'JwtBearer i
idpAppConfig@JwtBearerIdpApplication {ByteString
Text
Idp i
idp :: Idp i
idpAppJwt :: ByteString
idpAppName :: Text
$sel:idp:JwtBearerIdpApplication :: forall i. IdpApplication 'JwtBearer i -> Idp i
$sel:idpAppJwt:JwtBearerIdpApplication :: forall i. IdpApplication 'JwtBearer i -> ByteString
$sel:idpAppName:JwtBearerIdpApplication :: forall i. IdpApplication 'JwtBearer i -> Text
..} Manager
mgr = do
    ByteString
resp <- forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
      let tokenReq :: WithExchangeToken 'JwtBearer (TokenRequest 'JwtBearer)
tokenReq = forall (a :: GrantTypeFlow) i.
HasTokenRequest a =>
IdpApplication a i -> WithExchangeToken a (TokenRequest a)
mkTokenRequest IdpApplication 'JwtBearer i
idpAppConfig
      let body :: [(ByteString, ByteString)]
body = [Map Text Text] -> [(ByteString, ByteString)]
mapsToParams [forall a. ToQueryParam a => a -> Map Text Text
toQueryParam WithExchangeToken 'JwtBearer (TokenRequest 'JwtBearer)
tokenReq]
      Request
req <- forall (m :: * -> *). MonadThrow m => URI -> m Request
uriToRequest (forall a. Idp a -> URI
idpTokenEndpoint Idp i
idp)
      Response ByteString -> Either TokenRequestError ByteString
handleOAuth2TokenResponse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadIO m =>
Request -> Manager -> m (Response ByteString)
httpLbs ([(ByteString, ByteString)] -> Request -> Request
urlEncodedBody [(ByteString, ByteString)]
body (Request -> Request
addDefaultRequestHeaders Request
req)) Manager
mgr
    case forall a. FromJSON a => ByteString -> Either TokenRequestError a
parseResponseFlexible ByteString
resp of
      Right OAuth2Token
obj -> forall (m :: * -> *) a. Monad m => a -> m a
return OAuth2Token
obj
      Left TokenRequestError
e -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE TokenRequestError
e

instance ToQueryParam (TokenRequest 'JwtBearer) where
  toQueryParam :: TokenRequest 'JwtBearer -> Map Text Text
  toQueryParam :: TokenRequest 'JwtBearer -> Map Text Text
toQueryParam JwtBearerTokenRequest {ByteString
GrantTypeValue
assertion :: ByteString
grantType :: GrantTypeValue
$sel:assertion:JwtBearerTokenRequest :: TokenRequest 'JwtBearer -> ByteString
$sel:grantType:JwtBearerTokenRequest :: TokenRequest 'JwtBearer -> GrantTypeValue
..} =
    forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions
      [ forall a. ToQueryParam a => a -> Map Text Text
toQueryParam GrantTypeValue
grantType
      , forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text
"assertion", ByteString -> Text
bs8ToLazyText ByteString
assertion)]
      ]

instance HasUserInfoRequest 'JwtBearer where
  conduitUserInfoRequest :: forall i.
FromJSON (IdpUserInfo i) =>
IdpApplication 'JwtBearer i
-> Manager -> AccessToken -> ExceptT ByteString IO (IdpUserInfo i)
conduitUserInfoRequest JwtBearerIdpApplication {ByteString
Text
Idp i
idp :: Idp i
idpAppJwt :: ByteString
idpAppName :: Text
$sel:idp:JwtBearerIdpApplication :: forall i. IdpApplication 'JwtBearer i -> Idp i
$sel:idpAppJwt:JwtBearerIdpApplication :: forall i. IdpApplication 'JwtBearer i -> ByteString
$sel:idpAppName:JwtBearerIdpApplication :: forall i. IdpApplication 'JwtBearer i -> Text
..} Manager
mgr AccessToken
at = do
    forall a.
Idp a
-> forall (m :: * -> *).
   (FromJSON (IdpUserInfo a), MonadIO m) =>
   Manager
   -> AccessToken -> URI -> ExceptT ByteString m (IdpUserInfo a)
idpFetchUserInfo Idp i
idp Manager
mgr AccessToken
at (forall a. Idp a -> URI
idpUserInfoEndpoint Idp i
idp)

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

-- * Password flow

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

-- https://www.rfc-editor.org/rfc/rfc6749#section-4.3.1
-- 4.3.1.  Authorization Request and Response (Password grant type)
-- The method through which the client obtains the resource owner
-- credentials is beyond the scope of this specification.  The client
-- MUST discard the credentials once an access token has been obtained.
--
-- Hence no AuhorizationRequest instance

data instance IdpApplication 'ResourceOwnerPassword i = ResourceOwnerPasswordIDPApplication
  { forall i. IdpApplication 'ResourceOwnerPassword i -> ClientId
idpAppClientId :: ClientId
  , forall i. IdpApplication 'ResourceOwnerPassword i -> ClientSecret
idpAppClientSecret :: ClientSecret
  , forall i. IdpApplication 'ResourceOwnerPassword i -> Text
idpAppName :: Text
  , forall i. IdpApplication 'ResourceOwnerPassword i -> Set Scope
idpAppScope :: Set Scope
  , forall i. IdpApplication 'ResourceOwnerPassword i -> Username
idpAppUserName :: Username
  , forall i. IdpApplication 'ResourceOwnerPassword i -> Password
idpAppPassword :: Password
  , forall i. IdpApplication 'ResourceOwnerPassword i -> Map Text Text
idpAppTokenRequestExtraParams :: Map Text Text
  -- ^ Any parameter that required by your Idp and not mentioned in the OAuth2 spec
  , forall i. IdpApplication 'ResourceOwnerPassword i -> Idp i
idp :: Idp i
  }

instance HasUserInfoRequest 'ResourceOwnerPassword where
  conduitUserInfoRequest :: forall i.
FromJSON (IdpUserInfo i) =>
IdpApplication 'ResourceOwnerPassword i
-> Manager -> AccessToken -> ExceptT ByteString IO (IdpUserInfo i)
conduitUserInfoRequest ResourceOwnerPasswordIDPApplication {Map Text Text
Text
Set Scope
Idp i
Password
Username
ClientSecret
ClientId
idp :: Idp i
idpAppTokenRequestExtraParams :: Map Text Text
idpAppPassword :: Password
idpAppUserName :: Username
idpAppScope :: Set Scope
idpAppName :: Text
idpAppClientSecret :: ClientSecret
idpAppClientId :: ClientId
$sel:idp:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Idp i
$sel:idpAppTokenRequestExtraParams:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Map Text Text
$sel:idpAppPassword:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Password
$sel:idpAppUserName:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Username
$sel:idpAppScope:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Set Scope
$sel:idpAppName:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Text
$sel:idpAppClientSecret:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> ClientSecret
$sel:idpAppClientId:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> ClientId
..} Manager
mgr AccessToken
at = do
    forall a.
Idp a
-> forall (m :: * -> *).
   (FromJSON (IdpUserInfo a), MonadIO m) =>
   Manager
   -> AccessToken -> URI -> ExceptT ByteString m (IdpUserInfo a)
idpFetchUserInfo Idp i
idp Manager
mgr AccessToken
at (forall a. Idp a -> URI
idpUserInfoEndpoint Idp i
idp)

instance HasTokenRequest 'ResourceOwnerPassword where
  -- \| https://www.rfc-editor.org/rfc/rfc6749#section-4.3.2
  data TokenRequest 'ResourceOwnerPassword = PasswordTokenRequest
    { TokenRequest 'ResourceOwnerPassword -> Set Scope
scope :: Set Scope
    , TokenRequest 'ResourceOwnerPassword -> Username
username :: Username
    , TokenRequest 'ResourceOwnerPassword -> Password
password :: Password
    , TokenRequest 'ResourceOwnerPassword -> GrantTypeValue
grantType :: GrantTypeValue
    }
  type WithExchangeToken 'ResourceOwnerPassword a = a

  mkTokenRequest :: IdpApplication 'ResourceOwnerPassword i -> TokenRequest 'ResourceOwnerPassword
  mkTokenRequest :: forall i.
IdpApplication 'ResourceOwnerPassword i
-> TokenRequest 'ResourceOwnerPassword
mkTokenRequest ResourceOwnerPasswordIDPApplication {Map Text Text
Text
Set Scope
Idp i
Password
Username
ClientSecret
ClientId
idp :: Idp i
idpAppTokenRequestExtraParams :: Map Text Text
idpAppPassword :: Password
idpAppUserName :: Username
idpAppScope :: Set Scope
idpAppName :: Text
idpAppClientSecret :: ClientSecret
idpAppClientId :: ClientId
$sel:idp:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Idp i
$sel:idpAppTokenRequestExtraParams:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Map Text Text
$sel:idpAppPassword:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Password
$sel:idpAppUserName:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Username
$sel:idpAppScope:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Set Scope
$sel:idpAppName:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Text
$sel:idpAppClientSecret:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> ClientSecret
$sel:idpAppClientId:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> ClientId
..} =
    PasswordTokenRequest
      { $sel:username:PasswordTokenRequest :: Username
username = Username
idpAppUserName
      , $sel:password:PasswordTokenRequest :: Password
password = Password
idpAppPassword
      , $sel:grantType:PasswordTokenRequest :: GrantTypeValue
grantType = GrantTypeValue
GTPassword
      , $sel:scope:PasswordTokenRequest :: Set Scope
scope = Set Scope
idpAppScope
      }

  conduitTokenRequest ::
    (MonadIO m) =>
    IdpApplication 'ResourceOwnerPassword i ->
    Manager ->
    ExceptT TokenRequestError m OAuth2Token
  conduitTokenRequest :: forall (m :: * -> *) i.
MonadIO m =>
IdpApplication 'ResourceOwnerPassword i
-> Manager -> ExceptT TokenRequestError m OAuth2Token
conduitTokenRequest idpAppConfig :: IdpApplication 'ResourceOwnerPassword i
idpAppConfig@ResourceOwnerPasswordIDPApplication {Map Text Text
Text
Set Scope
Idp i
Password
Username
ClientSecret
ClientId
idp :: Idp i
idpAppTokenRequestExtraParams :: Map Text Text
idpAppPassword :: Password
idpAppUserName :: Username
idpAppScope :: Set Scope
idpAppName :: Text
idpAppClientSecret :: ClientSecret
idpAppClientId :: ClientId
$sel:idp:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Idp i
$sel:idpAppTokenRequestExtraParams:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Map Text Text
$sel:idpAppPassword:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Password
$sel:idpAppUserName:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Username
$sel:idpAppScope:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Set Scope
$sel:idpAppName:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Text
$sel:idpAppClientSecret:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> ClientSecret
$sel:idpAppClientId:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> ClientId
..} Manager
mgr =
    let req :: WithExchangeToken
  'ResourceOwnerPassword (TokenRequest 'ResourceOwnerPassword)
req = forall (a :: GrantTypeFlow) i.
HasTokenRequest a =>
IdpApplication a i -> WithExchangeToken a (TokenRequest a)
mkTokenRequest IdpApplication 'ResourceOwnerPassword i
idpAppConfig
        key :: OAuth2
key = ClientId -> ClientSecret -> OAuth2
toOAuth2Key ClientId
idpAppClientId ClientSecret
idpAppClientSecret
        body :: [(ByteString, ByteString)]
body = [Map Text Text] -> [(ByteString, ByteString)]
mapsToParams [Map Text Text
idpAppTokenRequestExtraParams, forall a. ToQueryParam a => a -> Map Text Text
toQueryParam WithExchangeToken
  'ResourceOwnerPassword (TokenRequest 'ResourceOwnerPassword)
req]
     in forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Manager
-> OAuth2
-> URI
-> [(ByteString, ByteString)]
-> ExceptT TokenRequestError m a
doJSONPostRequest Manager
mgr OAuth2
key (forall a. Idp a -> URI
idpTokenEndpoint Idp i
idp) [(ByteString, ByteString)]
body

-- | TODO: TBD
instance HasRefreshTokenRequest 'ResourceOwnerPassword where
  data RefreshTokenRequest 'ResourceOwnerPassword = PasswordRefreshTokenRequest

  mkRefreshTokenRequest ::
    IdpApplication 'ResourceOwnerPassword i ->
    OAuth2.RefreshToken ->
    RefreshTokenRequest 'ResourceOwnerPassword
  mkRefreshTokenRequest :: forall i.
IdpApplication 'ResourceOwnerPassword i
-> RefreshToken -> RefreshTokenRequest 'ResourceOwnerPassword
mkRefreshTokenRequest = forall a. HasCallStack => a
undefined

  conduitRefreshTokenRequest ::
    MonadIO m =>
    IdpApplication 'ResourceOwnerPassword i ->
    Manager ->
    OAuth2.RefreshToken ->
    ExceptT TokenRequestError m OAuth2Token
  conduitRefreshTokenRequest :: forall (m :: * -> *) i.
MonadIO m =>
IdpApplication 'ResourceOwnerPassword i
-> Manager
-> RefreshToken
-> ExceptT TokenRequestError m OAuth2Token
conduitRefreshTokenRequest = forall a. HasCallStack => a
undefined

instance ToQueryParam (TokenRequest 'ResourceOwnerPassword) where
  toQueryParam :: TokenRequest 'ResourceOwnerPassword -> Map Text Text
  toQueryParam :: TokenRequest 'ResourceOwnerPassword -> Map Text Text
toQueryParam PasswordTokenRequest {Set Scope
Password
Username
GrantTypeValue
grantType :: GrantTypeValue
password :: Password
username :: Username
scope :: Set Scope
$sel:grantType:PasswordTokenRequest :: TokenRequest 'ResourceOwnerPassword -> GrantTypeValue
$sel:password:PasswordTokenRequest :: TokenRequest 'ResourceOwnerPassword -> Password
$sel:username:PasswordTokenRequest :: TokenRequest 'ResourceOwnerPassword -> Username
$sel:scope:PasswordTokenRequest :: TokenRequest 'ResourceOwnerPassword -> Set Scope
..} =
    forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions
      [ forall a. ToQueryParam a => a -> Map Text Text
toQueryParam GrantTypeValue
grantType
      , forall a. ToQueryParam a => a -> Map Text Text
toQueryParam Set Scope
scope
      , forall a. ToQueryParam a => a -> Map Text Text
toQueryParam Username
username
      , forall a. ToQueryParam a => a -> Map Text Text
toQueryParam Password
password
      ]

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

-- * Client Credentials flow

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

-- https://www.rfc-editor.org/rfc/rfc6749#section-4.4.1
-- 4.4.1.  Authorization Request and Response (Client Credentials grant type)
-- Since the client authentication is used as the authorization grant,
-- no additional authorization request is needed.
--
-- Hence no AuhorizationRequest instance

data instance IdpApplication 'ClientCredentials i = ClientCredentialsIDPApplication
  { forall i. IdpApplication 'ClientCredentials i -> ClientId
idpAppClientId :: ClientId
  , forall i. IdpApplication 'ClientCredentials i -> ClientSecret
idpAppClientSecret :: ClientSecret
  , forall i.
IdpApplication 'ClientCredentials i -> ClientAuthenticationMethod
idpAppTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
  -- ^ FIXME: rename to ClientCredential
  , forall i. IdpApplication 'ClientCredentials i -> Text
idpAppName :: Text
  , forall i. IdpApplication 'ClientCredentials i -> Set Scope
idpAppScope :: Set Scope
  , forall i. IdpApplication 'ClientCredentials i -> Map Text Text
idpAppTokenRequestExtraParams :: Map Text Text
  -- ^ Any parameter that required by your Idp and not mentioned in the OAuth2 spec
  , forall i. IdpApplication 'ClientCredentials i -> Idp i
idp :: Idp i
  }

instance HasTokenRequest 'ClientCredentials where
  -- \| https://www.rfc-editor.org/rfc/rfc6749#section-4.4.2
  data TokenRequest 'ClientCredentials = ClientCredentialsTokenRequest
    { TokenRequest 'ClientCredentials -> Set Scope
scope :: Set Scope
    , TokenRequest 'ClientCredentials -> GrantTypeValue
grantType :: GrantTypeValue
    , TokenRequest 'ClientCredentials -> Text
clientAssertionType :: Text
    , TokenRequest 'ClientCredentials -> ByteString
clientAssertion :: BS.ByteString
    , TokenRequest 'ClientCredentials -> ClientAuthenticationMethod
clientAuthenticationMethod :: ClientAuthenticationMethod
    }

  type WithExchangeToken 'ClientCredentials a = a

  mkTokenRequest :: IdpApplication 'ClientCredentials i -> TokenRequest 'ClientCredentials
  mkTokenRequest :: forall i.
IdpApplication 'ClientCredentials i
-> TokenRequest 'ClientCredentials
mkTokenRequest ClientCredentialsIDPApplication {Map Text Text
Text
Set Scope
ClientAuthenticationMethod
Idp i
ClientSecret
ClientId
idp :: Idp i
idpAppTokenRequestExtraParams :: Map Text Text
idpAppScope :: Set Scope
idpAppName :: Text
idpAppTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
idpAppClientSecret :: ClientSecret
idpAppClientId :: ClientId
$sel:idp:ClientCredentialsIDPApplication :: forall i. IdpApplication 'ClientCredentials i -> Idp i
$sel:idpAppTokenRequestExtraParams:ClientCredentialsIDPApplication :: forall i. IdpApplication 'ClientCredentials i -> Map Text Text
$sel:idpAppScope:ClientCredentialsIDPApplication :: forall i. IdpApplication 'ClientCredentials i -> Set Scope
$sel:idpAppName:ClientCredentialsIDPApplication :: forall i. IdpApplication 'ClientCredentials i -> Text
$sel:idpAppTokenRequestAuthenticationMethod:ClientCredentialsIDPApplication :: forall i.
IdpApplication 'ClientCredentials i -> ClientAuthenticationMethod
$sel:idpAppClientSecret:ClientCredentialsIDPApplication :: forall i. IdpApplication 'ClientCredentials i -> ClientSecret
$sel:idpAppClientId:ClientCredentialsIDPApplication :: forall i. IdpApplication 'ClientCredentials i -> ClientId
..} =
    ClientCredentialsTokenRequest
      { $sel:scope:ClientCredentialsTokenRequest :: Set Scope
scope = Set Scope
idpAppScope
      , $sel:grantType:ClientCredentialsTokenRequest :: GrantTypeValue
grantType = GrantTypeValue
GTClientCredentials
      , $sel:clientAssertionType:ClientCredentialsTokenRequest :: Text
clientAssertionType = Text
"urn:ietf:params:oauth:client-assertion-type:jwt-bearer"
      , $sel:clientAssertion:ClientCredentialsTokenRequest :: ByteString
clientAssertion = Text -> ByteString
tlToBS forall a b. (a -> b) -> a -> b
$ ClientSecret -> Text
unClientSecret ClientSecret
idpAppClientSecret
      , $sel:clientAuthenticationMethod:ClientCredentialsTokenRequest :: ClientAuthenticationMethod
clientAuthenticationMethod = ClientAuthenticationMethod
idpAppTokenRequestAuthenticationMethod
      }

  conduitTokenRequest ::
    (MonadIO m) =>
    IdpApplication 'ClientCredentials i ->
    Manager ->
    ExceptT TokenRequestError m OAuth2Token
  conduitTokenRequest :: forall (m :: * -> *) i.
MonadIO m =>
IdpApplication 'ClientCredentials i
-> Manager -> ExceptT TokenRequestError m OAuth2Token
conduitTokenRequest idpAppConfig :: IdpApplication 'ClientCredentials i
idpAppConfig@ClientCredentialsIDPApplication {Map Text Text
Text
Set Scope
ClientAuthenticationMethod
Idp i
ClientSecret
ClientId
idp :: Idp i
idpAppTokenRequestExtraParams :: Map Text Text
idpAppScope :: Set Scope
idpAppName :: Text
idpAppTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
idpAppClientSecret :: ClientSecret
idpAppClientId :: ClientId
$sel:idp:ClientCredentialsIDPApplication :: forall i. IdpApplication 'ClientCredentials i -> Idp i
$sel:idpAppTokenRequestExtraParams:ClientCredentialsIDPApplication :: forall i. IdpApplication 'ClientCredentials i -> Map Text Text
$sel:idpAppScope:ClientCredentialsIDPApplication :: forall i. IdpApplication 'ClientCredentials i -> Set Scope
$sel:idpAppName:ClientCredentialsIDPApplication :: forall i. IdpApplication 'ClientCredentials i -> Text
$sel:idpAppTokenRequestAuthenticationMethod:ClientCredentialsIDPApplication :: forall i.
IdpApplication 'ClientCredentials i -> ClientAuthenticationMethod
$sel:idpAppClientSecret:ClientCredentialsIDPApplication :: forall i. IdpApplication 'ClientCredentials i -> ClientSecret
$sel:idpAppClientId:ClientCredentialsIDPApplication :: forall i. IdpApplication 'ClientCredentials i -> ClientId
..} Manager
mgr = do
    let tokenReq :: WithExchangeToken
  'ClientCredentials (TokenRequest 'ClientCredentials)
tokenReq = forall (a :: GrantTypeFlow) i.
HasTokenRequest a =>
IdpApplication a i -> WithExchangeToken a (TokenRequest a)
mkTokenRequest IdpApplication 'ClientCredentials i
idpAppConfig
        key :: OAuth2
key =
          ClientId -> ClientSecret -> OAuth2
toOAuth2Key
            ClientId
idpAppClientId
            ClientSecret
idpAppClientSecret
        body :: [(ByteString, ByteString)]
body =
          [Map Text Text] -> [(ByteString, ByteString)]
mapsToParams
            [ Map Text Text
idpAppTokenRequestExtraParams
            , forall a. ToQueryParam a => a -> Map Text Text
toQueryParam WithExchangeToken
  'ClientCredentials (TokenRequest 'ClientCredentials)
tokenReq
            ]
    if TokenRequest 'ClientCredentials -> ClientAuthenticationMethod
clientAuthenticationMethod WithExchangeToken
  'ClientCredentials (TokenRequest 'ClientCredentials)
tokenReq forall a. Eq a => a -> a -> Bool
== ClientAuthenticationMethod
ClientAssertionJwt
      then do
        ByteString
resp <- forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
          Request
req <- forall (m :: * -> *). MonadThrow m => URI -> m Request
uriToRequest (forall a. Idp a -> URI
idpTokenEndpoint Idp i
idp)
          let req' :: Request
req' = [(ByteString, ByteString)] -> Request -> Request
urlEncodedBody [(ByteString, ByteString)]
body (Request -> Request
addDefaultRequestHeaders Request
req)
          Response ByteString -> Either TokenRequestError ByteString
handleOAuth2TokenResponse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadIO m =>
Request -> Manager -> m (Response ByteString)
httpLbs Request
req' Manager
mgr
        case forall a. FromJSON a => ByteString -> Either TokenRequestError a
parseResponseFlexible ByteString
resp of
          Right OAuth2Token
obj -> forall (m :: * -> *) a. Monad m => a -> m a
return OAuth2Token
obj
          Left TokenRequestError
e -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE TokenRequestError
e
      else forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Manager
-> OAuth2
-> URI
-> [(ByteString, ByteString)]
-> ExceptT TokenRequestError m a
doJSONPostRequest Manager
mgr OAuth2
key (forall a. Idp a -> URI
idpTokenEndpoint Idp i
idp) [(ByteString, ByteString)]
body

instance ToQueryParam (TokenRequest 'ClientCredentials) where
  toQueryParam :: TokenRequest 'ClientCredentials -> Map Text Text
  toQueryParam :: TokenRequest 'ClientCredentials -> Map Text Text
toQueryParam ClientCredentialsTokenRequest {ByteString
Text
Set Scope
ClientAuthenticationMethod
GrantTypeValue
clientAuthenticationMethod :: ClientAuthenticationMethod
clientAssertion :: ByteString
clientAssertionType :: Text
grantType :: GrantTypeValue
scope :: Set Scope
$sel:clientAuthenticationMethod:ClientCredentialsTokenRequest :: TokenRequest 'ClientCredentials -> ClientAuthenticationMethod
$sel:clientAssertion:ClientCredentialsTokenRequest :: TokenRequest 'ClientCredentials -> ByteString
$sel:clientAssertionType:ClientCredentialsTokenRequest :: TokenRequest 'ClientCredentials -> Text
$sel:grantType:ClientCredentialsTokenRequest :: TokenRequest 'ClientCredentials -> GrantTypeValue
$sel:scope:ClientCredentialsTokenRequest :: TokenRequest 'ClientCredentials -> Set Scope
..} =
    forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions forall a b. (a -> b) -> a -> b
$
      [ forall a. ToQueryParam a => a -> Map Text Text
toQueryParam GrantTypeValue
grantType
      , forall a. ToQueryParam a => a -> Map Text Text
toQueryParam Set Scope
scope
      ]
        forall a. [a] -> [a] -> [a]
++ [ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
              ( if ClientAuthenticationMethod
clientAuthenticationMethod forall a. Eq a => a -> a -> Bool
== ClientAuthenticationMethod
ClientAssertionJwt
                  then
                    [ (Text
"client_assertion_type", Text
clientAssertionType)
                    , (Text
"client_assertion", ByteString -> Text
bs8ToLazyText ByteString
clientAssertion)
                    ]
                  else []
              )
           ]