{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- | [Google build oauth2 web server application](https://developers.google.com/identity/protocols/oauth2/web-server)
module Network.OAuth2.Provider.Google where

import Crypto.PubKey.RSA.Types
import Data.Aeson
import Data.Aeson qualified as Aeson
import Data.Bifunctor
import Data.ByteString.Contrib
import Data.Map.Strict qualified as Map
import Data.Maybe
import Data.Set qualified as Set
import Data.Text qualified as T
import Data.Text.Lazy (Text)
import Data.Text.Lazy qualified as TL
import Data.Time
import GHC.Generics
import Jose.Jwa
import Jose.Jws
import Jose.Jwt
import Network.OAuth.OAuth2
import Network.OAuth2.Experiment
import OpenSSL.EVP.PKey (toKeyPair)
import OpenSSL.PEM (
  PemPasswordSupply (PwNone),
  readPrivateKey,
 )
import OpenSSL.RSA
import URI.ByteString.QQ

{-
To test at google playground, set redirect uri to "https://developers.google.com/oauthplayground"
-}

data Google = Google deriving (Eq, Show)

type instance IdpUserInfo Google = GoogleUser

-- * Authorization Code flow

defaultGoogleApp :: IdpApplication 'AuthorizationCode Google
defaultGoogleApp =
  AuthorizationCodeIdpApplication
    { idpAppClientId = ""
    , idpAppClientSecret = ""
    , idpAppScope =
        Set.fromList
          [ "https://www.googleapis.com/auth/userinfo.email"
          , "https://www.googleapis.com/auth/userinfo.profile"
          ]
    , idpAppAuthorizeState = "CHANGE_ME"
    , idpAppAuthorizeExtraParams = Map.empty
    , idpAppRedirectUri = [uri|http://localhost|]
    , idpAppName = "default-google-App"
    , idpAppTokenRequestAuthenticationMethod = ClientSecretBasic
    , idp = defaultGoogleIdp
    }

-- * Service Account

-- | Service account key (in JSON format) that download from google
data GoogleServiceAccountKey = GoogleServiceAccountKey
  { privateKey :: String
  , clientEmail :: Text
  , projectId :: Text
  , privateKeyId :: Text
  , clientId :: Text
  , authUri :: Text
  , tokenUri :: Text
  , authProviderX509CertUrl :: Text
  , clientX509CertUrl :: Text
  }
  deriving (Generic)

instance FromJSON GoogleServiceAccountKey where
  parseJSON = genericParseJSON defaultOptions {fieldLabelModifier = camelTo2 '_'}

-- * Service Account

mkJwt ::
  PrivateKey ->
  -- | Private key
  Text ->
  -- | Issuer
  Maybe Text ->
  -- | impersonate user
  Set.Set Scope ->
  -- | Scope
  Idp Google ->
  IO (Either String Jwt)
mkJwt privateKey iss muser scopes idp = do
  now <- getCurrentTime
  let payload =
        bsToStrict $
          Aeson.encode $
            Aeson.object $
              [ "iss" .= iss
              , "scope" .= T.intercalate " " (map (TL.toStrict . unScope) $ Set.toList scopes)
              , "aud" .= idpTokenEndpoint idp
              , "exp" .= tToSeconds (addUTCTime (secondsToNominalDiffTime 300) now) -- 5 minutes expiration time
              , "iat" .= tToSeconds now
              ]
                ++ maybe [] (\a -> ["sub" .= a]) muser
  first show <$> rsaEncode RS256 privateKey payload
  where
    tToSeconds = formatTime defaultTimeLocale "%s"

-- | Read private RSA Key in PEM format
readPemRsaKey ::
  -- | PEM content
  String ->
  IO (Either String PrivateKey)
readPemRsaKey pemStr = do
  somePair <- readPrivateKey pemStr PwNone
  pure $ case (toKeyPair somePair :: Maybe RSAKeyPair) of
    Just k ->
      Right $
        PrivateKey
          { private_pub =
              PublicKey
                { public_size = rsaSize k
                , public_n = rsaN k
                , public_e = rsaE k
                }
          , private_d = rsaD k
          , private_p = rsaP k
          , private_q = rsaQ k
          , private_dP = fromMaybe 0 (rsaDMP1 k)
          , private_dQ = fromMaybe 0 (rsaDMQ1 k)
          , private_qinv = fromMaybe 0 (rsaIQMP k)
          }
    Nothing -> Left "unable to parse PEM to RSA key"

defaultServiceAccountApp :: Jwt -> IdpApplication 'JwtBearer Google
defaultServiceAccountApp jwt =
  JwtBearerIdpApplication
    { idpAppName = "google-sa-app"
    , idpAppJwt = unJwt jwt
    , idp = defaultGoogleIdp
    }

-- * IDP

defaultGoogleIdp :: Idp Google
defaultGoogleIdp =
  Idp
    { idpFetchUserInfo = authGetJSON @(IdpUserInfo Google)
    , idpAuthorizeEndpoint = [uri|https://accounts.google.com/o/oauth2/v2/auth|]
    , idpTokenEndpoint = [uri|https://oauth2.googleapis.com/token|]
    , idpUserInfoEndpoint = [uri|https://www.googleapis.com/oauth2/v2/userinfo|]
    }

-- requires scope "https://www.googleapis.com/auth/userinfo.profile" to obtain "name".
-- requires scopes "https://www.googleapis.com/auth/userinfo.email" to obtain "email".
data GoogleUser = GoogleUser
  { name :: Text
  , id :: Text
  , email :: Text
  }
  deriving (Show, Generic)

instance FromJSON GoogleUser