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

module Network.OAuth2.Provider.Google where

import Data.Aeson
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import Data.Text.Lazy (Text)
import GHC.Generics
import Network.OAuth.OAuth2
import Network.OAuth2.Experiment
import URI.ByteString.QQ

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

data Google = Google deriving (Google -> Google -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Google -> Google -> Bool
$c/= :: Google -> Google -> Bool
== :: Google -> Google -> Bool
$c== :: Google -> Google -> Bool
Eq, Int -> Google -> ShowS
[Google] -> ShowS
Google -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Google] -> ShowS
$cshowList :: [Google] -> ShowS
show :: Google -> String
$cshow :: Google -> String
showsPrec :: Int -> Google -> ShowS
$cshowsPrec :: Int -> Google -> ShowS
Show)

type instance IdpUserInfo Google = GoogleUser

defaultGoogleApp :: IdpApplication 'AuthorizationCode Google
defaultGoogleApp :: IdpApplication 'AuthorizationCode Google
defaultGoogleApp =
  AuthorizationCodeIdpApplication
    { $sel:idpAppClientId:AuthorizationCodeIdpApplication :: ClientId
idpAppClientId = ClientId
"",
      $sel:idpAppClientSecret:AuthorizationCodeIdpApplication :: ClientSecret
idpAppClientSecret = ClientSecret
"",
      $sel:idpAppScope:AuthorizationCodeIdpApplication :: Set Scope
idpAppScope =
        forall a. Ord a => [a] -> Set a
Set.fromList
          [ Scope
"https://www.googleapis.com/auth/userinfo.email",
            Scope
"https://www.googleapis.com/auth/userinfo.profile"
          ],
      $sel:idpAppAuthorizeState:AuthorizationCodeIdpApplication :: AuthorizeState
idpAppAuthorizeState = AuthorizeState
"CHANGE_ME",
      $sel:idpAppAuthorizeExtraParams:AuthorizationCodeIdpApplication :: Map Text Text
idpAppAuthorizeExtraParams = forall k a. Map k a
Map.empty,
      $sel:idpAppRedirectUri:AuthorizationCodeIdpApplication :: URI
idpAppRedirectUri = [uri|http://localhost|],
      $sel:idpAppName:AuthorizationCodeIdpApplication :: Text
idpAppName = Text
"default-google-App",
      $sel:idpAppTokenRequestAuthenticationMethod:AuthorizationCodeIdpApplication :: ClientAuthenticationMethod
idpAppTokenRequestAuthenticationMethod = ClientAuthenticationMethod
ClientSecretBasic,
      $sel:idp:AuthorizationCodeIdpApplication :: Idp Google
idp = Idp Google
defaultGoogleIdp
    }

defaultGoogleIdp :: Idp Google
defaultGoogleIdp :: Idp Google
defaultGoogleIdp =
  Idp
    { $sel:idpFetchUserInfo:Idp :: forall (m :: * -> *).
(FromJSON (IdpUserInfo Google), MonadIO m) =>
Manager
-> AccessToken -> URI -> ExceptT ByteString m (IdpUserInfo Google)
idpFetchUserInfo = forall a (m :: * -> *).
(FromJSON a, MonadIO m) =>
Manager -> AccessToken -> URI -> ExceptT ByteString m a
authGetJSON @(IdpUserInfo Google),
      $sel:idpAuthorizeEndpoint:Idp :: URI
idpAuthorizeEndpoint = [uri|https://accounts.google.com/o/oauth2/v2/auth|],
      $sel:idpTokenEndpoint:Idp :: URI
idpTokenEndpoint = [uri|https://oauth2.googleapis.com/token|],
      $sel:idpUserInfoEndpoint:Idp :: URI
idpUserInfoEndpoint = [uri|https://www.googleapis.com/oauth2/v2/userinfo|]
    }

data GoogleUser = GoogleUser
  { -- | "scope": "https://www.googleapis.com/auth/userinfo.profile"]
    GoogleUser -> Text
name :: Text,
    GoogleUser -> Text
id :: Text,
    -- | "scopes": "https://www.googleapis.com/auth/userinfo.email",
    GoogleUser -> Text
email :: Text
  }
  deriving (Int -> GoogleUser -> ShowS
[GoogleUser] -> ShowS
GoogleUser -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GoogleUser] -> ShowS
$cshowList :: [GoogleUser] -> ShowS
show :: GoogleUser -> String
$cshow :: GoogleUser -> String
showsPrec :: Int -> GoogleUser -> ShowS
$cshowsPrec :: Int -> GoogleUser -> ShowS
Show, forall x. Rep GoogleUser x -> GoogleUser
forall x. GoogleUser -> Rep GoogleUser x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GoogleUser x -> GoogleUser
$cfrom :: forall x. GoogleUser -> Rep GoogleUser x
Generic)

instance FromJSON GoogleUser