content: {-# LANGUAGE QuasiQuotes #-}
  
  -- | [Google build oauth2 web server application](https://developers.google.com/identity/protocols/oauth2/web-server)
  module Network.OAuth2.Provider.Google where
  
  import Control.Monad.IO.Class (MonadIO (..))
  import Control.Monad.Trans.Except (ExceptT (..))
  import Crypto.PubKey.RSA.Types
  import Data.Aeson
  import Data.Aeson qualified as Aeson
  import Data.Bifunctor
  import Data.ByteString.Contrib
  import Data.ByteString.Lazy.Char8 qualified as BSL
  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.HTTP.Conduit (Manager)
  import Network.OAuth2
  import Network.OAuth2.Experiment
  import Network.OAuth2.Provider
  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"
  -}
  
  -- * Authorization Code flow
  
  sampleGoogleAuthorizationCodeApp :: AuthorizationCodeApplication
  sampleGoogleAuthorizationCodeApp =
    AuthorizationCodeApplication
      { acName = "sample-google-authorization-code-app"
      , acClientId = ""
      , acClientSecret = ""
      , acScope = Set.fromList ["https://www.googleapis.com/auth/userinfo.email", "https://www.googleapis.com/auth/userinfo.profile"]
      , acAuthorizeState = "CHANGE_ME"
      , acRedirectUri = [uri|http://localhost|]
      , acAuthorizeRequestExtraParams = Map.empty
      , acClientAuthenticationMethod = ClientSecretBasic
      }
  
  -- * Service Account
  
  sampleServiceAccountApp :: Jwt -> JwtBearerApplication
  sampleServiceAccountApp jwt =
    JwtBearerApplication
      { jbName = "sample-google-service-account-app"
      , jbJwtAssertion = unJwt jwt
      }
  
  -- | 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"
  
  -- * IDP
  
  fetchUserInfo ::
    (MonadIO m, HasUserInfoRequest a, FromJSON b) =>
    IdpApplication i a ->
    Manager ->
    AccessToken ->
    ExceptT BSL.ByteString m b
  fetchUserInfo = conduitUserInfoRequest
  
  defaultGoogleIdp :: Idp Google
  defaultGoogleIdp =
    Idp
      { 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|]
      , idpDeviceAuthorizationEndpoint = Just [uri|https://oauth2.googleapis.com/device/code|]
      }
  
  -- 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
  