{-# LANGUAGE FlexibleInstances #-}

module Network.OAuth2.Experiment.Grants.JwtBearer where

import Data.ByteString qualified as BS
import Data.Default (Default (def))
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Text.Lazy (Text)
import Network.OAuth.OAuth2 (ClientAuthenticationMethod (..), OAuth2)
import Network.OAuth2.Experiment.Flows.TokenRequest
import Network.OAuth2.Experiment.Flows.UserInfoRequest
import Network.OAuth2.Experiment.Types
import Network.OAuth2.Experiment.Utils

-- | An Application that supports "JWT Bearer" flow
--
-- https://datatracker.ietf.org/doc/html/rfc7523
data JwtBearerApplication = JwtBearerApplication
  { JwtBearerApplication -> Text
jbName :: Text
  , JwtBearerApplication -> ByteString
jbJwtAssertion :: BS.ByteString
  }

-- JwtBearner doesn't use @client_id@ and @client_secret@ for authentication.
--
-- FIXME: The ideal solution shall be do not implement `HasOAuth2Key`
-- but it will stop to re-use the method 'conduitTokenRequest' for JwtBearer flow.
instance HasOAuth2Key JwtBearerApplication where
  mkOAuth2Key :: JwtBearerApplication -> OAuth2
  mkOAuth2Key :: JwtBearerApplication -> OAuth2
mkOAuth2Key JwtBearerApplication
_ = OAuth2
forall a. Default a => a
def

instance HasTokenRequestClientAuthenticationMethod JwtBearerApplication where
  getClientAuthenticationMethod :: JwtBearerApplication -> ClientAuthenticationMethod
  getClientAuthenticationMethod :: JwtBearerApplication -> ClientAuthenticationMethod
getClientAuthenticationMethod JwtBearerApplication
_ = ClientAuthenticationMethod
ClientAssertionJwt

instance HasTokenRequest JwtBearerApplication where
  type ExchangeTokenInfo JwtBearerApplication = NoNeedExchangeToken

  data TokenRequest JwtBearerApplication = JwtBearerTokenRequest
    { TokenRequest JwtBearerApplication -> GrantTypeValue
trGrantType :: GrantTypeValue -- \| 'GTJwtBearer'
    , TokenRequest JwtBearerApplication -> ByteString
trAssertion :: BS.ByteString -- \| The the signed JWT token
    }

  mkTokenRequestParam :: JwtBearerApplication -> NoNeedExchangeToken -> TokenRequest JwtBearerApplication
  mkTokenRequestParam :: JwtBearerApplication
-> NoNeedExchangeToken -> TokenRequest JwtBearerApplication
mkTokenRequestParam JwtBearerApplication {ByteString
Text
jbName :: JwtBearerApplication -> Text
jbJwtAssertion :: JwtBearerApplication -> ByteString
jbName :: Text
jbJwtAssertion :: ByteString
..} NoNeedExchangeToken
_ =
    JwtBearerTokenRequest
      { trGrantType :: GrantTypeValue
trGrantType = GrantTypeValue
GTJwtBearer
      , trAssertion :: ByteString
trAssertion = ByteString
jbJwtAssertion
      }

instance ToQueryParam (TokenRequest JwtBearerApplication) where
  toQueryParam :: TokenRequest JwtBearerApplication -> Map Text Text
  toQueryParam :: TokenRequest JwtBearerApplication -> Map Text Text
toQueryParam JwtBearerTokenRequest {ByteString
GrantTypeValue
trGrantType :: TokenRequest JwtBearerApplication -> GrantTypeValue
trAssertion :: TokenRequest JwtBearerApplication -> ByteString
trGrantType :: GrantTypeValue
trAssertion :: 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
trGrantType
      , Text -> Text -> Map Text Text
forall k a. k -> a -> Map k a
Map.singleton Text
"assertion" (ByteString -> Text
bs8ToLazyText ByteString
trAssertion)
      ]

instance HasUserInfoRequest JwtBearerApplication