{-# LANGUAGE FlexibleInstances #-}

module Network.OAuth2.Experiment.Grants.DeviceAuthorization where

import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe
import Data.Set (Set)
import Data.Text.Lazy (Text)
import Network.OAuth2
import Network.OAuth2.Experiment.Flows.DeviceAuthorizationRequest
import Network.OAuth2.Experiment.Flows.TokenRequest
import Network.OAuth2.Experiment.Flows.UserInfoRequest
import Network.OAuth2.Experiment.Types
import Prelude hiding (error)

-- | An Application that supports "Device Authorization Grant"
--
-- https://www.rfc-editor.org/rfc/rfc8628#section-3.1
data DeviceAuthorizationApplication = DeviceAuthorizationApplication
  { DeviceAuthorizationApplication -> Text
daName :: Text
  , DeviceAuthorizationApplication -> ClientId
daClientId :: ClientId
  , DeviceAuthorizationApplication -> ClientSecret
daClientSecret :: ClientSecret
  , DeviceAuthorizationApplication -> Set Scope
daScope :: Set Scope
  , DeviceAuthorizationApplication -> Map Text Text
daAuthorizationRequestExtraParam :: Map Text Text
  -- ^ Additional parameters to the device authorization request.
  -- Most of identity providers follow the spec strictly but
  -- AzureAD requires "tenant" parameter.
  , DeviceAuthorizationApplication -> ClientAuthenticationMethod
daAuthorizationRequestAuthenticationMethod :: ClientAuthenticationMethod
  -- ^ The spec requires similar authentication method as /token request.
  -- Most of identity providers doesn't required it but some does like Okta.
  }

instance HasClientAuthenticationMethod DeviceAuthorizationApplication where
  getClientAuthenticationMethod :: DeviceAuthorizationApplication -> ClientAuthenticationMethod
  getClientAuthenticationMethod :: DeviceAuthorizationApplication -> ClientAuthenticationMethod
getClientAuthenticationMethod = DeviceAuthorizationApplication -> ClientAuthenticationMethod
daAuthorizationRequestAuthenticationMethod
  addClientAuthToHeader :: DeviceAuthorizationApplication -> Request -> Request
addClientAuthToHeader DeviceAuthorizationApplication {Map Text Text
Text
Set Scope
ClientAuthenticationMethod
ClientSecret
ClientId
daName :: DeviceAuthorizationApplication -> Text
daClientId :: DeviceAuthorizationApplication -> ClientId
daClientSecret :: DeviceAuthorizationApplication -> ClientSecret
daScope :: DeviceAuthorizationApplication -> Set Scope
daAuthorizationRequestExtraParam :: DeviceAuthorizationApplication -> Map Text Text
daAuthorizationRequestAuthenticationMethod :: DeviceAuthorizationApplication -> ClientAuthenticationMethod
daName :: Text
daClientId :: ClientId
daClientSecret :: ClientSecret
daScope :: Set Scope
daAuthorizationRequestExtraParam :: Map Text Text
daAuthorizationRequestAuthenticationMethod :: ClientAuthenticationMethod
..} = ClientId -> ClientSecret -> Request -> Request
addSecretToHeader ClientId
daClientId ClientSecret
daClientSecret

mkDeviceAuthorizationRequestParam :: DeviceAuthorizationApplication -> DeviceAuthorizationRequestParam
mkDeviceAuthorizationRequestParam :: DeviceAuthorizationApplication -> DeviceAuthorizationRequestParam
mkDeviceAuthorizationRequestParam DeviceAuthorizationApplication {Map Text Text
Text
Set Scope
ClientAuthenticationMethod
ClientSecret
ClientId
daName :: DeviceAuthorizationApplication -> Text
daClientId :: DeviceAuthorizationApplication -> ClientId
daClientSecret :: DeviceAuthorizationApplication -> ClientSecret
daScope :: DeviceAuthorizationApplication -> Set Scope
daAuthorizationRequestExtraParam :: DeviceAuthorizationApplication -> Map Text Text
daAuthorizationRequestAuthenticationMethod :: DeviceAuthorizationApplication -> ClientAuthenticationMethod
daName :: Text
daClientId :: ClientId
daClientSecret :: ClientSecret
daScope :: Set Scope
daAuthorizationRequestExtraParam :: Map Text Text
daAuthorizationRequestAuthenticationMethod :: ClientAuthenticationMethod
..} =
  DeviceAuthorizationRequestParam
    { darScope :: Set Scope
darScope = Set Scope
daScope
    , darClientId :: Maybe ClientId
darClientId =
        if ClientAuthenticationMethod
daAuthorizationRequestAuthenticationMethod ClientAuthenticationMethod -> ClientAuthenticationMethod -> Bool
forall a. Eq a => a -> a -> Bool
== ClientAuthenticationMethod
ClientSecretPost
          then ClientId -> Maybe ClientId
forall a. a -> Maybe a
Just ClientId
daClientId
          else Maybe ClientId
forall a. Maybe a
Nothing
    , darExtraParams :: Map Text Text
darExtraParams = Map Text Text
daAuthorizationRequestExtraParam
    }

-- | https://www.rfc-editor.org/rfc/rfc8628#section-3.4
instance HasTokenRequest DeviceAuthorizationApplication where
  type ExchangeTokenInfo DeviceAuthorizationApplication = DeviceCode
  data TokenRequest DeviceAuthorizationApplication = AuthorizationCodeTokenRequest
    { TokenRequest DeviceAuthorizationApplication -> DeviceCode
trCode :: DeviceCode
    , TokenRequest DeviceAuthorizationApplication -> GrantTypeValue
trGrantType :: GrantTypeValue
    , TokenRequest DeviceAuthorizationApplication -> Maybe ClientId
trClientId :: Maybe ClientId
    }

  mkTokenRequestParam ::
    DeviceAuthorizationApplication ->
    DeviceCode ->
    TokenRequest DeviceAuthorizationApplication
  mkTokenRequestParam :: DeviceAuthorizationApplication
-> DeviceCode -> TokenRequest DeviceAuthorizationApplication
mkTokenRequestParam DeviceAuthorizationApplication {Map Text Text
Text
Set Scope
ClientAuthenticationMethod
ClientSecret
ClientId
daName :: DeviceAuthorizationApplication -> Text
daClientId :: DeviceAuthorizationApplication -> ClientId
daClientSecret :: DeviceAuthorizationApplication -> ClientSecret
daScope :: DeviceAuthorizationApplication -> Set Scope
daAuthorizationRequestExtraParam :: DeviceAuthorizationApplication -> Map Text Text
daAuthorizationRequestAuthenticationMethod :: DeviceAuthorizationApplication -> ClientAuthenticationMethod
daName :: Text
daClientId :: ClientId
daClientSecret :: ClientSecret
daScope :: Set Scope
daAuthorizationRequestExtraParam :: Map Text Text
daAuthorizationRequestAuthenticationMethod :: ClientAuthenticationMethod
..} DeviceCode
deviceCode =
    --
    -- This is a bit hacky!
    -- The token request use `ClientSecretBasic` by default. (has to pick up one Client Authn Method)
    -- ClientId shall be also be in request body per spec.
    -- However, for some IdPs, e.g. Okta, when using `ClientSecretBasic` to authn Client,
    -- it doesn't allow @client_id@ in the request body
    -- 'daAuthorizationRequestAuthenticationMethod' set the tone for Authorization Request,
    -- hence just follow it in the token request
    AuthorizationCodeTokenRequest
      { trCode :: DeviceCode
trCode = DeviceCode
deviceCode
      , trGrantType :: GrantTypeValue
trGrantType = GrantTypeValue
GTDeviceCode
      , trClientId :: Maybe ClientId
trClientId =
          if ClientAuthenticationMethod
daAuthorizationRequestAuthenticationMethod ClientAuthenticationMethod -> ClientAuthenticationMethod -> Bool
forall a. Eq a => a -> a -> Bool
== ClientAuthenticationMethod
ClientSecretPost
            then ClientId -> Maybe ClientId
forall a. a -> Maybe a
Just ClientId
daClientId
            else Maybe ClientId
forall a. Maybe a
Nothing
      }

instance ToQueryParam (TokenRequest DeviceAuthorizationApplication) where
  toQueryParam :: TokenRequest DeviceAuthorizationApplication -> Map Text Text
  toQueryParam :: TokenRequest DeviceAuthorizationApplication -> Map Text Text
toQueryParam AuthorizationCodeTokenRequest {Maybe ClientId
GrantTypeValue
DeviceCode
trCode :: TokenRequest DeviceAuthorizationApplication -> DeviceCode
trGrantType :: TokenRequest DeviceAuthorizationApplication -> GrantTypeValue
trClientId :: TokenRequest DeviceAuthorizationApplication -> Maybe ClientId
trCode :: DeviceCode
trGrantType :: GrantTypeValue
trClientId :: Maybe ClientId
..} =
    [Map Text Text] -> Map Text Text
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions
      [ DeviceCode -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam DeviceCode
trCode
      , GrantTypeValue -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam GrantTypeValue
trGrantType
      , Maybe ClientId -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam Maybe ClientId
trClientId
      ]

instance HasUserInfoRequest DeviceAuthorizationApplication