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

import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Text (Text)
import Data.Time.Clock.POSIX (POSIXTime)
import GHC.Generics (Generic)

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

-- ** 'ChatMember'

-- | This object contains information about one member of a chat.
data ChatMember = ChatMember
  { ChatMember -> User
chatMemberUser                  :: User -- ^ Information about the user
  , ChatMember -> Text
chatMemberStatus                :: Text -- ^ The member's status in the chat. Can be “owner”, “administrator”, “member”, “restricted”, “left” or “banned”.

  -- banned, restricted
  , ChatMember -> Maybe POSIXTime
chatMemberUntilDate             :: Maybe POSIXTime -- ^ Restictred and banned only. Date when restrictions will be lifted for this user, unix time.

  -- owner, administrator
  , ChatMember -> Maybe Bool
chatMemberIsAnonymous           :: Maybe Bool -- ^ Owners and administrators only. 'True', if the user's presence in the chat is hidden.
  , ChatMember -> Maybe Text
chatMemberCustomTitle           :: Maybe Text -- ^ Owners and administrators only. Custom title for this user.

  -- administrator
  , ChatMember -> Maybe Bool
chatMemberCanBeEdited           :: Maybe Bool -- ^ Administrators only. 'True', if the bot is allowed to edit administrator privileges of that user
  , ChatMember -> Maybe Bool
chatMemberCanManageChat         :: Maybe Bool -- ^ Administrators only. 'True', if the administrator can access the chat event log, chat statistics, message statistics in channels, see channel members, see anonymous administrators in supergroups and ignore slow mode. Implied by any other administrator privilege.
  , ChatMember -> Maybe Bool
chatMemberCanDeleteMessages     :: Maybe Bool -- ^ Administrators only. 'True', if the administrator can delete messages of other users.
  , ChatMember -> Maybe Bool
chatMemberCanManageVideoChats   :: Maybe Bool -- ^ Administrators only. 'True', if the administrator can manage video (previously, voice) chats.
  , ChatMember -> Maybe Bool
chatMemberCanRestrictMembers    :: Maybe Bool -- ^ Administrators only. 'True', if the administrator can restrict, ban or unban chat members.
  , ChatMember -> Maybe Bool
chatMemberCanPromoteMembers     :: Maybe Bool -- ^ Administrators only. 'True', if the administrator can add new administrators with a subset of his own privileges or demote administrators that he has promoted, directly or indirectly (promoted by administrators that were appointed by the user).
  , ChatMember -> Maybe Bool
chatMemberCanChangeInfo         :: Maybe Bool -- ^ Administrators only. 'True', if the administrator can change the chat title, photo and other settings.
  , ChatMember -> Maybe Bool
chatMemberCanPostMessages       :: Maybe Bool -- ^ Administrators only. 'True', if the administrator can post in the channel, channels only.
  , ChatMember -> Maybe Bool
chatMemberCanEditMessages       :: Maybe Bool -- ^ Administrators only. 'True', if the administrator can edit messages of other users and can pin messages, channels only.

  -- administrator, restricted
  , ChatMember -> Maybe Bool
chatMemberCanInviteUsers        :: Maybe Bool -- ^ Administrators and restricted only. 'True', if the administrator can invite new users to the chat.
  , ChatMember -> Maybe Bool
chatMemberCanPinMessages        :: Maybe Bool -- ^ Administrators and restricted only. 'True', if the administrator can pin messages, supergroups only.
  , ChatMember -> Maybe Bool
chatMemberCanManageTopics       :: Maybe Bool -- ^ Administrators and restricted only. 'True', if the user is allowed to create, rename, close, and reopen forum topics; supergroups only.

  -- restricted
  , ChatMember -> Maybe Bool
chatMemberIsMember              :: Maybe Bool -- ^ Restricted only. 'True', if the user is a member of the chat at the moment of the request.
  , ChatMember -> Maybe Bool
chatMemberCanSendMessages       :: Maybe Bool -- ^ Restricted only. 'True', if the user can send text messages, contacts, locations and venues.
  , ChatMember -> Maybe Bool
chatMemberCanSendAudios         :: Maybe Bool -- ^ Restricted only. 'True', if the user is allowed to send audios.
  , ChatMember -> Maybe Bool
chatMemberCanSendDocuments      :: Maybe Bool -- ^ Restricted only. 'True', if the user is allowed to send documents.
  , ChatMember -> Maybe Bool
chatMemberCanSendPhotos         :: Maybe Bool -- ^ Restricted only. 'True', if the user is allowed to send photos.
  , ChatMember -> Maybe Bool
chatMemberCanSendVideos         :: Maybe Bool -- ^ Restricted only. 'True', if the user is allowed to send videos.
  , ChatMember -> Maybe Bool
chatMemberCanSendVideoNotes     :: Maybe Bool -- ^ Restricted only. 'True', if the user is allowed to send video notes.
  , ChatMember -> Maybe Bool
chatMemberCanSendVoiceNotes     :: Maybe Bool -- ^ Restricted only. 'True', if the user is allowed to send voice notes.
  , ChatMember -> Maybe Bool
chatMemberCanSendPolls          :: Maybe Bool -- ^ Restricted only. 'True', if the user is allowed to send polls.
  , ChatMember -> Maybe Bool
chatMemberCanSendOtherMessages  :: Maybe Bool -- ^ Restricted only. 'True', if the user can send animations, games, stickers and use inline bots, implies can_send_media_messages.
  , ChatMember -> Maybe Bool
chatMemberCanAddWebPagePreviews :: Maybe Bool -- ^ Restricted only. 'True', if user may add web page previews to his messages, implies can_send_media_messages.
  }
  deriving (forall x. Rep ChatMember x -> ChatMember
forall x. ChatMember -> Rep ChatMember x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChatMember x -> ChatMember
$cfrom :: forall x. ChatMember -> Rep ChatMember x
Generic, Int -> ChatMember -> ShowS
[ChatMember] -> ShowS
ChatMember -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChatMember] -> ShowS
$cshowList :: [ChatMember] -> ShowS
show :: ChatMember -> String
$cshow :: ChatMember -> String
showsPrec :: Int -> ChatMember -> ShowS
$cshowsPrec :: Int -> ChatMember -> ShowS
Show)

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