content: {-# LANGUAGE BangPatterns #-}
  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE DeriveGeneric #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE KindSignatures #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  
  -- |
  -- Module      : Gogol.Internal.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)
  --
  -- Internal types and helpers for constructing OAuth credentials.
  module Gogol.Internal.Auth where
  
  import Control.Exception (Exception, SomeException, catch, throwIO)
  import Control.Exception.Lens (exception)
  import Control.Lens (Prism', prism)
  import Control.Monad.IO.Class (MonadIO (..))
  import Crypto.PubKey.RSA.Types (PrivateKey)
  import Data.Aeson
  import Data.Aeson.Types (Pair)
  import Data.ByteArray (ByteArray)
  import Data.ByteArray.Encoding
  import Data.ByteString.Builder ()
  import Data.ByteString.Lazy qualified as LBS
  import Data.String (IsString)
  import Data.Text qualified as Text
  import Data.Text.Encoding qualified as Text
  import Data.Time
  import Data.X509 (PrivKey (..))
  import Data.X509.Memory (readKeyFileFromMemory)
  import GHC.TypeLits (Symbol)
  import Gogol.Internal.Logger
  import Gogol.Prelude
  import Network.HTTP.Conduit (HttpException, Manager)
  import Network.HTTP.Conduit qualified as Client
  import Network.HTTP.Types (Status, hContentType)
  
  -- | The supported credential mechanisms.
  data Credentials (s :: [Symbol])
    = -- | Obtain and refresh access tokens from the underlying GCE host metadata
      -- at @http:\/\/169.254.169.254@.
      FromMetadata !ServiceId
    | -- | Obtain and refresh access tokens using the specified client secret
      -- and authorization code obtained from.
      --
      -- See the <https://developers.google.com/accounts/docs/OAuth2InstalledApp OAuth2 Installed Application>
      -- documentation for more information.
      FromClient !OAuthClient !(OAuthCode s)
    | -- | Use the specified @service_account@ and scopes to sign and request
      -- an access token. The 'ServiceAccount' will also be used for subsequent
      -- token refreshes.
      --
      -- A 'ServiceAccount' is typically generated through the
      -- Google Developer Console.
      FromAccount !ServiceAccount
    | -- | Use the specified @authorized_user@ to obtain and refresh access tokens.
      --
      -- An 'AuthorizedUser' is typically created by the @gcloud init@ command
      -- of the Google CloudSDK Tools.
      FromUser !AuthorizedUser
    | FromTokenFile !FilePath
  
  -- | Service Account credentials which are typically generated/download
  -- from the Google Developer console of the following form:
  --
  -- > {
  -- >   \"type\": \"service_account\",
  -- >   \"private_key_id\": \"303ad77e5efdf2ce952DFa\",
  -- >   \"private_key\": \"-----BEGIN PRIVATE KEY-----\n...\n\",
  -- >   \"client_email\": \"email@serviceaccount.com\",
  -- >   \"client_id\": \"035-2-310.useraccount.com\"
  -- > }
  --
  -- The private key is used to sign a JSON Web Token (JWT) of the
  -- grant_type @urn:ietf:params:oauth:grant-type:jwt-bearer@, which is sent to
  -- 'accountsURL' to obtain a valid 'OAuthToken'. This process requires explicitly
  -- specifying which 'Scope's the resulting 'OAuthToken' is authorized to access.
  --
  -- /See:/ <https://developers.google.com/identity/protocols/OAuth2ServiceAccount#delegatingauthority Delegating authority to your service account>.
  data ServiceAccount = ServiceAccount
    { _serviceId :: !ClientId,
      _serviceEmail :: !Text,
      _serviceKeyId :: !Text,
      _servicePrivateKey :: !PrivateKey,
      _serviceAccountUser :: !(Maybe Text)
    }
    deriving (Eq, Show)
  
  instance FromJSON ServiceAccount where
    parseJSON = withObject "service_account" $ \o -> do
      bs <- Text.encodeUtf8 <$> o .: "private_key"
      k <- case listToMaybe (readKeyFileFromMemory bs) of
        Just (PrivKeyRSA k) -> pure k
        _ ->
          fail "Unable to parse key contents from \"private_key\""
      ServiceAccount
        <$> o .: "client_id"
        <*> o .: "client_email"
        <*> o .: "private_key_id"
        <*> pure k
        <*> pure Nothing
  
  -- | Authorized User credentials which are typically generated by the Cloud SDK
  -- Tools such as @gcloud init@, of the following form:
  --
  -- > {
  -- >   \"type\": \"authorized_user\",
  -- >   \"client_id\": \"32555940559.apps.googleusercontent.com\",
  -- >   \"client_secret\": \"Zms2qjJy2998hD4CTg2ejr2\",
  -- >   \"refresh_token\": \"1/B3gM1x35v.VtqffS1n5w-rSJ\"
  -- > }
  --
  -- The secret and refresh token are used to obtain a valid 'OAuthToken' from
  -- 'accountsURL' using grant_type @refresh_token@.
  data AuthorizedUser = AuthorizedUser
    { _userId :: !ClientId,
      _userRefresh :: !RefreshToken,
      _userSecret :: !GSecret
    }
    deriving (Eq, Show)
  
  instance ToJSON AuthorizedUser where
    toJSON (AuthorizedUser i r s) =
      object
        [ "client_id" .= i,
          "refresh_token" .= r,
          "client_secret" .= s
        ]
  
  instance FromJSON AuthorizedUser where
    parseJSON = withObject "authorized_user" $ \o ->
      AuthorizedUser
        <$> o .: "client_id"
        <*> o .: "refresh_token"
        <*> o .: "client_secret"
  
  -- | A client identifier and accompanying secret used to obtain/refresh a token.
  data OAuthClient = OAuthClient
    { _clientId :: !ClientId,
      _clientSecret :: !GSecret
    }
    deriving (Eq, Show)
  
  -- | An OAuth bearer type token of the following form:
  --
  -- > {
  -- >   \"token_type\": \"Bearer\",
  -- >   \"access_token\": \"eyJhbGci...\",
  -- >   \"refresh_token\": \"1/B3gq9K...\",
  -- >   \"expires_in\": 3600,
  -- >   ...
  -- > }
  --
  -- The '_tokenAccess' field will be inserted verbatim into the
  -- @Authorization: Bearer ...@ header for all HTTP requests.
  data OAuthToken (s :: [Symbol]) = OAuthToken
    { _tokenAccess :: !AccessToken,
      _tokenRefresh :: !(Maybe RefreshToken),
      _tokenExpiry :: !UTCTime
    }
    deriving (Eq, Show)
  
  instance FromJSON (UTCTime -> OAuthToken s) where
    parseJSON = withObject "bearer" $ \o -> do
      t <- o .: "access_token"
      r <- o .:? "refresh_token"
      e <- o .: "expires_in" <&> fromInteger
      pure (OAuthToken t r . addUTCTime e)
  
  -- | An OAuth client authorization code.
  newtype OAuthCode (s :: [Symbol]) = OAuthCode Text
    deriving (Eq, Ord, Show, Read, IsString, Generic, Typeable, FromJSON, ToJSON)
  
  instance ToHttpApiData (OAuthCode s) where
    toQueryParam (OAuthCode c) = c
    toHeader (OAuthCode c) = Text.encodeUtf8 c
  
  -- | An error thrown when attempting to read/write AuthN/AuthZ information.
  data AuthError
    = RetrievalError HttpException
    | MissingFileError FilePath
    | InvalidFileError FilePath Text
    | TokenRefreshError Status Text (Maybe Text)
    | FileExistError FilePath
    deriving (Show, Typeable)
  
  instance Exception AuthError
  
  class AsAuthError a where
    -- | A general authentication error.
    _AuthError :: Prism' a AuthError
  
    {-# MINIMAL _AuthError #-}
  
    -- | An error occured while communicating over HTTP with either then
    -- local metadata or remote accounts.google.com endpoints.
    _RetrievalError :: Prism' a HttpException
  
    -- | The specified default credentials file could not be found.
    _MissingFileError :: Prism' a FilePath
  
    -- | An error occured parsing the default credentials file.
    _InvalidFileError :: Prism' a (FilePath, Text)
  
    -- | An error occured when attempting to refresh a token.
    _TokenRefreshError :: Prism' a (Status, Text, Maybe Text)
  
    _RetrievalError = _AuthError . _RetrievalError
    _MissingFileError = _AuthError . _MissingFileError
    _InvalidFileError = _AuthError . _InvalidFileError
    _TokenRefreshError = _AuthError . _TokenRefreshError
  
  instance AsAuthError SomeException where
    _AuthError = exception
  
  instance AsAuthError AuthError where
    _AuthError = id
  
    _RetrievalError = prism RetrievalError $ \case
      RetrievalError e -> Right e
      x -> Left x
  
    _MissingFileError = prism MissingFileError $ \case
      MissingFileError f -> Right f
      x -> Left x
  
    _InvalidFileError =
      prism
        (uncurry InvalidFileError)
        ( \case
            InvalidFileError f e -> Right (f, e)
            x -> Left x
        )
  
    _TokenRefreshError =
      prism
        (\(s, e, d) -> TokenRefreshError s e d)
        ( \case
            TokenRefreshError s e d -> Right (s, e, d)
            x -> Left x
        )
  
  data RefreshError = RefreshError
    { _error :: !Text,
      _description :: !(Maybe Text)
    }
  
  instance FromJSON RefreshError where
    parseJSON = withObject "refresh_error" $ \o ->
      RefreshError
        <$> o .: "error"
        <*> o .:? "error_description"
  
  -- | @https://accounts.google.com/o/oauth2/v2/auth@.
  accountsURL :: Text
  accountsURL = "https://accounts.google.com/o/oauth2/v2/auth"
  
  accountsRequest :: Client.Request
  accountsRequest =
    Client.defaultRequest
      { Client.host = "accounts.google.com",
        Client.port = 443,
        Client.secure = True,
        Client.method = "POST",
        Client.path = "/o/oauth2/v2/auth",
        Client.requestHeaders =
          [ (hContentType, "application/x-www-form-urlencoded")
          ]
      }
  
  -- | @https://www.googleapis.com/oauth2/v4/token@.
  tokenURL :: Text
  tokenURL = "https://www.googleapis.com/oauth2/v4/token"
  
  tokenRequest :: Client.Request
  tokenRequest =
    Client.defaultRequest
      { Client.host = "www.googleapis.com",
        Client.port = 443,
        Client.secure = True,
        Client.method = "POST",
        Client.path = "/oauth2/v4/token",
        Client.requestHeaders =
          [ (hContentType, "application/x-www-form-urlencoded")
          ]
      }
  
  refreshRequest ::
    (MonadIO m) =>
    Client.Request ->
    Logger ->
    Manager ->
    m (OAuthToken s)
  refreshRequest rq l m = do
    logDebug l rq -- debug:ClientRequest
    rs <- liftIO (Client.httpLbs rq m `catch` (throwIO . RetrievalError))
  
    let bs = Client.responseBody rs
        s = Client.responseStatus rs
  
    logDebug l rs -- debug:ClientResponse
    logTrace l $ "[Response Body]\n" <> bs -- trace:ResponseBody
    if fromEnum s == 200
      then success s bs
      else failure s bs
    where
      success s bs = do
        f <- parseErr s bs
        ts <- liftIO getCurrentTime
        pure (f ts)
  
      failure s bs = do
        let e = "Failure refreshing token from " <> host <> path
        logError l $ "[Refresh Error] " <> build e
        case parseLBS bs of
          Right x -> refreshErr s (_error x) (_description x)
          Left _ -> refreshErr s e Nothing
  
      parseErr s bs =
        case parseLBS bs of
          Right !x -> pure x
          Left e -> do
            logError l $
              "[Parse Error] Failure parsing token refresh " <> build e
            refreshErr s e Nothing
  
      refreshErr :: (MonadIO m) => Status -> Text -> Maybe Text -> m a
      refreshErr s e = liftIO . throwIO . TokenRefreshError s e
  
      host = Text.decodeUtf8 (Client.host rq)
      path = Text.decodeUtf8 (Client.path rq)
  
  parseLBS :: (FromJSON a) => LBS.ByteString -> Either Text a
  parseLBS = either (Left . Text.pack) Right . eitherDecode'
  
  base64Encode :: [Pair] -> ByteString
  base64Encode = base64 . LBS.toStrict . encode . object
  
  base64 :: (ByteArray a) => a -> ByteString
  base64 = convertToBase Base64URLUnpadded
  
  textBody :: Text -> RequestBody
  textBody = Client.RequestBodyBS . Text.encodeUtf8
  