{-# LANGUAGE FlexibleContexts #-}

module Network.OAuth2.Experiment.Flows.RefreshTokenRequest where

import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Trans.Except (ExceptT (..))
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Set (Set)
import Data.Text.Lazy (Text)
import Network.HTTP.Conduit
import Network.OAuth.OAuth2 hiding (RefreshToken)
import Network.OAuth.OAuth2 qualified as OAuth2
import Network.OAuth2.Experiment.Flows.TokenRequest
import Network.OAuth2.Experiment.Types
import Network.OAuth2.Experiment.Utils

-------------------------------------------------------------------------------
--                            RefreshToken Requset                           --
-------------------------------------------------------------------------------

data RefreshTokenRequest = RefreshTokenRequest
  { RefreshTokenRequest -> RefreshToken
rrRefreshToken :: OAuth2.RefreshToken
  , RefreshTokenRequest -> GrantTypeValue
rrGrantType :: GrantTypeValue
  , RefreshTokenRequest -> Set Scope
rrScope :: Set Scope
  }

instance ToQueryParam RefreshTokenRequest where
  toQueryParam :: RefreshTokenRequest -> Map Text Text
  toQueryParam :: RefreshTokenRequest -> Map Text Text
toQueryParam RefreshTokenRequest {Set Scope
RefreshToken
GrantTypeValue
rrRefreshToken :: RefreshTokenRequest -> RefreshToken
rrGrantType :: RefreshTokenRequest -> GrantTypeValue
rrScope :: RefreshTokenRequest -> Set Scope
rrRefreshToken :: RefreshToken
rrGrantType :: GrantTypeValue
rrScope :: 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
rrGrantType
      , Set Scope -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam Set Scope
rrScope
      , RefreshToken -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam RefreshToken
rrRefreshToken
      ]

class (HasOAuth2Key a, HasTokenRequestClientAuthenticationMethod a) => HasRefreshTokenRequest a where
  -- | Make Refresh Token Request parameters
  -- | https://www.rfc-editor.org/rfc/rfc6749#section-6
  mkRefreshTokenRequestParam :: a -> OAuth2.RefreshToken -> RefreshTokenRequest

-- | Make Refresh Token Request
-- https://www.rfc-editor.org/rfc/rfc6749#section-6
conduitRefreshTokenRequest ::
  (MonadIO m, HasRefreshTokenRequest a) =>
  IdpApplication i a ->
  Manager ->
  OAuth2.RefreshToken ->
  ExceptT TokenResponseError m OAuth2Token
conduitRefreshTokenRequest :: forall {k} (m :: * -> *) a (i :: k).
(MonadIO m, HasRefreshTokenRequest a) =>
IdpApplication i a
-> Manager
-> RefreshToken
-> ExceptT TokenResponseError m OAuth2Token
conduitRefreshTokenRequest IdpApplication {a
Idp i
idp :: Idp i
application :: a
idp :: forall k (i :: k) a. IdpApplication i a -> Idp i
application :: forall k (i :: k) a. IdpApplication i a -> a
..} Manager
mgr RefreshToken
rt =
  let tokenReq :: RefreshTokenRequest
tokenReq = a -> RefreshToken -> RefreshTokenRequest
forall a.
HasRefreshTokenRequest a =>
a -> RefreshToken -> RefreshTokenRequest
mkRefreshTokenRequestParam a
application RefreshToken
rt
      body :: [(ByteString, ByteString)]
body = [Map Text Text] -> [(ByteString, ByteString)]
unionMapsToQueryParams [RefreshTokenRequest -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam RefreshTokenRequest
tokenReq]
   in Manager
-> OAuth2
-> URI
-> [(ByteString, ByteString)]
-> ExceptT TokenResponseError m OAuth2Token
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Manager
-> OAuth2
-> URI
-> [(ByteString, ByteString)]
-> ExceptT TokenResponseError m a
doJSONPostRequest Manager
mgr (a -> OAuth2
forall a. HasOAuth2Key a => a -> OAuth2
mkOAuth2Key a
application) (Idp i -> URI
forall k (i :: k). Idp i -> URI
idpTokenEndpoint Idp i
idp) [(ByteString, ByteString)]
body