{-# LANGUAGE DeriveGeneric #-}
module Telegram.Bot.API.Types.SharedUser where

import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Text (Text)
import GHC.Generics (Generic)

import Telegram.Bot.API.Types.Common
import Telegram.Bot.API.Types.PhotoSize
import Telegram.Bot.API.Internal.Utils

-- ** 'SharedUser'

-- | This object contains information about a user that was shared with the bot using a 'KeyboardButtonRequestUsers' button.
data SharedUser = SharedUser
  { SharedUser -> UserId
sharedUserUserId :: UserId -- ^ Identifier of the shared user. This number may have more than 32 significant bits and some programming languages may have difficulty\/silent defects in interpreting it. But it has at most 52 significant bits, so 64-bit integers or double-precision float types are safe for storing these identifiers. The bot may not have access to the user and could be unable to use this identifier, unless the user is already known to the bot by some other means.
  , SharedUser -> Maybe Text
sharedUserFirstName :: Maybe Text -- ^ First name of the user, if the name was requested by the bot.
  , SharedUser -> Maybe Text
sharedUserLastName :: Maybe Text -- ^ Last name of the user, if the name was requested by the bot.
  , SharedUser -> Maybe Text
sharedUserUsername :: Maybe Text -- ^ Username of the user, if the username was requested by the bot.
  , SharedUser -> Maybe [PhotoSize]
sharedUserPhoto :: Maybe [PhotoSize] -- ^ Available sizes of the chat photo, if the photo was requested by the bot.3
  }
  deriving ((forall x. SharedUser -> Rep SharedUser x)
-> (forall x. Rep SharedUser x -> SharedUser) -> Generic SharedUser
forall x. Rep SharedUser x -> SharedUser
forall x. SharedUser -> Rep SharedUser x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SharedUser -> Rep SharedUser x
from :: forall x. SharedUser -> Rep SharedUser x
$cto :: forall x. Rep SharedUser x -> SharedUser
to :: forall x. Rep SharedUser x -> SharedUser
Generic, Int -> SharedUser -> ShowS
[SharedUser] -> ShowS
SharedUser -> String
(Int -> SharedUser -> ShowS)
-> (SharedUser -> String)
-> ([SharedUser] -> ShowS)
-> Show SharedUser
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SharedUser -> ShowS
showsPrec :: Int -> SharedUser -> ShowS
$cshow :: SharedUser -> String
show :: SharedUser -> String
$cshowList :: [SharedUser] -> ShowS
showList :: [SharedUser] -> ShowS
Show)

instance ToJSON   SharedUser where toJSON :: SharedUser -> Value
toJSON = SharedUser -> Value
forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON
instance FromJSON SharedUser where parseJSON :: Value -> Parser SharedUser
parseJSON = Value -> Parser SharedUser
forall a (d :: Meta) (f :: * -> *).
(Generic a, GFromJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
Value -> Parser a
gparseJSON