{-# LANGUAGE CPP               #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE RankNTypes        #-}
{-# LANGUAGE TypeFamilies      #-}
-- | Use an email address as an identifier via Google's login system.
--
-- Note that this is a replacement for "Yesod.Auth.GoogleEmail", which depends
-- on Google's now deprecated OpenID system. For more information, see
-- <https://developers.google.com/+/api/auth-migration>.
--
-- By using this plugin, you are trusting Google to validate an email address,
-- and requiring users to have a Google account. On the plus side, you get to
-- use email addresses as the identifier, many users have existing Google
-- accounts, the login system has been long tested (as opposed to BrowserID),
-- and it requires no credential managing or setup (as opposed to Email).
--
-- In order to use this plugin:
--
-- * Create an application on the Google Developer Console <https://console.developers.google.com/>
--
-- * Create OAuth credentials. The redirect URI will be <http://yourdomain/auth/page/googleemail2/complete>. (If you have your authentication subsite at a different root than \/auth\/, please adjust accordingly.)
--
-- * Enable the Google+ API.
--
-- @since 1.3.1
module Yesod.Auth.GoogleEmail2
    {-# DEPRECATED "Google+ is being shut down, please migrate to Google Sign-in https://pbrisbin.com/posts/googleemail2_deprecation/" #-}
    ( -- * Authentication handlers
      authGoogleEmail
    , authGoogleEmailSaveToken
    , forwardUrl
    -- * User authentication token
    , Token(..)
    , getUserAccessToken
    -- * Person
    , getPerson
    , Person(..)
    , Name(..)
    , Gender(..)
    , PersonImage(..)
    , resizePersonImage
    , RelationshipStatus(..)
    , PersonURI(..)
    , PersonURIType(..)
    , Organization(..)
    , OrganizationType(..)
    , Place(..)
    , Email(..)
    , EmailType(..)
    -- * Other functions
    , pid
    ) where

import           Yesod.Auth                  (Auth, AuthHandler,
                                              AuthPlugin (AuthPlugin),
                                              AuthRoute, Creds (Creds),
                                              Route (PluginR), YesodAuth,
                                              logoutDest, runHttpRequest,
                                              setCredsRedirect)
import qualified Yesod.Auth.Message          as Msg
import           Yesod.Core                  (HandlerSite, MonadHandler,
                                              TypedContent, addMessage,
                                              getRouteToParent, getUrlRender,
                                              getYesod, invalidArgs, liftIO,
                                              liftSubHandler, lookupGetParam,
                                              lookupSession, notFound, redirect,
                                              setSession, toHtml, whamlet, (.:))


import           Blaze.ByteString.Builder    (fromByteString, toByteString)
import           Control.Applicative         ((<$>), (<*>))
import           Control.Arrow               (second)
import           Control.Monad               (unless, when)
import           Control.Monad.IO.Class      (MonadIO)
import qualified Crypto.Nonce                as Nonce
import           Data.Aeson                  ((.:?))
import qualified Data.Aeson                  as A
#if MIN_VERSION_aeson(1,0,0)
import qualified Data.Aeson.Text             as A
#else
import qualified Data.Aeson.Encode           as A
#endif
import           Data.Aeson.Parser           (json')
import           Data.Aeson.Types            (FromJSON (parseJSON), parseEither,
                                              parseMaybe, withObject, withText)
import           Data.Conduit
import           Data.Conduit.Attoparsec     (sinkParser)
import           Data.Maybe                  (fromMaybe)
import           Data.Monoid                 (mappend)
import           Data.Text                   (Text)
import qualified Data.Text                   as T
import           Data.Text.Encoding          (decodeUtf8, encodeUtf8)
import qualified Data.Text.Lazy              as TL
import qualified Data.Text.Lazy.Builder      as TL
import           Network.HTTP.Client         (Manager, requestHeaders,
                                              responseBody, urlEncodedBody)
import qualified Network.HTTP.Client         as HTTP
import           Network.HTTP.Client.Conduit (Request, bodyReaderSource)
import           Network.HTTP.Conduit        (http)
import           Network.HTTP.Types          (renderQueryText)
import           System.IO.Unsafe            (unsafePerformIO)

#if MIN_VERSION_aeson(2, 0, 0)
import qualified Data.Aeson.Key
import qualified Data.Aeson.KeyMap
#else
import qualified Data.HashMap.Strict         as M
#endif


-- | Plugin identifier. This is used to identify the plugin used for
-- authentication. The 'credsPlugin' will contain this value when this
-- plugin is used for authentication.
-- @since 1.4.17
pid :: Text
pid :: Text
pid = Text
"googleemail2"

forwardUrl :: AuthRoute
forwardUrl :: AuthRoute
forwardUrl = Text -> Texts -> AuthRoute
PluginR Text
pid [Text
"forward"]

csrfKey :: Text
csrfKey :: Text
csrfKey = Text
"_GOOGLE_CSRF_TOKEN"

getCsrfToken :: MonadHandler m => m (Maybe Text)
getCsrfToken :: forall (m :: * -> *). MonadHandler m => m (Maybe Text)
getCsrfToken = forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupSession Text
csrfKey

accessTokenKey :: Text
accessTokenKey :: Text
accessTokenKey = Text
"_GOOGLE_ACCESS_TOKEN"

-- | Get user's access token from the session. Returns Nothing if it's not found
--   (probably because the user is not logged in via 'Yesod.Auth.GoogleEmail2'
--   or you are not using 'authGoogleEmailSaveToken')
getUserAccessToken :: MonadHandler m => m (Maybe Token)
getUserAccessToken :: forall (m :: * -> *). MonadHandler m => m (Maybe Token)
getUserAccessToken = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
t -> Text -> Text -> Token
Token Text
t Text
"Bearer") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupSession Text
accessTokenKey

getCreateCsrfToken :: MonadHandler m => m Text
getCreateCsrfToken :: forall (m :: * -> *). MonadHandler m => m Text
getCreateCsrfToken = do
    Maybe Text
mtoken <- forall (m :: * -> *). MonadHandler m => m (Maybe Text)
getCsrfToken
    case Maybe Text
mtoken of
        Just Text
token -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
token
        Maybe Text
Nothing -> do
            Text
token <- forall (m :: * -> *). MonadIO m => Generator -> m Text
Nonce.nonce128urlT Generator
defaultNonceGen
            forall (m :: * -> *). MonadHandler m => Text -> Text -> m ()
setSession Text
csrfKey Text
token
            forall (m :: * -> *) a. Monad m => a -> m a
return Text
token

authGoogleEmail :: YesodAuth m
                => Text -- ^ client ID
                -> Text -- ^ client secret
                -> AuthPlugin m
authGoogleEmail :: forall m. YesodAuth m => Text -> Text -> AuthPlugin m
authGoogleEmail = forall m. YesodAuth m => Bool -> Text -> Text -> AuthPlugin m
authPlugin Bool
False

-- | An alternative version which stores user access token in the session
--   variable. Use it if you want to request user's profile from your app.
--
-- @since 1.4.3
authGoogleEmailSaveToken :: YesodAuth m
                         => Text -- ^ client ID
                         -> Text -- ^ client secret
                         -> AuthPlugin m
authGoogleEmailSaveToken :: forall m. YesodAuth m => Text -> Text -> AuthPlugin m
authGoogleEmailSaveToken = forall m. YesodAuth m => Bool -> Text -> Text -> AuthPlugin m
authPlugin Bool
True

authPlugin :: YesodAuth m
           => Bool -- ^ if the token should be stored
           -> Text -- ^ client ID
           -> Text -- ^ client secret
           -> AuthPlugin m
authPlugin :: forall m. YesodAuth m => Bool -> Text -> Text -> AuthPlugin m
authPlugin Bool
storeToken Text
clientID Text
clientSecret =
    forall master.
Text
-> (Text -> Texts -> AuthHandler master TypedContent)
-> ((AuthRoute -> Route master) -> WidgetFor master ())
-> AuthPlugin master
AuthPlugin Text
pid forall site.
YesodAuth site =>
Text -> Texts -> AuthHandler site TypedContent
dispatch forall {site}.
YesodAuth site =>
(AuthRoute -> Route site) -> WidgetFor site ()
login
  where
    complete :: AuthRoute
complete = Text -> Texts -> AuthRoute
PluginR Text
pid [Text
"complete"]

    getDest :: MonadHandler m
            => (Route Auth -> Route (HandlerSite m))
            -> m Text
    getDest :: forall (m :: * -> *).
MonadHandler m =>
(AuthRoute -> Route (HandlerSite m)) -> m Text
getDest AuthRoute -> Route (HandlerSite m)
tm = do
        Text
csrf <- forall (m :: * -> *). MonadHandler m => m Text
getCreateCsrfToken
        Route (HandlerSite m) -> Text
render <- forall (m :: * -> *).
MonadHandler m =>
m (Route (HandlerSite m) -> Text)
getUrlRender
        let qs :: [(Text, Maybe Text)]
qs = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a. a -> Maybe a
Just)
                [ (Text
"scope", Text
"email profile")
                , (Text
"state", Text
csrf)
                , (Text
"redirect_uri", Route (HandlerSite m) -> Text
render forall a b. (a -> b) -> a -> b
$ AuthRoute -> Route (HandlerSite m)
tm AuthRoute
complete)
                , (Text
"response_type", Text
"code")
                , (Text
"client_id", Text
clientID)
                , (Text
"access_type", Text
"offline")
                ]
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8
               forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
toByteString
               forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
fromByteString ByteString
"https://accounts.google.com/o/oauth2/auth"
                    forall a. Monoid a => a -> a -> a
`Data.Monoid.mappend` Bool -> [(Text, Maybe Text)] -> Builder
renderQueryText Bool
True [(Text, Maybe Text)]
qs

    login :: (AuthRoute -> Route site) -> WidgetFor site ()
login AuthRoute -> Route site
tm = do
        [whamlet|<a href=@{tm forwardUrl}>_{Msg.LoginGoogle}|]

    dispatch :: YesodAuth site
             => Text
             -> [Text]
             -> AuthHandler site TypedContent
    dispatch :: forall site.
YesodAuth site =>
Text -> Texts -> AuthHandler site TypedContent
dispatch Text
"GET" [Text
"forward"] = do
        AuthRoute -> Route site
tm <- forall (m :: * -> *).
MonadHandler m =>
m (Route (SubHandlerSite m) -> Route (HandlerSite m))
getRouteToParent
        forall (m :: * -> *).
MonadHandler m =>
(AuthRoute -> Route (HandlerSite m)) -> m Text
getDest AuthRoute -> Route site
tm forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) url a.
(MonadHandler m, RedirectUrl (HandlerSite m) url) =>
url -> m a
redirect

    dispatch Text
"GET" [Text
"complete"] = do
        Maybe Text
mstate <- forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupGetParam Text
"state"
        case Maybe Text
mstate of
            Maybe Text
Nothing -> forall (m :: * -> *) a. MonadHandler m => Texts -> m a
invalidArgs [Text
"CSRF state from Google is missing"]
            Just Text
state -> do
                Maybe Text
mtoken <- forall (m :: * -> *). MonadHandler m => m (Maybe Text)
getCsrfToken
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. a -> Maybe a
Just Text
state forall a. Eq a => a -> a -> Bool
== Maybe Text
mtoken) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadHandler m => Texts -> m a
invalidArgs [Text
"Invalid CSRF token from Google"]
        Maybe Text
mcode <- forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupGetParam Text
"code"
        Text
code <-
            case Maybe Text
mcode of
                Maybe Text
Nothing -> do
                    Maybe Text
merr <- forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupGetParam Text
"error"
                    case Maybe Text
merr of
                        Maybe Text
Nothing -> forall (m :: * -> *) a. MonadHandler m => Texts -> m a
invalidArgs [Text
"Missing code paramter"]
                        Just Text
err -> do
                            site
master <- forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
getYesod
                            let msg :: Text
msg =
                                    case Text
err of
                                        Text
"access_denied" -> Text
"Access denied"
                                        Text
_ -> Text
"Unknown error occurred: " Text -> Text -> Text
`T.append` Text
err
                            forall (m :: * -> *). MonadHandler m => Text -> Markup -> m ()
addMessage Text
"error" forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Markup
toHtml Text
msg
                            forall (m :: * -> *) url a.
(MonadHandler m, RedirectUrl (HandlerSite m) url) =>
url -> m a
redirect forall a b. (a -> b) -> a -> b
$ forall master. YesodAuth master => master -> Route master
logoutDest site
master
                Just Text
c -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
c

        Route site -> Text
render <- forall (m :: * -> *).
MonadHandler m =>
m (Route (HandlerSite m) -> Text)
getUrlRender
        AuthRoute -> Route site
tm <- forall (m :: * -> *).
MonadHandler m =>
m (Route (SubHandlerSite m) -> Route (HandlerSite m))
getRouteToParent

        Request
req' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *). MonadThrow m => String -> m Request
HTTP.parseUrlThrow
            String
"https://accounts.google.com/o/oauth2/token" -- FIXME don't hardcode, use: https://accounts.google.com/.well-known/openid-configuration
        let req :: Request
req =
                [(ByteString, ByteString)] -> Request -> Request
urlEncodedBody
                    [ (ByteString
"code", Text -> ByteString
encodeUtf8 Text
code)
                    , (ByteString
"client_id", Text -> ByteString
encodeUtf8 Text
clientID)
                    , (ByteString
"client_secret", Text -> ByteString
encodeUtf8 Text
clientSecret)
                    , (ByteString
"redirect_uri", Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ Route site -> Text
render forall a b. (a -> b) -> a -> b
$ AuthRoute -> Route site
tm AuthRoute
complete)
                    , (ByteString
"grant_type", ByteString
"authorization_code")
                    ]
                    Request
req'
                        { requestHeaders :: RequestHeaders
requestHeaders = []
                        }
        Value
value <- forall site. Request -> AuthHandler site Value
makeHttpRequest Request
req
        token :: Token
token@(Token Text
accessToken' Text
tokenType') <-
            case forall a b. (a -> Parser b) -> a -> Either String b
parseEither forall a. FromJSON a => Value -> Parser a
parseJSON Value
value of
                Left String
e  -> forall a. HasCallStack => String -> a
error String
e
                Right Token
t -> forall (m :: * -> *) a. Monad m => a -> m a
return Token
t

        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text
tokenType' forall a. Eq a => a -> a -> Bool
== Text
"Bearer") forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Unknown token type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
tokenType'

        -- User's access token is saved for further access to API
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
storeToken forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadHandler m => Text -> Text -> m ()
setSession Text
accessTokenKey Text
accessToken'

        Request
personValReq <- forall (m :: * -> *). MonadIO m => Token -> m Request
personValueRequest Token
token
        Value
personValue <- forall site. Request -> AuthHandler site Value
makeHttpRequest Request
personValReq

        Person
person <- case forall a b. (a -> Parser b) -> a -> Either String b
parseEither forall a. FromJSON a => Value -> Parser a
parseJSON Value
personValue of
                Left String
e  -> forall a. HasCallStack => String -> a
error String
e
                Right Person
x -> forall (m :: * -> *) a. Monad m => a -> m a
return Person
x

        Text
email <-
            case forall a b. (a -> b) -> [a] -> [b]
map Email -> Text
emailValue forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (\Email
e -> Email -> EmailType
emailType Email
e forall a. Eq a => a -> a -> Bool
== EmailType
EmailAccount) forall a b. (a -> b) -> a -> b
$ Person -> [Email]
personEmails Person
person of
                [Text
e] -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
e
                []  -> forall a. HasCallStack => String -> a
error String
"No account email"
                Texts
x   -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Too many account emails: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Texts
x
        forall (m :: * -> *).
(MonadHandler m, YesodAuth (HandlerSite m)) =>
Creds (HandlerSite m) -> m TypedContent
setCredsRedirect forall a b. (a -> b) -> a -> b
$ forall master. Text -> Text -> [(Text, Text)] -> Creds master
Creds Text
pid Text
email forall a b. (a -> b) -> a -> b
$ Value -> [(Text, Text)]
allPersonInfo Value
personValue

    dispatch Text
_ Texts
_ = forall (m :: * -> *) a. MonadHandler m => m a
notFound

makeHttpRequest :: Request -> AuthHandler site A.Value
makeHttpRequest :: forall site. Request -> AuthHandler site Value
makeHttpRequest Request
req =
    forall (m :: * -> *) a.
MonadHandler m =>
SubHandlerFor (SubHandlerSite m) (HandlerSite m) a -> m a
liftSubHandler forall a b. (a -> b) -> a -> b
$ forall master (m :: * -> *) a.
(YesodAuth master, MonadHandler m, HandlerSite m ~ master,
 MonadUnliftIO m) =>
Request -> (Response BodyReader -> m a) -> m a
runHttpRequest Request
req forall a b. (a -> b) -> a -> b
$ \Response BodyReader
res ->
    forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) i.
MonadIO m =>
BodyReader -> ConduitM i ByteString m ()
bodyReaderSource (forall body. Response body -> body
responseBody Response BodyReader
res) forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall a (m :: * -> *) b o.
(AttoparsecInput a, MonadThrow m) =>
Parser a b -> ConduitT a o m b
sinkParser Parser Value
json'

-- | Allows to fetch information about a user from Google's API.
--   In case of parsing error returns 'Nothing'.
--   Will throw 'HttpException' in case of network problems or error response code.
--
-- @since 1.4.3
getPerson :: MonadHandler m => Manager -> Token -> m (Maybe Person)
getPerson :: forall (m :: * -> *).
MonadHandler m =>
Manager -> Token -> m (Maybe Person)
getPerson Manager
manager Token
token = forall (m :: * -> *) a.
MonadHandler m =>
SubHandlerFor (SubHandlerSite m) (HandlerSite m) a -> m a
liftSubHandler forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe forall a. FromJSON a => Value -> Parser a
parseJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (do
    Request
req <- forall (m :: * -> *). MonadIO m => Token -> m Request
personValueRequest Token
token
    Response
  (ConduitM
     ()
     ByteString
     (SubHandlerFor (SubHandlerSite m) (HandlerSite m))
     ())
res <- forall (m :: * -> *) i.
MonadResource m =>
Request -> Manager -> m (Response (ConduitM i ByteString m ()))
http Request
req Manager
manager
    forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit forall a b. (a -> b) -> a -> b
$ forall body. Response body -> body
responseBody Response
  (ConduitM
     ()
     ByteString
     (SubHandlerFor (SubHandlerSite m) (HandlerSite m))
     ())
res forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall a (m :: * -> *) b o.
(AttoparsecInput a, MonadThrow m) =>
Parser a b -> ConduitT a o m b
sinkParser Parser Value
json'
  )

personValueRequest :: MonadIO m => Token -> m Request
personValueRequest :: forall (m :: * -> *). MonadIO m => Token -> m Request
personValueRequest Token
token = do
    Request
req2' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
           forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadThrow m => String -> m Request
HTTP.parseUrlThrow String
"https://www.googleapis.com/plus/v1/people/me"
    forall (m :: * -> *) a. Monad m => a -> m a
return Request
req2'
            { requestHeaders :: RequestHeaders
requestHeaders =
                [ (HeaderName
"Authorization", Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ Text
"Bearer " forall a. Monoid a => a -> a -> a
`mappend` Token -> Text
accessToken Token
token)
                ]
            }

--------------------------------------------------------------------------------
-- | An authentication token which was acquired from OAuth callback.
--   The token gets saved into the session storage only if you use
--   'authGoogleEmailSaveToken'.
--   You can acquire saved token with 'getUserAccessToken'.
--
-- @since 1.4.3
data Token = Token { Token -> Text
accessToken :: Text
                   , Token -> Text
tokenType   :: Text
                   } deriving (Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show, Token -> Token -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c== :: Token -> Token -> Bool
Eq)

instance FromJSON Token where
    parseJSON :: Value -> Parser Token
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Tokens" forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Text -> Token
Token
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Control.Applicative.<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"access_token"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Control.Applicative.<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"token_type"

--------------------------------------------------------------------------------
-- | Gender of the person
--
-- @since 1.4.3
data Gender = Male | Female | OtherGender deriving (Int -> Gender -> ShowS
[Gender] -> ShowS
Gender -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Gender] -> ShowS
$cshowList :: [Gender] -> ShowS
show :: Gender -> String
$cshow :: Gender -> String
showsPrec :: Int -> Gender -> ShowS
$cshowsPrec :: Int -> Gender -> ShowS
Show, Gender -> Gender -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Gender -> Gender -> Bool
$c/= :: Gender -> Gender -> Bool
== :: Gender -> Gender -> Bool
$c== :: Gender -> Gender -> Bool
Eq)

instance FromJSON Gender where
    parseJSON :: Value -> Parser Gender
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Gender" forall a b. (a -> b) -> a -> b
$ \Text
t -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Text
t of
                                                Text
"male"   -> Gender
Male
                                                Text
"female" -> Gender
Female
                                                Text
_        -> Gender
OtherGender

--------------------------------------------------------------------------------
-- | URIs specified in the person's profile
--
-- @since 1.4.3
data PersonURI =
    PersonURI { PersonURI -> Maybe Text
uriLabel :: Maybe Text
              , PersonURI -> Maybe Text
uriValue :: Maybe Text
              , PersonURI -> Maybe PersonURIType
uriType  :: Maybe PersonURIType
              } deriving (Int -> PersonURI -> ShowS
[PersonURI] -> ShowS
PersonURI -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PersonURI] -> ShowS
$cshowList :: [PersonURI] -> ShowS
show :: PersonURI -> String
$cshow :: PersonURI -> String
showsPrec :: Int -> PersonURI -> ShowS
$cshowsPrec :: Int -> PersonURI -> ShowS
Show, PersonURI -> PersonURI -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PersonURI -> PersonURI -> Bool
$c/= :: PersonURI -> PersonURI -> Bool
== :: PersonURI -> PersonURI -> Bool
$c== :: PersonURI -> PersonURI -> Bool
Eq)

instance FromJSON PersonURI where
    parseJSON :: Value -> Parser PersonURI
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PersonURI" forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe Text -> Maybe Text -> Maybe PersonURIType -> PersonURI
PersonURI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"label"
                                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"value"
                                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"type"

--------------------------------------------------------------------------------
-- | The type of URI
--
-- @since 1.4.3
data PersonURIType = OtherProfile       -- ^ URI for another profile
                   | Contributor        -- ^ URI to a site for which this person is a contributor
                   | Website            -- ^ URI for this Google+ Page's primary website
                   | OtherURI           -- ^ Other URL
                   | PersonURIType Text -- ^ Something else
                   deriving (Int -> PersonURIType -> ShowS
[PersonURIType] -> ShowS
PersonURIType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PersonURIType] -> ShowS
$cshowList :: [PersonURIType] -> ShowS
show :: PersonURIType -> String
$cshow :: PersonURIType -> String
showsPrec :: Int -> PersonURIType -> ShowS
$cshowsPrec :: Int -> PersonURIType -> ShowS
Show, PersonURIType -> PersonURIType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PersonURIType -> PersonURIType -> Bool
$c/= :: PersonURIType -> PersonURIType -> Bool
== :: PersonURIType -> PersonURIType -> Bool
$c== :: PersonURIType -> PersonURIType -> Bool
Eq)

instance FromJSON PersonURIType where
    parseJSON :: Value -> Parser PersonURIType
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"PersonURIType" forall a b. (a -> b) -> a -> b
$ \Text
t -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Text
t of
            Text
"otherProfile" -> PersonURIType
OtherProfile
            Text
"contributor"  -> PersonURIType
Contributor
            Text
"website"      -> PersonURIType
Website
            Text
"other"        -> PersonURIType
OtherURI
            Text
_              -> Text -> PersonURIType
PersonURIType Text
t

--------------------------------------------------------------------------------
-- | Current or past organizations with which this person is associated
--
-- @since 1.4.3
data Organization =
    Organization { Organization -> Maybe Text
orgName      :: Maybe Text
                   -- ^ The person's job title or role within the organization
                 , Organization -> Maybe Text
orgTitle     :: Maybe Text
                 , Organization -> Maybe OrganizationType
orgType      :: Maybe OrganizationType
                   -- ^ The date that the person joined this organization.
                 , Organization -> Maybe Text
orgStartDate :: Maybe Text
                   -- ^ The date that the person left this organization.
                 , Organization -> Maybe Text
orgEndDate   :: Maybe Text
                   -- ^ If @True@, indicates this organization is the person's
                   -- ^ primary one, which is typically interpreted as the current one.
                 , Organization -> Maybe Bool
orgPrimary   :: Maybe Bool
                 } deriving (Int -> Organization -> ShowS
[Organization] -> ShowS
Organization -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Organization] -> ShowS
$cshowList :: [Organization] -> ShowS
show :: Organization -> String
$cshow :: Organization -> String
showsPrec :: Int -> Organization -> ShowS
$cshowsPrec :: Int -> Organization -> ShowS
Show, Organization -> Organization -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Organization -> Organization -> Bool
$c/= :: Organization -> Organization -> Bool
== :: Organization -> Organization -> Bool
$c== :: Organization -> Organization -> Bool
Eq)

instance FromJSON Organization where
    parseJSON :: Value -> Parser Organization
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Organization" forall a b. (a -> b) -> a -> b
$ \Object
o ->
        Maybe Text
-> Maybe Text
-> Maybe OrganizationType
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Organization
Organization forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name"
                     forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title"
                     forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"type"
                     forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"startDate"
                     forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"endDate"
                     forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"primary"

--------------------------------------------------------------------------------
-- | The type of an organization
--
-- @since 1.4.3
data OrganizationType = Work
                      | School
                      | OrganizationType Text -- ^ Something else
                      deriving (Int -> OrganizationType -> ShowS
[OrganizationType] -> ShowS
OrganizationType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrganizationType] -> ShowS
$cshowList :: [OrganizationType] -> ShowS
show :: OrganizationType -> String
$cshow :: OrganizationType -> String
showsPrec :: Int -> OrganizationType -> ShowS
$cshowsPrec :: Int -> OrganizationType -> ShowS
Show, OrganizationType -> OrganizationType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrganizationType -> OrganizationType -> Bool
$c/= :: OrganizationType -> OrganizationType -> Bool
== :: OrganizationType -> OrganizationType -> Bool
$c== :: OrganizationType -> OrganizationType -> Bool
Eq)
instance FromJSON OrganizationType where
    parseJSON :: Value -> Parser OrganizationType
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"OrganizationType" forall a b. (a -> b) -> a -> b
$ \Text
t -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Text
t of
                                                Text
"work"   -> OrganizationType
Work
                                                Text
"school" -> OrganizationType
School
                                                Text
_        -> Text -> OrganizationType
OrganizationType Text
t

--------------------------------------------------------------------------------
-- | A place where the person has lived or is living at the moment.
--
-- @since 1.4.3
data Place =
    Place { -- | A place where this person has lived. For example: "Seattle, WA", "Near Toronto".
            Place -> Maybe Text
placeValue   :: Maybe Text
            -- | If @True@, this place of residence is this person's primary residence.
          , Place -> Maybe Bool
placePrimary :: Maybe Bool
          } deriving (Int -> Place -> ShowS
[Place] -> ShowS
Place -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Place] -> ShowS
$cshowList :: [Place] -> ShowS
show :: Place -> String
$cshow :: Place -> String
showsPrec :: Int -> Place -> ShowS
$cshowsPrec :: Int -> Place -> ShowS
Show, Place -> Place -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Place -> Place -> Bool
$c/= :: Place -> Place -> Bool
== :: Place -> Place -> Bool
$c== :: Place -> Place -> Bool
Eq)

instance FromJSON Place where
    parseJSON :: Value -> Parser Place
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Place" forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe Text -> Maybe Bool -> Place
Place forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"value") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"primary")

--------------------------------------------------------------------------------
-- | Individual components of a name
--
-- @since 1.4.3
data Name =
    Name { -- | The full name of this person, including middle names, suffixes, etc
           Name -> Maybe Text
nameFormatted       :: Maybe Text
           -- | The family name (last name) of this person
         , Name -> Maybe Text
nameFamily          :: Maybe Text
           -- | The given name (first name) of this person
         , Name -> Maybe Text
nameGiven           :: Maybe Text
           -- | The middle name of this person.
         , Name -> Maybe Text
nameMiddle          :: Maybe Text
           -- | The honorific prefixes (such as "Dr." or "Mrs.") for this person
         , Name -> Maybe Text
nameHonorificPrefix :: Maybe Text
           -- | The honorific suffixes (such as "Jr.") for this person
         , Name -> Maybe Text
nameHonorificSuffix :: Maybe Text
         } deriving (Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> String
$cshow :: Name -> String
showsPrec :: Int -> Name -> ShowS
$cshowsPrec :: Int -> Name -> ShowS
Show, Name -> Name -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c== :: Name -> Name -> Bool
Eq)

instance FromJSON Name where
    parseJSON :: Value -> Parser Name
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Name" forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Name
Name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"formatted"
                                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"familyName"
                                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"givenName"
                                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"middleName"
                                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"honorificPrefix"
                                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"honorificSuffix"

--------------------------------------------------------------------------------
-- | The person's relationship status.
--
-- @since 1.4.3
data RelationshipStatus = Single              -- ^ Person is single
                        | InRelationship      -- ^ Person is in a relationship
                        | Engaged             -- ^ Person is engaged
                        | Married             -- ^ Person is married
                        | Complicated         -- ^ The relationship is complicated
                        | OpenRelationship    -- ^ Person is in an open relationship
                        | Widowed             -- ^ Person is widowed
                        | DomesticPartnership -- ^ Person is in a domestic partnership
                        | CivilUnion          -- ^ Person is in a civil union
                        | RelationshipStatus Text -- ^ Something else
                        deriving (Int -> RelationshipStatus -> ShowS
[RelationshipStatus] -> ShowS
RelationshipStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RelationshipStatus] -> ShowS
$cshowList :: [RelationshipStatus] -> ShowS
show :: RelationshipStatus -> String
$cshow :: RelationshipStatus -> String
showsPrec :: Int -> RelationshipStatus -> ShowS
$cshowsPrec :: Int -> RelationshipStatus -> ShowS
Show, RelationshipStatus -> RelationshipStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RelationshipStatus -> RelationshipStatus -> Bool
$c/= :: RelationshipStatus -> RelationshipStatus -> Bool
== :: RelationshipStatus -> RelationshipStatus -> Bool
$c== :: RelationshipStatus -> RelationshipStatus -> Bool
Eq)

instance FromJSON RelationshipStatus where
    parseJSON :: Value -> Parser RelationshipStatus
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"RelationshipStatus" forall a b. (a -> b) -> a -> b
$ \Text
t -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Text
t of
                  Text
"single"                  -> RelationshipStatus
Single
                  Text
"in_a_relationship"       -> RelationshipStatus
InRelationship
                  Text
"engaged"                 -> RelationshipStatus
Engaged
                  Text
"married"                 -> RelationshipStatus
Married
                  Text
"its_complicated"         -> RelationshipStatus
Complicated
                  Text
"open_relationship"       -> RelationshipStatus
OpenRelationship
                  Text
"widowed"                 -> RelationshipStatus
Widowed
                  Text
"in_domestic_partnership" -> RelationshipStatus
DomesticPartnership
                  Text
"in_civil_union"          -> RelationshipStatus
CivilUnion
                  Text
_                         -> Text -> RelationshipStatus
RelationshipStatus Text
t

--------------------------------------------------------------------------------
-- | The URI of the person's profile photo.
--
-- @since 1.4.3
newtype PersonImage = PersonImage { PersonImage -> Text
imageUri :: Text } deriving (Int -> PersonImage -> ShowS
[PersonImage] -> ShowS
PersonImage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PersonImage] -> ShowS
$cshowList :: [PersonImage] -> ShowS
show :: PersonImage -> String
$cshow :: PersonImage -> String
showsPrec :: Int -> PersonImage -> ShowS
$cshowsPrec :: Int -> PersonImage -> ShowS
Show, PersonImage -> PersonImage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PersonImage -> PersonImage -> Bool
$c/= :: PersonImage -> PersonImage -> Bool
== :: PersonImage -> PersonImage -> Bool
$c== :: PersonImage -> PersonImage -> Bool
Eq)

instance FromJSON PersonImage where
    parseJSON :: Value -> Parser PersonImage
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PersonImage" forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> PersonImage
PersonImage forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"

-- | @resizePersonImage img 30@ would set query part to @?sz=30@ which would resize
--   the image under the URI. If for some reason you need to modify the query
--   part, you should do it after resizing.
--
-- @since 1.4.3
resizePersonImage :: PersonImage -> Int -> PersonImage
resizePersonImage :: PersonImage -> Int -> PersonImage
resizePersonImage (PersonImage Text
uri) Int
size =
    Text -> PersonImage
PersonImage forall a b. (a -> b) -> a -> b
$ Text
uri forall a. Monoid a => a -> a -> a
`mappend` Text
"?sz=" forall a. Monoid a => a -> a -> a
`mappend` String -> Text
T.pack (forall a. Show a => a -> String
show Int
size)

--------------------------------------------------------------------------------
-- | Information about the user
--   Full description of the resource https://developers.google.com/+/api/latest/people
--
-- @since 1.4.3
data Person = Person
    { Person -> Text
personId                 :: Text
      -- | The name of this person, which is suitable for display
    , Person -> Maybe Text
personDisplayName        :: Maybe Text
    , Person -> Maybe Name
personName               :: Maybe Name
    , Person -> Maybe Text
personNickname           :: Maybe Text
    , Person -> Maybe Text
personBirthday           :: Maybe Text -- ^ Birthday formatted as YYYY-MM-DD
    , Person -> Maybe Gender
personGender             :: Maybe Gender
    , Person -> Maybe Text
personProfileUri         :: Maybe Text -- ^ The URI of this person's profile
    , Person -> Maybe PersonImage
personImage              :: Maybe PersonImage
    , Person -> Maybe Text
personAboutMe            :: Maybe Text -- ^ A short biography for this person
    , Person -> Maybe RelationshipStatus
personRelationshipStatus :: Maybe RelationshipStatus
    , Person -> [PersonURI]
personUris               :: [PersonURI]
    , Person -> [Organization]
personOrganizations      :: [Organization]
    , Person -> [Place]
personPlacesLived        :: [Place]
    -- | The brief description of this person
    , Person -> Maybe Text
personTagline            :: Maybe Text
    -- | Whether this user has signed up for Google+
    , Person -> Maybe Bool
personIsPlusUser         :: Maybe Bool
    -- | The "bragging rights" line of this person
    , Person -> Maybe Text
personBraggingRights     :: Maybe Text
    -- | if a Google+ page, the number of people who have +1'd this page
    , Person -> Maybe Int
personPlusOneCount       :: Maybe Int
    -- | For followers who are visible, the number of people who have added
    --   this person or page to a circle.
    , Person -> Maybe Int
personCircledByCount     :: Maybe Int
    -- | Whether the person or Google+ Page has been verified. This is used only
    --   for pages with a higher risk of being impersonated or similar. This
    --   flag will not be present on most profiles.
    , Person -> Maybe Bool
personVerified           :: Maybe Bool
    -- | The user's preferred language for rendering.
    , Person -> Maybe Text
personLanguage           :: Maybe Text
    , Person -> [Email]
personEmails             :: [Email]
    , Person -> Maybe Text
personDomain             :: Maybe Text
    , Person -> Maybe Text
personOccupation         :: Maybe Text -- ^ The occupation of this person
    , Person -> Maybe Text
personSkills             :: Maybe Text -- ^ The person's skills
    } deriving (Int -> Person -> ShowS
[Person] -> ShowS
Person -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Person] -> ShowS
$cshowList :: [Person] -> ShowS
show :: Person -> String
$cshow :: Person -> String
showsPrec :: Int -> Person -> ShowS
$cshowsPrec :: Int -> Person -> ShowS
Show, Person -> Person -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Person -> Person -> Bool
$c/= :: Person -> Person -> Bool
== :: Person -> Person -> Bool
$c== :: Person -> Person -> Bool
Eq)


instance FromJSON Person where
    parseJSON :: Value -> Parser Person
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Person" forall a b. (a -> b) -> a -> b
$ \Object
o ->
        Text
-> Maybe Text
-> Maybe Name
-> Maybe Text
-> Maybe Text
-> Maybe Gender
-> Maybe Text
-> Maybe PersonImage
-> Maybe Text
-> Maybe RelationshipStatus
-> [PersonURI]
-> [Organization]
-> [Place]
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Int
-> Maybe Int
-> Maybe Bool
-> Maybe Text
-> [Email]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Person
Person forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"id"
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"displayName"
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name"
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"nickname"
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"birthday"
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"gender"
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"image"
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"aboutMe"
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"relationshipStatus"
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((forall a. a -> Maybe a -> a
fromMaybe []) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"urls"))
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((forall a. a -> Maybe a -> a
fromMaybe []) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"organizations"))
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((forall a. a -> Maybe a -> a
fromMaybe []) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"placesLived"))
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tagline"
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"isPlusUser"
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"braggingRights"
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"plusOneCount"
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"circledByCount"
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"verified"
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"language"
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((forall a. a -> Maybe a -> a
fromMaybe []) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"emails"))
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"domain"
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"occupation"
               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"skills"

--------------------------------------------------------------------------------
-- | Person's email
--
-- @since 1.4.3
data Email = Email
    { Email -> Text
emailValue :: Text
    , Email -> EmailType
emailType  :: EmailType
    }
    deriving (Int -> Email -> ShowS
[Email] -> ShowS
Email -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Email] -> ShowS
$cshowList :: [Email] -> ShowS
show :: Email -> String
$cshow :: Email -> String
showsPrec :: Int -> Email -> ShowS
$cshowsPrec :: Int -> Email -> ShowS
Show, Email -> Email -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Email -> Email -> Bool
$c/= :: Email -> Email -> Bool
== :: Email -> Email -> Bool
$c== :: Email -> Email -> Bool
Eq)

instance FromJSON Email where
    parseJSON :: Value -> Parser Email
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Email" forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> EmailType -> Email
Email
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"

--------------------------------------------------------------------------------
-- | Type of email
--
-- @since 1.4.3
data EmailType = EmailAccount   -- ^ Google account email address
               | EmailHome      -- ^ Home email address
               | EmailWork      -- ^ Work email adress
               | EmailOther     -- ^ Other email address
               | EmailType Text -- ^ Something else
               deriving (Int -> EmailType -> ShowS
[EmailType] -> ShowS
EmailType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmailType] -> ShowS
$cshowList :: [EmailType] -> ShowS
show :: EmailType -> String
$cshow :: EmailType -> String
showsPrec :: Int -> EmailType -> ShowS
$cshowsPrec :: Int -> EmailType -> ShowS
Show, EmailType -> EmailType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmailType -> EmailType -> Bool
$c/= :: EmailType -> EmailType -> Bool
== :: EmailType -> EmailType -> Bool
$c== :: EmailType -> EmailType -> Bool
Eq)

instance FromJSON EmailType where
    parseJSON :: Value -> Parser EmailType
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"EmailType" forall a b. (a -> b) -> a -> b
$ \Text
t -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Text
t of
        Text
"account" -> EmailType
EmailAccount
        Text
"home"    -> EmailType
EmailHome
        Text
"work"    -> EmailType
EmailWork
        Text
"other"   -> EmailType
EmailOther
        Text
_         -> Text -> EmailType
EmailType Text
t

allPersonInfo :: A.Value -> [(Text, Text)]
allPersonInfo :: Value -> [(Text, Text)]
allPersonInfo (A.Object Object
o) = forall a b. (a -> b) -> [a] -> [b]
map (Key, Value) -> (Text, Text)
enc forall a b. (a -> b) -> a -> b
$ forall {v}. KeyMap v -> [(Key, v)]
mapToList Object
o
  where
    enc :: (Key, Value) -> (Text, Text)
enc (Key
key, A.String Text
s) = (Key -> Text
keyToText Key
key, Text
s)
    enc (Key
key, Value
v) = (Key -> Text
keyToText Key
key, Text -> Text
TL.toStrict forall a b. (a -> b) -> a -> b
$ Builder -> Text
TL.toLazyText forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Builder
A.encodeToTextBuilder Value
v)

#if MIN_VERSION_aeson(2, 0, 0)
    keyToText :: Key -> Text
keyToText = Key -> Text
Data.Aeson.Key.toText
    mapToList :: KeyMap v -> [(Key, v)]
mapToList = forall {v}. KeyMap v -> [(Key, v)]
Data.Aeson.KeyMap.toList
#else
    keyToText = id
    mapToList = M.toList
#endif

allPersonInfo Value
_ = []


-- See https://github.com/yesodweb/yesod/issues/1245 for discussion on this
-- use of unsafePerformIO.
defaultNonceGen :: Nonce.Generator
defaultNonceGen :: Generator
defaultNonceGen = forall a. IO a -> a
unsafePerformIO (forall (m :: * -> *). MonadIO m => m Generator
Nonce.new)
{-# NOINLINE defaultNonceGen #-}