{-# 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
_ = b -> b -> Map b b
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
(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)

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

-- * 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
(Int -> Scope -> ShowS)
-> (Scope -> String) -> ([Scope] -> ShowS) -> Show Scope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Scope -> ShowS
showsPrec :: Int -> Scope -> ShowS
$cshow :: Scope -> String
show :: Scope -> String
$cshowList :: [Scope] -> ShowS
showList :: [Scope] -> ShowS
Show, 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

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

-- * 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 :: Text
oauth2ClientId = Text -> Text
TL.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ClientId -> Text
unClientId ClientId
cid
    , oauth2ClientSecret :: Text
oauth2ClientSecret = Text -> Text
TL.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ClientSecret -> Text
unClientSecret ClientSecret
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"

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)

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

-- * 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
$sel:idpAppName:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Text
$sel:idpAppClientId:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientId
$sel:idpAppClientSecret:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientSecret
$sel:idpAppScope:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Set Scope
$sel:idpAppRedirectUri:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> URI
$sel:idpAppAuthorizeState:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> AuthorizeState
$sel:idpAppAuthorizeExtraParams:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Map Text Text
$sel:idpAppTokenRequestAuthenticationMethod:AuthorizationCodeIdpApplication :: forall i.
IdpApplication 'AuthorizationCode i -> ClientAuthenticationMethod
$sel:idp:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Idp i
idpAppName :: Text
idpAppClientId :: ClientId
idpAppClientSecret :: ClientSecret
idpAppScope :: Set Scope
idpAppRedirectUri :: URI
idpAppAuthorizeState :: AuthorizeState
idpAppAuthorizeExtraParams :: Map Text Text
idpAppTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
idp :: Idp i
..} =
    AuthorizationCodeAuthorizationRequest
      { $sel:scope:AuthorizationCodeAuthorizationRequest :: Set Scope
scope = if Set Scope -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set Scope
idpAppScope then Set Scope
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 = RedirectUri -> Maybe 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
$sel:idpAppName:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Text
$sel:idpAppClientId:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientId
$sel:idpAppClientSecret:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientSecret
$sel:idpAppScope:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Set Scope
$sel:idpAppRedirectUri:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> URI
$sel:idpAppAuthorizeState:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> AuthorizeState
$sel:idpAppAuthorizeExtraParams:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Map Text Text
$sel:idpAppTokenRequestAuthenticationMethod:AuthorizationCodeIdpApplication :: forall i.
IdpApplication 'AuthorizationCode i -> ClientAuthenticationMethod
$sel:idp:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Idp i
idpAppName :: Text
idpAppClientId :: ClientId
idpAppClientSecret :: ClientSecret
idpAppScope :: Set Scope
idpAppRedirectUri :: URI
idpAppAuthorizeState :: AuthorizeState
idpAppAuthorizeExtraParams :: Map Text Text
idpAppTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
idp :: Idp i
..} =
    let req :: AuthorizationRequest 'AuthorizationCode
req = IdpApplication 'AuthorizationCode i
-> AuthorizationRequest 'AuthorizationCode
forall i.
IdpApplication 'AuthorizationCode i
-> AuthorizationRequest 'AuthorizationCode
forall (a :: GrantTypeFlow) i.
HasAuthorizeRequest a =>
IdpApplication a i -> AuthorizationRequest a
mkAuthorizeRequestParameter IdpApplication 'AuthorizationCode i
idpAppConfig
        allParams :: [(ByteString, ByteString)]
allParams =
          ((Text, Text) -> (ByteString, ByteString))
-> [(Text, Text)] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> ByteString)
-> (Text -> ByteString) -> (Text, Text) -> (ByteString, ByteString)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Text -> ByteString
tlToBS Text -> ByteString
tlToBS) ([(Text, Text)] -> [(ByteString, ByteString)])
-> [(Text, Text)] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> a -> b
$
            Map Text Text -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Text Text -> [(Text, Text)])
-> Map Text Text -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$
              [Map Text Text] -> Map Text Text
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions [Map Text Text
idpAppAuthorizeExtraParams, AuthorizationRequest 'AuthorizationCode -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam AuthorizationRequest 'AuthorizationCode
req]
     in Text -> Text
TL.fromStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
          ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$
            URI -> ByteString
forall a. URIRef a -> ByteString
serializeURIRef' (URI -> ByteString) -> URI -> ByteString
forall a b. (a -> b) -> a -> b
$
              [(ByteString, ByteString)] -> URI -> URI
forall a. [(ByteString, ByteString)] -> URIRef a -> URIRef a
appendQueryParams [(ByteString, ByteString)]
allParams (URI -> URI) -> URI -> URI
forall a b. (a -> b) -> a -> b
$
                Idp i -> URI
forall 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
$sel:idpAppName:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Text
$sel:idpAppClientId:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientId
$sel:idpAppClientSecret:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientSecret
$sel:idpAppScope:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Set Scope
$sel:idpAppRedirectUri:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> URI
$sel:idpAppAuthorizeState:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> AuthorizeState
$sel:idpAppAuthorizeExtraParams:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Map Text Text
$sel:idpAppTokenRequestAuthenticationMethod:AuthorizationCodeIdpApplication :: forall i.
IdpApplication 'AuthorizationCode i -> ClientAuthenticationMethod
$sel:idp:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Idp i
idpAppName :: Text
idpAppClientId :: ClientId
idpAppClientSecret :: ClientSecret
idpAppScope :: Set Scope
idpAppRedirectUri :: URI
idpAppAuthorizeState :: AuthorizeState
idpAppAuthorizeExtraParams :: Map Text Text
idpAppTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
idp :: Idp i
..} 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
$sel:idpAppName:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Text
$sel:idpAppClientId:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientId
$sel:idpAppClientSecret:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientSecret
$sel:idpAppScope:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Set Scope
$sel:idpAppRedirectUri:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> URI
$sel:idpAppAuthorizeState:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> AuthorizeState
$sel:idpAppAuthorizeExtraParams:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Map Text Text
$sel:idpAppTokenRequestAuthenticationMethod:AuthorizationCodeIdpApplication :: forall i.
IdpApplication 'AuthorizationCode i -> ClientAuthenticationMethod
$sel:idp:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Idp i
idpAppName :: Text
idpAppClientId :: ClientId
idpAppClientSecret :: ClientSecret
idpAppScope :: Set Scope
idpAppRedirectUri :: URI
idpAppAuthorizeState :: AuthorizeState
idpAppAuthorizeExtraParams :: Map Text Text
idpAppTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
idp :: Idp i
..} Manager
mgr ExchangeToken
exchangeToken =
    let req :: TokenRequest 'AuthorizationCode
req = IdpApplication 'AuthorizationCode i
-> WithExchangeToken
     'AuthorizationCode (TokenRequest 'AuthorizationCode)
forall i.
IdpApplication 'AuthorizationCode i
-> WithExchangeToken
     'AuthorizationCode (TokenRequest 'AuthorizationCode)
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
            [ TokenRequest 'AuthorizationCode -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam TokenRequest 'AuthorizationCode
req
            , Maybe ClientSecret -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam
                ( if ClientAuthenticationMethod
idpAppTokenRequestAuthenticationMethod ClientAuthenticationMethod -> ClientAuthenticationMethod -> Bool
forall a. Eq a => a -> a -> Bool
== ClientAuthenticationMethod
ClientSecretPost
                    then ClientSecret -> Maybe ClientSecret
forall a. a -> Maybe a
Just ClientSecret
idpAppClientSecret
                    else Maybe ClientSecret
forall a. Maybe a
Nothing
                )
            ]
     in Manager
-> OAuth2
-> URI
-> [(ByteString, ByteString)]
-> ExceptT TokenRequestError m OAuth2Token
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Manager
-> OAuth2
-> URI
-> [(ByteString, ByteString)]
-> ExceptT TokenRequestError m a
doJSONPostRequest Manager
mgr OAuth2
key (Idp i -> URI
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
$sel:idpAppName:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Text
$sel:idpAppClientId:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientId
$sel:idpAppClientSecret:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientSecret
$sel:idpAppScope:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Set Scope
$sel:idpAppRedirectUri:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> URI
$sel:idpAppAuthorizeState:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> AuthorizeState
$sel:idpAppAuthorizeExtraParams:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Map Text Text
$sel:idpAppTokenRequestAuthenticationMethod:AuthorizationCodeIdpApplication :: forall i.
IdpApplication 'AuthorizationCode i -> ClientAuthenticationMethod
$sel:idp:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Idp i
idpAppName :: Text
idpAppClientId :: ClientId
idpAppClientSecret :: ClientSecret
idpAppScope :: Set Scope
idpAppRedirectUri :: URI
idpAppAuthorizeState :: AuthorizeState
idpAppAuthorizeExtraParams :: Map Text Text
idpAppTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
idp :: Idp i
..} = do
    PkceRequestParam {CodeChallengeMethod
CodeVerifier
CodeChallenge
codeVerifier :: CodeVerifier
codeChallenge :: CodeChallenge
codeChallengeMethod :: CodeChallengeMethod
codeVerifier :: PkceRequestParam -> CodeVerifier
codeChallenge :: PkceRequestParam -> CodeChallenge
codeChallengeMethod :: PkceRequestParam -> CodeChallengeMethod
..} <- m PkceRequestParam
forall (m :: * -> *). MonadIO m => m PkceRequestParam
mkPkceParam
    let req :: AuthorizationRequest 'AuthorizationCode
req = IdpApplication 'AuthorizationCode i
-> AuthorizationRequest 'AuthorizationCode
forall i.
IdpApplication 'AuthorizationCode i
-> AuthorizationRequest 'AuthorizationCode
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
            , AuthorizationRequest 'AuthorizationCode -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam AuthorizationRequest 'AuthorizationCode
req
            , CodeChallenge -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam CodeChallenge
codeChallenge
            , CodeChallengeMethod -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam CodeChallengeMethod
codeChallengeMethod
            ]

    let url :: Text
url =
          Text -> Text
TL.fromStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
            ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$
              URI -> ByteString
forall a. URIRef a -> ByteString
serializeURIRef' (URI -> ByteString) -> URI -> ByteString
forall a b. (a -> b) -> a -> b
$
                [(ByteString, ByteString)] -> URI -> URI
forall a. [(ByteString, ByteString)] -> URIRef a -> URIRef a
appendQueryParams [(ByteString, ByteString)]
allParams (URI -> URI) -> URI -> URI
forall a b. (a -> b) -> a -> b
$
                  Idp i -> URI
forall a. Idp a -> URI
idpAuthorizeEndpoint Idp i
idp
    (Text, CodeVerifier) -> m (Text, CodeVerifier)
forall a. a -> m a
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
$sel:idpAppName:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Text
$sel:idpAppClientId:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientId
$sel:idpAppClientSecret:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientSecret
$sel:idpAppScope:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Set Scope
$sel:idpAppRedirectUri:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> URI
$sel:idpAppAuthorizeState:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> AuthorizeState
$sel:idpAppAuthorizeExtraParams:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Map Text Text
$sel:idpAppTokenRequestAuthenticationMethod:AuthorizationCodeIdpApplication :: forall i.
IdpApplication 'AuthorizationCode i -> ClientAuthenticationMethod
$sel:idp:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Idp i
idpAppName :: Text
idpAppClientId :: ClientId
idpAppClientSecret :: ClientSecret
idpAppScope :: Set Scope
idpAppRedirectUri :: URI
idpAppAuthorizeState :: AuthorizeState
idpAppAuthorizeExtraParams :: Map Text Text
idpAppTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
idp :: Idp i
..} Manager
mgr (ExchangeToken
exchangeToken, CodeVerifier
codeVerifier) =
    let req :: TokenRequest 'AuthorizationCode
req = IdpApplication 'AuthorizationCode i
-> WithExchangeToken
     'AuthorizationCode (TokenRequest 'AuthorizationCode)
forall i.
IdpApplication 'AuthorizationCode i
-> WithExchangeToken
     'AuthorizationCode (TokenRequest 'AuthorizationCode)
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
            [ TokenRequest 'AuthorizationCode -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam TokenRequest 'AuthorizationCode
req
            , CodeVerifier -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam CodeVerifier
codeVerifier
            , Maybe ClientSecret -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam (if ClientAuthenticationMethod
idpAppTokenRequestAuthenticationMethod ClientAuthenticationMethod -> ClientAuthenticationMethod -> Bool
forall a. Eq a => a -> a -> Bool
== ClientAuthenticationMethod
ClientSecretPost then ClientSecret -> Maybe ClientSecret
forall a. a -> Maybe a
Just ClientSecret
idpAppClientSecret else Maybe ClientSecret
forall a. Maybe a
Nothing)
            ]
     in Manager
-> OAuth2
-> URI
-> [(ByteString, ByteString)]
-> ExceptT TokenRequestError m OAuth2Token
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Manager
-> OAuth2
-> URI
-> [(ByteString, ByteString)]
-> ExceptT TokenRequestError m a
doJSONPostRequest Manager
mgr OAuth2
key (Idp i -> URI
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
$sel:idpAppName:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Text
$sel:idpAppClientId:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientId
$sel:idpAppClientSecret:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientSecret
$sel:idpAppScope:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Set Scope
$sel:idpAppRedirectUri:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> URI
$sel:idpAppAuthorizeState:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> AuthorizeState
$sel:idpAppAuthorizeExtraParams:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Map Text Text
$sel:idpAppTokenRequestAuthenticationMethod:AuthorizationCodeIdpApplication :: forall i.
IdpApplication 'AuthorizationCode i -> ClientAuthenticationMethod
$sel:idp:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Idp i
idpAppName :: Text
idpAppClientId :: ClientId
idpAppClientSecret :: ClientSecret
idpAppScope :: Set Scope
idpAppRedirectUri :: URI
idpAppAuthorizeState :: AuthorizeState
idpAppAuthorizeExtraParams :: Map Text Text
idpAppTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
idp :: Idp i
..} 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
$sel:idpAppName:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Text
$sel:idpAppClientId:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientId
$sel:idpAppClientSecret:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientSecret
$sel:idpAppScope:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Set Scope
$sel:idpAppRedirectUri:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> URI
$sel:idpAppAuthorizeState:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> AuthorizeState
$sel:idpAppAuthorizeExtraParams:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Map Text Text
$sel:idpAppTokenRequestAuthenticationMethod:AuthorizationCodeIdpApplication :: forall i.
IdpApplication 'AuthorizationCode i -> ClientAuthenticationMethod
$sel:idp:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Idp i
idpAppName :: Text
idpAppClientId :: ClientId
idpAppClientSecret :: ClientSecret
idpAppScope :: Set Scope
idpAppRedirectUri :: URI
idpAppAuthorizeState :: AuthorizeState
idpAppAuthorizeExtraParams :: Map Text Text
idpAppTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
idp :: Idp i
..} Manager
mgr RefreshToken
rt =
    let req :: RefreshTokenRequest 'AuthorizationCode
req = IdpApplication 'AuthorizationCode i
-> RefreshToken -> RefreshTokenRequest 'AuthorizationCode
forall i.
IdpApplication 'AuthorizationCode i
-> RefreshToken -> RefreshTokenRequest 'AuthorizationCode
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
            [ RefreshTokenRequest 'AuthorizationCode -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam RefreshTokenRequest 'AuthorizationCode
req
            , Maybe ClientSecret -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam (if ClientAuthenticationMethod
idpAppTokenRequestAuthenticationMethod ClientAuthenticationMethod -> ClientAuthenticationMethod -> Bool
forall a. Eq a => a -> a -> Bool
== ClientAuthenticationMethod
ClientSecretPost then ClientSecret -> Maybe ClientSecret
forall a. a -> Maybe a
Just ClientSecret
idpAppClientSecret else Maybe ClientSecret
forall a. Maybe a
Nothing)
            ]
     in Manager
-> OAuth2
-> URI
-> [(ByteString, ByteString)]
-> ExceptT TokenRequestError m OAuth2Token
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Manager
-> OAuth2
-> URI
-> [(ByteString, ByteString)]
-> ExceptT TokenRequestError m a
doJSONPostRequest Manager
mgr OAuth2
key (Idp i -> URI
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
$sel:idpAppName:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Text
$sel:idpAppClientId:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientId
$sel:idpAppClientSecret:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> ClientSecret
$sel:idpAppScope:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Set Scope
$sel:idpAppRedirectUri:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> URI
$sel:idpAppAuthorizeState:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> AuthorizeState
$sel:idpAppAuthorizeExtraParams:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Map Text Text
$sel:idpAppTokenRequestAuthenticationMethod:AuthorizationCodeIdpApplication :: forall i.
IdpApplication 'AuthorizationCode i -> ClientAuthenticationMethod
$sel:idp:AuthorizationCodeIdpApplication :: forall i. IdpApplication 'AuthorizationCode i -> Idp i
idpAppName :: Text
idpAppClientId :: ClientId
idpAppClientSecret :: ClientSecret
idpAppScope :: Set Scope
idpAppRedirectUri :: URI
idpAppAuthorizeState :: AuthorizeState
idpAppAuthorizeExtraParams :: Map Text Text
idpAppTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
idp :: Idp i
..} Manager
mgr AccessToken
at = do
    Idp i
-> forall (m :: * -> *).
   (FromJSON (IdpUserInfo i), MonadIO m) =>
   Manager
   -> AccessToken -> URI -> ExceptT ByteString m (IdpUserInfo i)
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 (Idp i -> URI
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
$sel:scope:AuthorizationCodeAuthorizationRequest :: AuthorizationRequest 'AuthorizationCode -> Set Scope
$sel:state:AuthorizationCodeAuthorizationRequest :: AuthorizationRequest 'AuthorizationCode -> AuthorizeState
$sel:clientId:AuthorizationCodeAuthorizationRequest :: AuthorizationRequest 'AuthorizationCode -> ClientId
$sel:redirectUri:AuthorizationCodeAuthorizationRequest :: AuthorizationRequest 'AuthorizationCode -> Maybe RedirectUri
scope :: Set Scope
state :: AuthorizeState
clientId :: ClientId
redirectUri :: Maybe RedirectUri
..} =
    [Map Text Text] -> Map Text Text
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions
      [ AuthorizationRequest 'AuthorizationCode -> Map Text Text
forall (a :: GrantTypeFlow) b (req :: GrantTypeFlow -> *).
(ToResponseTypeValue a, IsString b) =>
req a -> Map b b
toResponseTypeParam AuthorizationRequest 'AuthorizationCode
req
      , Set Scope -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam Set Scope
scope
      , ClientId -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam ClientId
clientId
      , AuthorizeState -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam AuthorizeState
state
      , Maybe RedirectUri -> Map Text Text
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
$sel:code:AuthorizationCodeTokenRequest :: TokenRequest 'AuthorizationCode -> ExchangeToken
$sel:clientId:AuthorizationCodeTokenRequest :: TokenRequest 'AuthorizationCode -> ClientId
$sel:grantType:AuthorizationCodeTokenRequest :: TokenRequest 'AuthorizationCode -> GrantTypeValue
$sel:redirectUri:AuthorizationCodeTokenRequest :: TokenRequest 'AuthorizationCode -> RedirectUri
code :: ExchangeToken
clientId :: ClientId
grantType :: GrantTypeValue
redirectUri :: RedirectUri
..} =
    [Map Text Text] -> Map Text Text
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions
      [ GrantTypeValue -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam GrantTypeValue
grantType
      , ExchangeToken -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam ExchangeToken
code
      , RedirectUri -> Map Text Text
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
$sel:refreshToken:AuthorizationCodeTokenRefreshRequest :: RefreshTokenRequest 'AuthorizationCode -> RefreshToken
$sel:grantType:AuthorizationCodeTokenRefreshRequest :: RefreshTokenRequest 'AuthorizationCode -> GrantTypeValue
$sel:scope:AuthorizationCodeTokenRefreshRequest :: RefreshTokenRequest 'AuthorizationCode -> Set Scope
refreshToken :: RefreshToken
grantType :: GrantTypeValue
scope :: Set Scope
..} =
    [Map Text Text] -> Map Text Text
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions
      [ GrantTypeValue -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam GrantTypeValue
grantType
      , Set Scope -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam Set Scope
scope
      , RefreshToken -> Map Text Text
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
$sel:idpAppName:JwtBearerIdpApplication :: forall i. IdpApplication 'JwtBearer i -> Text
$sel:idpAppJwt:JwtBearerIdpApplication :: forall i. IdpApplication 'JwtBearer i -> ByteString
$sel:idp:JwtBearerIdpApplication :: forall i. IdpApplication 'JwtBearer i -> Idp i
idpAppName :: Text
idpAppJwt :: ByteString
idp :: Idp i
..} =
    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
$sel:idpAppName:JwtBearerIdpApplication :: forall i. IdpApplication 'JwtBearer i -> Text
$sel:idpAppJwt:JwtBearerIdpApplication :: forall i. IdpApplication 'JwtBearer i -> ByteString
$sel:idp:JwtBearerIdpApplication :: forall i. IdpApplication 'JwtBearer i -> Idp i
idpAppName :: Text
idpAppJwt :: ByteString
idp :: Idp i
..} Manager
mgr = do
    ByteString
resp <- m (Either TokenRequestError ByteString)
-> ExceptT TokenRequestError m ByteString
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either TokenRequestError ByteString)
 -> ExceptT TokenRequestError m ByteString)
-> (IO (Either TokenRequestError ByteString)
    -> m (Either TokenRequestError ByteString))
-> IO (Either TokenRequestError ByteString)
-> ExceptT TokenRequestError m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either TokenRequestError ByteString)
-> m (Either TokenRequestError ByteString)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either TokenRequestError ByteString)
 -> ExceptT TokenRequestError m ByteString)
-> IO (Either TokenRequestError ByteString)
-> ExceptT TokenRequestError m ByteString
forall a b. (a -> b) -> a -> b
$ do
      let tokenReq :: WithExchangeToken 'JwtBearer (TokenRequest 'JwtBearer)
tokenReq = IdpApplication 'JwtBearer i
-> WithExchangeToken 'JwtBearer (TokenRequest 'JwtBearer)
forall i.
IdpApplication 'JwtBearer i
-> WithExchangeToken 'JwtBearer (TokenRequest 'JwtBearer)
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 [TokenRequest 'JwtBearer -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam TokenRequest 'JwtBearer
WithExchangeToken 'JwtBearer (TokenRequest 'JwtBearer)
tokenReq]
      Request
req <- URI -> IO Request
forall (m :: * -> *). MonadThrow m => URI -> m Request
uriToRequest (Idp i -> URI
forall a. Idp a -> URI
idpTokenEndpoint Idp i
idp)
      Response ByteString -> Either TokenRequestError ByteString
handleOAuth2TokenResponse (Response ByteString -> Either TokenRequestError ByteString)
-> IO (Response ByteString)
-> IO (Either TokenRequestError ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> Manager -> IO (Response ByteString)
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 ByteString -> Either TokenRequestError OAuth2Token
forall a. FromJSON a => ByteString -> Either TokenRequestError a
parseResponseFlexible ByteString
resp of
      Right OAuth2Token
obj -> OAuth2Token -> ExceptT TokenRequestError m OAuth2Token
forall a. a -> ExceptT TokenRequestError m a
forall (m :: * -> *) a. Monad m => a -> m a
return OAuth2Token
obj
      Left TokenRequestError
e -> TokenRequestError -> ExceptT TokenRequestError m OAuth2Token
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
$sel:grantType:JwtBearerTokenRequest :: TokenRequest 'JwtBearer -> GrantTypeValue
$sel:assertion:JwtBearerTokenRequest :: TokenRequest 'JwtBearer -> ByteString
grantType :: GrantTypeValue
assertion :: ByteString
..} =
    [Map Text Text] -> Map Text Text
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions
      [ GrantTypeValue -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam GrantTypeValue
grantType
      , [(Text, Text)] -> Map Text Text
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
$sel:idpAppName:JwtBearerIdpApplication :: forall i. IdpApplication 'JwtBearer i -> Text
$sel:idpAppJwt:JwtBearerIdpApplication :: forall i. IdpApplication 'JwtBearer i -> ByteString
$sel:idp:JwtBearerIdpApplication :: forall i. IdpApplication 'JwtBearer i -> Idp i
idpAppName :: Text
idpAppJwt :: ByteString
idp :: Idp i
..} Manager
mgr AccessToken
at = do
    Idp i
-> forall (m :: * -> *).
   (FromJSON (IdpUserInfo i), MonadIO m) =>
   Manager
   -> AccessToken -> URI -> ExceptT ByteString m (IdpUserInfo i)
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 (Idp i -> URI
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
$sel:idpAppClientId:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> ClientId
$sel:idpAppClientSecret:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> ClientSecret
$sel:idpAppName:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Text
$sel:idpAppScope:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Set Scope
$sel:idpAppUserName:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Username
$sel:idpAppPassword:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Password
$sel:idpAppTokenRequestExtraParams:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Map Text Text
$sel:idp:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Idp i
idpAppClientId :: ClientId
idpAppClientSecret :: ClientSecret
idpAppName :: Text
idpAppScope :: Set Scope
idpAppUserName :: Username
idpAppPassword :: Password
idpAppTokenRequestExtraParams :: Map Text Text
idp :: Idp i
..} Manager
mgr AccessToken
at = do
    Idp i
-> forall (m :: * -> *).
   (FromJSON (IdpUserInfo i), MonadIO m) =>
   Manager
   -> AccessToken -> URI -> ExceptT ByteString m (IdpUserInfo i)
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 (Idp i -> URI
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
$sel:idpAppClientId:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> ClientId
$sel:idpAppClientSecret:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> ClientSecret
$sel:idpAppName:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Text
$sel:idpAppScope:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Set Scope
$sel:idpAppUserName:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Username
$sel:idpAppPassword:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Password
$sel:idpAppTokenRequestExtraParams:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Map Text Text
$sel:idp:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Idp i
idpAppClientId :: ClientId
idpAppClientSecret :: ClientSecret
idpAppName :: Text
idpAppScope :: Set Scope
idpAppUserName :: Username
idpAppPassword :: Password
idpAppTokenRequestExtraParams :: Map Text Text
idp :: Idp i
..} =
    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
$sel:idpAppClientId:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> ClientId
$sel:idpAppClientSecret:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> ClientSecret
$sel:idpAppName:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Text
$sel:idpAppScope:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Set Scope
$sel:idpAppUserName:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Username
$sel:idpAppPassword:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Password
$sel:idpAppTokenRequestExtraParams:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Map Text Text
$sel:idp:ResourceOwnerPasswordIDPApplication :: forall i. IdpApplication 'ResourceOwnerPassword i -> Idp i
idpAppClientId :: ClientId
idpAppClientSecret :: ClientSecret
idpAppName :: Text
idpAppScope :: Set Scope
idpAppUserName :: Username
idpAppPassword :: Password
idpAppTokenRequestExtraParams :: Map Text Text
idp :: Idp i
..} Manager
mgr =
    let req :: WithExchangeToken
  'ResourceOwnerPassword (TokenRequest 'ResourceOwnerPassword)
req = IdpApplication 'ResourceOwnerPassword i
-> WithExchangeToken
     'ResourceOwnerPassword (TokenRequest 'ResourceOwnerPassword)
forall i.
IdpApplication 'ResourceOwnerPassword i
-> WithExchangeToken
     'ResourceOwnerPassword (TokenRequest 'ResourceOwnerPassword)
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, TokenRequest 'ResourceOwnerPassword -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam TokenRequest 'ResourceOwnerPassword
WithExchangeToken
  'ResourceOwnerPassword (TokenRequest 'ResourceOwnerPassword)
req]
     in Manager
-> OAuth2
-> URI
-> [(ByteString, ByteString)]
-> ExceptT TokenRequestError m OAuth2Token
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Manager
-> OAuth2
-> URI
-> [(ByteString, ByteString)]
-> ExceptT TokenRequestError m a
doJSONPostRequest Manager
mgr OAuth2
key (Idp i -> URI
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 = IdpApplication 'ResourceOwnerPassword i
-> RefreshToken -> RefreshTokenRequest 'ResourceOwnerPassword
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 = IdpApplication 'ResourceOwnerPassword i
-> Manager
-> RefreshToken
-> ExceptT TokenRequestError m OAuth2Token
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
$sel:scope:PasswordTokenRequest :: TokenRequest 'ResourceOwnerPassword -> Set Scope
$sel:username:PasswordTokenRequest :: TokenRequest 'ResourceOwnerPassword -> Username
$sel:password:PasswordTokenRequest :: TokenRequest 'ResourceOwnerPassword -> Password
$sel:grantType:PasswordTokenRequest :: TokenRequest 'ResourceOwnerPassword -> GrantTypeValue
scope :: Set Scope
username :: Username
password :: Password
grantType :: GrantTypeValue
..} =
    [Map Text Text] -> Map Text Text
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions
      [ GrantTypeValue -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam GrantTypeValue
grantType
      , Set Scope -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam Set Scope
scope
      , Username -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam Username
username
      , Password -> Map Text Text
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
$sel:idpAppClientId:ClientCredentialsIDPApplication :: forall i. IdpApplication 'ClientCredentials i -> ClientId
$sel:idpAppClientSecret:ClientCredentialsIDPApplication :: forall i. IdpApplication 'ClientCredentials i -> ClientSecret
$sel:idpAppTokenRequestAuthenticationMethod:ClientCredentialsIDPApplication :: forall i.
IdpApplication 'ClientCredentials i -> ClientAuthenticationMethod
$sel:idpAppName:ClientCredentialsIDPApplication :: forall i. IdpApplication 'ClientCredentials i -> Text
$sel:idpAppScope:ClientCredentialsIDPApplication :: forall i. IdpApplication 'ClientCredentials i -> Set Scope
$sel:idpAppTokenRequestExtraParams:ClientCredentialsIDPApplication :: forall i. IdpApplication 'ClientCredentials i -> Map Text Text
$sel:idp:ClientCredentialsIDPApplication :: forall i. IdpApplication 'ClientCredentials i -> Idp i
idpAppClientId :: ClientId
idpAppClientSecret :: ClientSecret
idpAppTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
idpAppName :: Text
idpAppScope :: Set Scope
idpAppTokenRequestExtraParams :: Map Text Text
idp :: Idp i
..} =
    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 (Text -> ByteString) -> Text -> ByteString
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
$sel:idpAppClientId:ClientCredentialsIDPApplication :: forall i. IdpApplication 'ClientCredentials i -> ClientId
$sel:idpAppClientSecret:ClientCredentialsIDPApplication :: forall i. IdpApplication 'ClientCredentials i -> ClientSecret
$sel:idpAppTokenRequestAuthenticationMethod:ClientCredentialsIDPApplication :: forall i.
IdpApplication 'ClientCredentials i -> ClientAuthenticationMethod
$sel:idpAppName:ClientCredentialsIDPApplication :: forall i. IdpApplication 'ClientCredentials i -> Text
$sel:idpAppScope:ClientCredentialsIDPApplication :: forall i. IdpApplication 'ClientCredentials i -> Set Scope
$sel:idpAppTokenRequestExtraParams:ClientCredentialsIDPApplication :: forall i. IdpApplication 'ClientCredentials i -> Map Text Text
$sel:idp:ClientCredentialsIDPApplication :: forall i. IdpApplication 'ClientCredentials i -> Idp i
idpAppClientId :: ClientId
idpAppClientSecret :: ClientSecret
idpAppTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
idpAppName :: Text
idpAppScope :: Set Scope
idpAppTokenRequestExtraParams :: Map Text Text
idp :: Idp i
..} Manager
mgr = do
    let tokenReq :: WithExchangeToken
  'ClientCredentials (TokenRequest 'ClientCredentials)
tokenReq = IdpApplication 'ClientCredentials i
-> WithExchangeToken
     'ClientCredentials (TokenRequest 'ClientCredentials)
forall i.
IdpApplication 'ClientCredentials i
-> WithExchangeToken
     'ClientCredentials (TokenRequest 'ClientCredentials)
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
            , TokenRequest 'ClientCredentials -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam TokenRequest 'ClientCredentials
WithExchangeToken
  'ClientCredentials (TokenRequest 'ClientCredentials)
tokenReq
            ]
    if TokenRequest 'ClientCredentials -> ClientAuthenticationMethod
clientAuthenticationMethod TokenRequest 'ClientCredentials
WithExchangeToken
  'ClientCredentials (TokenRequest 'ClientCredentials)
tokenReq ClientAuthenticationMethod -> ClientAuthenticationMethod -> Bool
forall a. Eq a => a -> a -> Bool
== ClientAuthenticationMethod
ClientAssertionJwt
      then do
        ByteString
resp <- m (Either TokenRequestError ByteString)
-> ExceptT TokenRequestError m ByteString
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either TokenRequestError ByteString)
 -> ExceptT TokenRequestError m ByteString)
-> (IO (Either TokenRequestError ByteString)
    -> m (Either TokenRequestError ByteString))
-> IO (Either TokenRequestError ByteString)
-> ExceptT TokenRequestError m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either TokenRequestError ByteString)
-> m (Either TokenRequestError ByteString)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either TokenRequestError ByteString)
 -> ExceptT TokenRequestError m ByteString)
-> IO (Either TokenRequestError ByteString)
-> ExceptT TokenRequestError m ByteString
forall a b. (a -> b) -> a -> b
$ do
          Request
req <- URI -> IO Request
forall (m :: * -> *). MonadThrow m => URI -> m Request
uriToRequest (Idp i -> URI
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 (Response ByteString -> Either TokenRequestError ByteString)
-> IO (Response ByteString)
-> IO (Either TokenRequestError ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> Manager -> IO (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> Manager -> m (Response ByteString)
httpLbs Request
req' Manager
mgr
        case ByteString -> Either TokenRequestError OAuth2Token
forall a. FromJSON a => ByteString -> Either TokenRequestError a
parseResponseFlexible ByteString
resp of
          Right OAuth2Token
obj -> OAuth2Token -> ExceptT TokenRequestError m OAuth2Token
forall a. a -> ExceptT TokenRequestError m a
forall (m :: * -> *) a. Monad m => a -> m a
return OAuth2Token
obj
          Left TokenRequestError
e -> TokenRequestError -> ExceptT TokenRequestError m OAuth2Token
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE TokenRequestError
e
      else Manager
-> OAuth2
-> URI
-> [(ByteString, ByteString)]
-> ExceptT TokenRequestError m OAuth2Token
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Manager
-> OAuth2
-> URI
-> [(ByteString, ByteString)]
-> ExceptT TokenRequestError m a
doJSONPostRequest Manager
mgr OAuth2
key (Idp i -> URI
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
$sel:scope:ClientCredentialsTokenRequest :: TokenRequest 'ClientCredentials -> Set Scope
$sel:grantType:ClientCredentialsTokenRequest :: TokenRequest 'ClientCredentials -> GrantTypeValue
$sel:clientAssertionType:ClientCredentialsTokenRequest :: TokenRequest 'ClientCredentials -> Text
$sel:clientAssertion:ClientCredentialsTokenRequest :: TokenRequest 'ClientCredentials -> ByteString
$sel:clientAuthenticationMethod:ClientCredentialsTokenRequest :: TokenRequest 'ClientCredentials -> ClientAuthenticationMethod
scope :: Set Scope
grantType :: GrantTypeValue
clientAssertionType :: Text
clientAssertion :: ByteString
clientAuthenticationMethod :: ClientAuthenticationMethod
..} =
    [Map Text Text] -> Map Text Text
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions ([Map Text Text] -> Map Text Text)
-> [Map Text Text] -> Map Text Text
forall a b. (a -> b) -> a -> b
$
      [ GrantTypeValue -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam GrantTypeValue
grantType
      , Set Scope -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam Set Scope
scope
      ]
        [Map Text Text] -> [Map Text Text] -> [Map Text Text]
forall a. [a] -> [a] -> [a]
++ [ [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
              ( if ClientAuthenticationMethod
clientAuthenticationMethod ClientAuthenticationMethod -> ClientAuthenticationMethod -> Bool
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 []
              )
           ]