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

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

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

-- ** 'UserShared'

-- | This object contains information about the user whose identifier was shared with the bot using a 'KeyboardButtonRequestUser' button.
data UserShared = UserShared
  { UserShared -> RequestId
userSharedRequestId :: RequestId -- ^ Identifier of the request.
  , UserShared -> UserId
userSharedUserId :: 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 a 64-bit integer or double-precision float type are safe for storing this identifier. 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.
  }
  deriving ((forall x. UserShared -> Rep UserShared x)
-> (forall x. Rep UserShared x -> UserShared) -> Generic UserShared
forall x. Rep UserShared x -> UserShared
forall x. UserShared -> Rep UserShared x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UserShared -> Rep UserShared x
from :: forall x. UserShared -> Rep UserShared x
$cto :: forall x. Rep UserShared x -> UserShared
to :: forall x. Rep UserShared x -> UserShared
Generic, Int -> UserShared -> ShowS
[UserShared] -> ShowS
UserShared -> String
(Int -> UserShared -> ShowS)
-> (UserShared -> String)
-> ([UserShared] -> ShowS)
-> Show UserShared
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserShared -> ShowS
showsPrec :: Int -> UserShared -> ShowS
$cshow :: UserShared -> String
show :: UserShared -> String
$cshowList :: [UserShared] -> ShowS
showList :: [UserShared] -> ShowS
Show)

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