content: {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE KindSignatures #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  
  -- |
  -- Module      : Gogol.Auth
  -- Copyright   : (c) 2015-2022 Brendan Hay
  -- License     : Mozilla Public License, v. 2.0.
  -- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>
  -- Stability   : provisional
  -- Portability : non-portable (GHC extensions)
  --
  -- Explicitly specify your Google credentials, or retrieve them
  -- from the underlying OS.
  module Gogol.Auth
    ( -- * Credentials
      Credentials (..),
  
      -- ** Application Default Credentials
      getApplicationDefault,
      fromWellKnownPath,
      fromFilePath,
      saveAuthorizedUserToWellKnownPath,
      saveAuthorizedUser,
  
      -- ** Service account user impersonation
      serviceAccountUser,
  
      -- *** Kubernetes
      serviceAccountTokenFile,
  
      -- ** Installed Application Credentials
      installedApplication,
      formURL,
  
      -- ** Authorizing Requests
      authorize,
  
      -- ** Thread-safe Storage
      Store,
      initStore,
      retrieveAuthFromStore,
      retrieveTokenFromStore,
      Auth (..),
      authToAuthorizedUser,
      exchange,
      refresh,
  
      -- ** Default Constants
      checkGCEVar,
      cloudSDKConfigDir,
      defaultCredentialsFile,
  
      -- ** Handling Errors
      AsAuthError (..),
      AuthError (..),
  
      -- * OAuth Types
      OAuthClient (..),
      OAuthToken (..),
      OAuthCode (..),
      OAuthScope (..),
  
      -- * Re-exported Types
      AccessToken (..),
      RefreshToken (..),
      GSecret (..),
      ServiceId (..),
      ClientId (..),
  
      -- * Re-exported Modules
      module Gogol.Auth.Scope,
    )
  where
  
  import Control.Concurrent
  import Control.Monad.Catch (MonadCatch)
  import Control.Monad.IO.Class (MonadIO (..))
  import Data.Time (getCurrentTime)
  import GHC.TypeLits (Symbol)
  import Gogol.Auth.ApplicationDefault
  import Gogol.Auth.InstalledApplication
  import Gogol.Auth.Scope
  import Gogol.Auth.ServiceAccount
  import Gogol.Auth.TokenFile
  import Gogol.Compute.Metadata (checkGCEVar)
  import Gogol.Internal.Auth
  import Gogol.Internal.Logger (Logger)
  import Gogol.Prelude
  import Network.HTTP.Conduit (Manager)
  import Network.HTTP.Conduit qualified as Client
  import Network.HTTP.Types (hAuthorization)
  
  -- | 'authToAuthorizedUser' converts 'Auth' into an 'AuthorizedUser'
  --  by returning 'Right' if there is a 'FromClient'-constructed
  --  Credentials and a refreshed token; otherwise, returning
  --  'Left' with error message.
  authToAuthorizedUser :: (KnownScopes s) => Auth s -> Either Text AuthorizedUser
  authToAuthorizedUser a =
    AuthorizedUser
      <$> (_clientId <$> getClient)
      <*> maybe (Left "no refresh token") Right (_tokenRefresh (_token a))
      <*> (_clientSecret <$> getClient)
    where
      getClient = case _credentials a of
        FromClient c _ -> Right c
        _ -> Left "not FromClient"
  
  -- | An 'OAuthToken' that can potentially be expired, with the original
  -- credentials that can be used to perform a refresh.
  data Auth (s :: [Symbol]) = Auth
    { _credentials :: !(Credentials s),
      _token :: !(OAuthToken s)
    }
  
  -- | Check if the given token is still valid, ie. younger than the projected
  -- expiry time.
  --
  -- This deliberately makes no external calls due to the absolute construction of
  -- the '_tokenExpiry' field, unlike the
  -- <https://developers.google.com/accounts/docs/OAuth2Login#validatingtoken documented>
  -- validation method.
  validate :: (MonadIO m) => Auth s -> m Bool
  validate a = (< _tokenExpiry (_token a)) <$> liftIO getCurrentTime
  
  -- | Data store which ensures thread-safe access of credentials.
  newtype Store (s :: [Symbol]) = Store (MVar (Auth s))
  
  -- | Construct storage containing the credentials which have not yet been
  -- exchanged or refreshed.
  initStore ::
    (MonadIO m, MonadCatch m, KnownScopes s) =>
    Credentials s ->
    Logger ->
    Manager ->
    m (Store s)
  initStore c l m = exchange c l m >>= fmap Store . liftIO . newMVar
  
  -- | Retrieve auth from storage
  retrieveAuthFromStore ::
    (MonadIO m, KnownScopes s) =>
    Store s ->
    m (Auth s)
  retrieveAuthFromStore (Store s) =
    liftIO (readMVar s)
  
  -- | Concurrently read the current token, and if expired, then
  -- safely perform a single serial refresh.
  retrieveTokenFromStore ::
    (MonadIO m, MonadCatch m, KnownScopes s) =>
    Store s ->
    Logger ->
    Manager ->
    m (OAuthToken s)
  retrieveTokenFromStore (Store s) l m = do
    x <- liftIO (readMVar s)
    mx <- validate x
    if mx
      then pure (_token x)
      else liftIO . modifyMVar s $ \y -> do
        my <- validate y
        if my
          then pure (y, _token y)
          else do
            z <- refresh y l m
            pure (z, _token z)
  
  -- | Perform the initial credentials exchange to obtain a valid 'OAuthToken'
  -- suitable for authorizing requests.
  exchange ::
    forall m s.
    (MonadIO m, MonadCatch m, KnownScopes s) =>
    Credentials s ->
    Logger ->
    Manager ->
    m (Auth s)
  exchange c l = fmap (Auth c) . action l
    where
      action = case c of
        FromMetadata s -> metadataToken s
        FromAccount a -> serviceAccountToken a (Proxy :: Proxy s)
        FromClient x n -> exchangeCode x n
        FromUser u -> authorizedUserToken u Nothing
        FromTokenFile f -> \_l _m -> readTokenFile f
  
  -- | Refresh an existing 'OAuthToken'.
  refresh ::
    forall m s.
    (MonadIO m, MonadCatch m, KnownScopes s) =>
    Auth s ->
    Logger ->
    Manager ->
    m (Auth s)
  refresh (Auth c t) l = fmap (Auth c) . action l
    where
      action = case c of
        FromMetadata s -> metadataToken s
        FromAccount a -> serviceAccountToken a (Proxy :: Proxy s)
        FromClient x _ -> refreshToken x t
        FromUser u -> authorizedUserToken u (_tokenRefresh t)
        FromTokenFile f -> \_l _m -> readTokenFile f
  
  -- | Apply the (by way of possible token refresh) a bearer token to the
  -- authentication header of a request.
  authorize ::
    (MonadIO m, MonadCatch m, KnownScopes s) =>
    Client.Request ->
    Store s ->
    Logger ->
    Manager ->
    m Client.Request
  authorize rq s l m = bearer <$> retrieveTokenFromStore s l m
    where
      bearer t =
        rq
          { Client.requestHeaders =
              ( hAuthorization,
                "Bearer " <> toHeader (_tokenAccess t)
              )
                : Client.requestHeaders rq
          }
  
  -- | Set the user to be impersonated for a service account with domain
  -- wide delegation. See
  -- https://developers.google.com/identity/protocols/OAuth2ServiceAccount
  serviceAccountUser ::
    forall s.
    (KnownScopes s) =>
    Maybe Text ->
    Credentials s ->
    Credentials s
  serviceAccountUser u (FromAccount s) = FromAccount $ s {_serviceAccountUser = u}
  serviceAccountUser _ c = c
  