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

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

import Telegram.Bot.API.Internal.Utils

-- ** 'ChatPermissions'

-- | Describes actions that a non-administrator user is allowed to take in a chat.
data ChatPermissions = ChatPermissions
  { ChatPermissions -> Maybe Bool
chatPermissionsCanSendMessages :: Maybe Bool       -- ^ 'True', if the user is allowed to send text messages, contacts, locations and venues.
  , ChatPermissions -> Maybe Bool
chatPermissionsCanSendAudios     :: Maybe Bool     -- ^ 'True', if the user is allowed to send audios.
  , ChatPermissions -> Maybe Bool
chatPermissionsCanSendDocuments  :: Maybe Bool     -- ^ 'True', if the user is allowed to send documents.
  , ChatPermissions -> Maybe Bool
chatPermissionsCanSendPhotos     :: Maybe Bool     -- ^ 'True', if the user is allowed to send photos.
  , ChatPermissions -> Maybe Bool
chatPermissionsCanSendVideos     :: Maybe Bool     -- ^ 'True', if the user is allowed to send videos.
  , ChatPermissions -> Maybe Bool
chatPermissionsCanSendVideoNotes :: Maybe Bool     -- ^ 'True', if the user is allowed to send video notes.
  , ChatPermissions -> Maybe Bool
chatPermissionsCanSendVoiceNotes :: Maybe Bool     -- ^ 'True', if the user is allowed to send voice notes.
  , ChatPermissions -> Maybe Bool
chatPermissionsCanSendPolls :: Maybe Bool          -- ^ 'True', if the user is allowed to send polls, implies can_send_messages.
  , ChatPermissions -> Maybe Bool
chatPermissionsCanSendOtherMessages :: Maybe Bool  -- ^ 'True', if the user is allowed to send animations, games, stickers and use inline bots, implies can_send_media_messages.
  , ChatPermissions -> Maybe Bool
chatPermissionsCanAddWebPagePreviews :: Maybe Bool -- ^ 'True', if the user is allowed to add web page previews to their messages, implies can_send_media_messages.
  , ChatPermissions -> Maybe Bool
chatPermissionsCanChangeInfo :: Maybe Bool         -- ^ 'True', if the user is allowed to change the chat title, photo and other settings. Ignored in public supergroups
  , ChatPermissions -> Maybe Bool
chatPermissionsCanInviteUsers :: Maybe Bool        -- ^ 'True', if the user is allowed to invite new users to the chat.
  , ChatPermissions -> Maybe Bool
chatPermissionsCanPinMessages :: Maybe Bool        -- ^ 'True', if the user is allowed to pin messages. Ignored in public supergroups.
  , ChatPermissions -> Maybe Bool
chatPermissionsCanManageTopics :: Maybe Bool       -- ^ 'True', if the user is allowed to create forum topics. If omitted defaults to the value of can_pin_messages.
  }
  deriving (forall x. Rep ChatPermissions x -> ChatPermissions
forall x. ChatPermissions -> Rep ChatPermissions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChatPermissions x -> ChatPermissions
$cfrom :: forall x. ChatPermissions -> Rep ChatPermissions x
Generic, Int -> ChatPermissions -> ShowS
[ChatPermissions] -> ShowS
ChatPermissions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChatPermissions] -> ShowS
$cshowList :: [ChatPermissions] -> ShowS
show :: ChatPermissions -> String
$cshow :: ChatPermissions -> String
showsPrec :: Int -> ChatPermissions -> ShowS
$cshowsPrec :: Int -> ChatPermissions -> ShowS
Show)

instance ToJSON   ChatPermissions where toJSON :: ChatPermissions -> 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 ChatPermissions where parseJSON :: Value -> Parser ChatPermissions
parseJSON = forall a (d :: Meta) (f :: * -> *).
(Generic a, GFromJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
Value -> Parser a
gparseJSON