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

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

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

-- ** 'UsersShared'

-- | This object contains information about the users whose identifiers were shared with the bot using a 'KeyboardButtonRequestUsers' button.
data UsersShared = UsersShared
  { UsersShared -> RequestId
usersSharedRequestId :: RequestId -- ^ Identifier of the request.
  , UsersShared -> [UserId]
usersSharedUserId :: [UserId] -- ^ Identifiers of the shared users. These numbers may have more than 32 significant bits and some programming languages may have difficulty/silent defects in interpreting them. But they have 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 users and could be unable to use these identifiers, unless the users are already known to the bot by some other means.
  }
  deriving ((forall x. UsersShared -> Rep UsersShared x)
-> (forall x. Rep UsersShared x -> UsersShared)
-> Generic UsersShared
forall x. Rep UsersShared x -> UsersShared
forall x. UsersShared -> Rep UsersShared x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UsersShared -> Rep UsersShared x
from :: forall x. UsersShared -> Rep UsersShared x
$cto :: forall x. Rep UsersShared x -> UsersShared
to :: forall x. Rep UsersShared x -> UsersShared
Generic, Int -> UsersShared -> ShowS
[UsersShared] -> ShowS
UsersShared -> String
(Int -> UsersShared -> ShowS)
-> (UsersShared -> String)
-> ([UsersShared] -> ShowS)
-> Show UsersShared
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UsersShared -> ShowS
showsPrec :: Int -> UsersShared -> ShowS
$cshow :: UsersShared -> String
show :: UsersShared -> String
$cshowList :: [UsersShared] -> ShowS
showList :: [UsersShared] -> ShowS
Show)

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