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

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

import Telegram.Bot.API.Types.ChatLocation
import Telegram.Bot.API.Types.ChatPhoto
import Telegram.Bot.API.Types.ChatPermissions
import Telegram.Bot.API.Types.Common
import Telegram.Bot.API.Types.Message
import Telegram.Bot.API.Internal.Utils

-- ** Chat

-- | This object represents a chat.
--
-- <https://core.telegram.org/bots/api#chat>
data Chat = Chat
  { Chat -> ChatId
chatId               :: ChatId          -- ^ Unique identifier for this chat. This number may be greater than 32 bits and some programming languages may have difficulty/silent defects in interpreting it. But it is smaller than 52 bits, so a signed 64 bit integer or double-precision float type are safe for storing this identifier.
  , Chat -> ChatType
chatType             :: ChatType        -- ^ Type of chat.
  , Chat -> Maybe Text
chatTitle            :: Maybe Text      -- ^ Title, for supergroups, channels and group chats
  , Chat -> Maybe Text
chatUsername         :: Maybe Text      -- ^ Username, for private chats, supergroups and channels if available
  , Chat -> Maybe Text
chatFirstName        :: Maybe Text      -- ^ First name of the other party in a private chat
  , Chat -> Maybe Text
chatLastName         :: Maybe Text      -- ^ Last name of the other party in a private chat
  , Chat -> Maybe Bool
chatIsForum          :: Maybe Bool      -- ^ 'True', if the supergroup chat is a forum (has topics enabled).
  , Chat -> Maybe ChatPhoto
chatPhoto            :: Maybe ChatPhoto -- ^ Chat photo. Returned only in getChat.
  , Chat -> Maybe Text
chatActiveUsernames  :: Maybe Text      -- ^ If non-empty, the list of all active chat usernames; for private chats, supergroups and channels. Returned only in 'getChat'.
  , Chat -> Maybe Text
chatEmojiStatusCustomEmojiId :: Maybe Text -- ^ Custom emoji identifier of emoji status of the other party in a private chat. Returned only in 'getChat'.
  , Chat -> Maybe Text
chatBio              :: Maybe Text      -- ^ Bio of the other party in a private chat. Returned only in `getChat`.
  , Chat -> Maybe Bool
chatHasPrivateForwards :: Maybe Bool    -- ^ 'True', if privacy settings of the other party in the private chat allows to use `tg://user?id=<user_id>` links only in chats with the user. Returned only in getChat.
  , Chat -> Maybe Bool
chatHasRestrictedVoiceAndVideoMessages :: Maybe Bool -- ^ 'True', if the privacy settings of the other party restrict sending voice and video note messages in the private chat. Returned only in 'getChat'.
  , Chat -> Maybe Bool
chatJoinToSendMessages :: Maybe Bool    -- ^ 'True', if users need to join the supergroup before they can send messages. Returned only in 'getChat'.
  , Chat -> Maybe Bool
chatJoinByRequest    :: Maybe Bool      -- ^ 'True', if all users directly joining the supergroup need to be approved by supergroup administrators. Returned only in 'getChat'.
  , Chat -> Maybe Text
chatDescription      :: Maybe Text      -- ^ Description, for supergroups and channel chats. Returned only in getChat.
  , Chat -> Maybe Text
chatInviteLink       :: Maybe Text      -- ^ Chat invite link, for supergroups and channel chats. Returned only in getChat.
  , Chat -> Maybe Message
chatPinnedMessage    :: Maybe Message   -- ^ Pinned message, for supergroups. Returned only in getChat.
  , Chat -> Maybe ChatPermissions
chatPermissions      :: Maybe ChatPermissions -- ^ Default chat member permissions, for groups and supergroups.
  , Chat -> Maybe Int
chatSlowModeDelay    :: Maybe Int       -- ^ For supergroups, the minimum allowed delay between consecutive messages sent by each unpriviledged user; in seconds.
  , Chat -> Maybe POSIXTime
chatMessageAutoDeleteTime :: Maybe POSIXTime -- ^ The time after which all messages sent to the chat will be automatically deleted; in seconds.
  , Chat -> Maybe Bool
chatHasProtectedContent :: Maybe Bool   -- ^ 'True', if messages from the chat can't be forwarded to other chats.
  , Chat -> Maybe Text
chatStickerSetName   :: Maybe Text      -- ^ For supergroups, name of group sticker set. Returned only in getChat.
  , Chat -> Maybe Bool
chatCanSetStickerSet :: Maybe Bool      -- ^ True, if the bot can change the group sticker set. Returned only in `getChat`.
  , Chat -> Maybe ChatId
chatLinkedChatId     :: Maybe ChatId    -- ^ Unique identifier for the linked chat, i.e. the discussion group identifier for a channel and vice versa; for supergroups and channel chats. This identifier may be greater than 32 bits and some programming languages may have difficulty/silent defects in interpreting it. But it is smaller than 52 bits, so a signed 64 bit integer or double-precision float type are safe for storing this identifier.
  , Chat -> Maybe ChatLocation
chatLocation         :: Maybe ChatLocation -- ^ For supergroups, the location to which the supergroup is connected. Returned only in getChat.
  }
  deriving (forall x. Rep Chat x -> Chat
forall x. Chat -> Rep Chat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Chat x -> Chat
$cfrom :: forall x. Chat -> Rep Chat x
Generic, Int -> Chat -> ShowS
[Chat] -> ShowS
Chat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Chat] -> ShowS
$cshowList :: [Chat] -> ShowS
show :: Chat -> String
$cshow :: Chat -> String
showsPrec :: Int -> Chat -> ShowS
$cshowsPrec :: Int -> Chat -> ShowS
Show)

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

-- | Type of chat.
data ChatType
  = ChatTypePrivate
  | ChatTypeGroup
  | ChatTypeSupergroup
  | ChatTypeChannel
  deriving (forall x. Rep ChatType x -> ChatType
forall x. ChatType -> Rep ChatType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChatType x -> ChatType
$cfrom :: forall x. ChatType -> Rep ChatType x
Generic, Int -> ChatType -> ShowS
[ChatType] -> ShowS
ChatType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChatType] -> ShowS
$cshowList :: [ChatType] -> ShowS
show :: ChatType -> String
$cshow :: ChatType -> String
showsPrec :: Int -> ChatType -> ShowS
$cshowsPrec :: Int -> ChatType -> ShowS
Show)

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