{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
module Telegram.Bot.API.Types where

import Data.Aeson (ToJSON(..), FromJSON(..))
import Data.Coerce (coerce)
import Data.Int (Int32)
import Data.Hashable (Hashable)
import Data.String
import Data.Text (Text, pack)
import Data.Time.Clock.POSIX (POSIXTime)
import GHC.Generics (Generic)
import Servant.API

import Telegram.Bot.API.Internal.Utils

type RequiredQueryParam = QueryParam' '[Required, Strict]

newtype Seconds = Seconds Int32
  deriving (Seconds -> Seconds -> Bool
(Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Bool) -> Eq Seconds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Seconds -> Seconds -> Bool
$c/= :: Seconds -> Seconds -> Bool
== :: Seconds -> Seconds -> Bool
$c== :: Seconds -> Seconds -> Bool
Eq, Int -> Seconds -> ShowS
[Seconds] -> ShowS
Seconds -> String
(Int -> Seconds -> ShowS)
-> (Seconds -> String) -> ([Seconds] -> ShowS) -> Show Seconds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Seconds] -> ShowS
$cshowList :: [Seconds] -> ShowS
show :: Seconds -> String
$cshow :: Seconds -> String
showsPrec :: Int -> Seconds -> ShowS
$cshowsPrec :: Int -> Seconds -> ShowS
Show, Integer -> Seconds
Seconds -> Seconds
Seconds -> Seconds -> Seconds
(Seconds -> Seconds -> Seconds)
-> (Seconds -> Seconds -> Seconds)
-> (Seconds -> Seconds -> Seconds)
-> (Seconds -> Seconds)
-> (Seconds -> Seconds)
-> (Seconds -> Seconds)
-> (Integer -> Seconds)
-> Num Seconds
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Seconds
$cfromInteger :: Integer -> Seconds
signum :: Seconds -> Seconds
$csignum :: Seconds -> Seconds
abs :: Seconds -> Seconds
$cabs :: Seconds -> Seconds
negate :: Seconds -> Seconds
$cnegate :: Seconds -> Seconds
* :: Seconds -> Seconds -> Seconds
$c* :: Seconds -> Seconds -> Seconds
- :: Seconds -> Seconds -> Seconds
$c- :: Seconds -> Seconds -> Seconds
+ :: Seconds -> Seconds -> Seconds
$c+ :: Seconds -> Seconds -> Seconds
Num, [Seconds] -> Encoding
[Seconds] -> Value
Seconds -> Encoding
Seconds -> Value
(Seconds -> Value)
-> (Seconds -> Encoding)
-> ([Seconds] -> Value)
-> ([Seconds] -> Encoding)
-> ToJSON Seconds
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Seconds] -> Encoding
$ctoEncodingList :: [Seconds] -> Encoding
toJSONList :: [Seconds] -> Value
$ctoJSONList :: [Seconds] -> Value
toEncoding :: Seconds -> Encoding
$ctoEncoding :: Seconds -> Encoding
toJSON :: Seconds -> Value
$ctoJSON :: Seconds -> Value
ToJSON, Value -> Parser [Seconds]
Value -> Parser Seconds
(Value -> Parser Seconds)
-> (Value -> Parser [Seconds]) -> FromJSON Seconds
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Seconds]
$cparseJSONList :: Value -> Parser [Seconds]
parseJSON :: Value -> Parser Seconds
$cparseJSON :: Value -> Parser Seconds
FromJSON)

-- * Available types

-- ** User

-- | This object represents a Telegram user or bot.
--
-- <https://core.telegram.org/bots/api#user>
data User = User
  { User -> UserId
userId           :: UserId     -- ^ Unique identifier for this user or bot.
  , User -> Bool
userIsBot        :: Bool       -- ^ 'True', if this user is a bot.
  , User -> Text
userFirstName    :: Text       -- ^ User's or bot's first name.
  , User -> Maybe Text
userLastName     :: Maybe Text -- ^ User‘s or bot’s last name
  , User -> Maybe Text
userUsername     :: Maybe Text -- ^ User‘s or bot’s username
  , User -> Maybe Text
userLanguageCode :: Maybe Text -- ^ IETF language tag of the user's language
  } deriving (Int -> User -> ShowS
[User] -> ShowS
User -> String
(Int -> User -> ShowS)
-> (User -> String) -> ([User] -> ShowS) -> Show User
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [User] -> ShowS
$cshowList :: [User] -> ShowS
show :: User -> String
$cshow :: User -> String
showsPrec :: Int -> User -> ShowS
$cshowsPrec :: Int -> User -> ShowS
Show, (forall x. User -> Rep User x)
-> (forall x. Rep User x -> User) -> Generic User
forall x. Rep User x -> User
forall x. User -> Rep User x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep User x -> User
$cfrom :: forall x. User -> Rep User x
Generic)

-- | Unique identifier for this user or bot.
newtype UserId = UserId Int32
  deriving (UserId -> UserId -> Bool
(UserId -> UserId -> Bool)
-> (UserId -> UserId -> Bool) -> Eq UserId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserId -> UserId -> Bool
$c/= :: UserId -> UserId -> Bool
== :: UserId -> UserId -> Bool
$c== :: UserId -> UserId -> Bool
Eq, Int -> UserId -> ShowS
[UserId] -> ShowS
UserId -> String
(Int -> UserId -> ShowS)
-> (UserId -> String) -> ([UserId] -> ShowS) -> Show UserId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserId] -> ShowS
$cshowList :: [UserId] -> ShowS
show :: UserId -> String
$cshow :: UserId -> String
showsPrec :: Int -> UserId -> ShowS
$cshowsPrec :: Int -> UserId -> ShowS
Show, [UserId] -> Encoding
[UserId] -> Value
UserId -> Encoding
UserId -> Value
(UserId -> Value)
-> (UserId -> Encoding)
-> ([UserId] -> Value)
-> ([UserId] -> Encoding)
-> ToJSON UserId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [UserId] -> Encoding
$ctoEncodingList :: [UserId] -> Encoding
toJSONList :: [UserId] -> Value
$ctoJSONList :: [UserId] -> Value
toEncoding :: UserId -> Encoding
$ctoEncoding :: UserId -> Encoding
toJSON :: UserId -> Value
$ctoJSON :: UserId -> Value
ToJSON, Value -> Parser [UserId]
Value -> Parser UserId
(Value -> Parser UserId)
-> (Value -> Parser [UserId]) -> FromJSON UserId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [UserId]
$cparseJSONList :: Value -> Parser [UserId]
parseJSON :: Value -> Parser UserId
$cparseJSON :: Value -> Parser UserId
FromJSON)

instance ToHttpApiData UserId where toUrlPiece :: UserId -> Text
toUrlPiece = String -> Text
pack (String -> Text) -> (UserId -> String) -> UserId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Show Int32 => Int32 -> String
forall a. Show a => a -> String
show @Int32 (Int32 -> String) -> (UserId -> Int32) -> UserId -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserId -> Int32
coerce

-- ** 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
chatAllMembersAreAdministrators  :: Maybe Bool      -- ^ 'True' if a group has ‘All Members Are Admins’ enabled.
  , Chat -> Maybe ChatPhoto
chatPhoto                        :: Maybe ChatPhoto -- ^ Chat photo. 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 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.
  } deriving ((forall x. Chat -> Rep Chat x)
-> (forall x. Rep Chat x -> Chat) -> Generic Chat
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
(Int -> Chat -> ShowS)
-> (Chat -> String) -> ([Chat] -> ShowS) -> Show Chat
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)

-- | Unique identifier for this chat.
newtype ChatId = ChatId Integer
  deriving (ChatId -> ChatId -> Bool
(ChatId -> ChatId -> Bool)
-> (ChatId -> ChatId -> Bool) -> Eq ChatId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChatId -> ChatId -> Bool
$c/= :: ChatId -> ChatId -> Bool
== :: ChatId -> ChatId -> Bool
$c== :: ChatId -> ChatId -> Bool
Eq, Int -> ChatId -> ShowS
[ChatId] -> ShowS
ChatId -> String
(Int -> ChatId -> ShowS)
-> (ChatId -> String) -> ([ChatId] -> ShowS) -> Show ChatId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChatId] -> ShowS
$cshowList :: [ChatId] -> ShowS
show :: ChatId -> String
$cshow :: ChatId -> String
showsPrec :: Int -> ChatId -> ShowS
$cshowsPrec :: Int -> ChatId -> ShowS
Show, [ChatId] -> Encoding
[ChatId] -> Value
ChatId -> Encoding
ChatId -> Value
(ChatId -> Value)
-> (ChatId -> Encoding)
-> ([ChatId] -> Value)
-> ([ChatId] -> Encoding)
-> ToJSON ChatId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ChatId] -> Encoding
$ctoEncodingList :: [ChatId] -> Encoding
toJSONList :: [ChatId] -> Value
$ctoJSONList :: [ChatId] -> Value
toEncoding :: ChatId -> Encoding
$ctoEncoding :: ChatId -> Encoding
toJSON :: ChatId -> Value
$ctoJSON :: ChatId -> Value
ToJSON, Value -> Parser [ChatId]
Value -> Parser ChatId
(Value -> Parser ChatId)
-> (Value -> Parser [ChatId]) -> FromJSON ChatId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ChatId]
$cparseJSONList :: Value -> Parser [ChatId]
parseJSON :: Value -> Parser ChatId
$cparseJSON :: Value -> Parser ChatId
FromJSON, Int -> ChatId -> Int
ChatId -> Int
(Int -> ChatId -> Int) -> (ChatId -> Int) -> Hashable ChatId
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ChatId -> Int
$chash :: ChatId -> Int
hashWithSalt :: Int -> ChatId -> Int
$chashWithSalt :: Int -> ChatId -> Int
Hashable)

instance ToHttpApiData ChatId where toUrlPiece :: ChatId -> Text
toUrlPiece ChatId
a = String -> Text
pack (String -> Text) -> (Integer -> String) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Show Integer => Integer -> String
forall a. Show a => a -> String
show @Integer (Integer -> Text) -> Integer -> Text
forall a b. (a -> b) -> a -> b
$ ChatId -> Integer
coerce ChatId
a

-- | Type of chat.
data ChatType
  = ChatTypePrivate
  | ChatTypeGroup
  | ChatTypeSupergroup
  | ChatTypeChannel
  deriving ((forall x. ChatType -> Rep ChatType x)
-> (forall x. Rep ChatType x -> ChatType) -> Generic ChatType
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
(Int -> ChatType -> ShowS)
-> (ChatType -> String) -> ([ChatType] -> ShowS) -> Show ChatType
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 = ChatType -> Value
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 = Value -> Parser ChatType
forall a (d :: Meta) (f :: * -> *).
(Generic a, GFromJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
Value -> Parser a
gparseJSON

-- ** Message

-- | This object represents a message.
data Message = Message
  { Message -> MessageId
messageMessageId :: MessageId -- ^ Unique message identifier inside this chat
  , Message -> Maybe User
messageFrom :: Maybe User -- ^ Sender, empty for messages sent to channels
  , Message -> POSIXTime
messageDate :: POSIXTime -- ^ Date the message was sent in Unix time
  , Message -> Chat
messageChat :: Chat -- ^ Conversation the message belongs to
  , Message -> Maybe User
messageForwardFrom :: Maybe User -- ^ For forwarded messages, sender of the original message
  , Message -> Maybe Chat
messageForwardFromChat :: Maybe Chat -- ^ For messages forwarded from channels, information about the original channel
  , Message -> Maybe MessageId
messageForwardFromMessageId :: Maybe MessageId -- ^ For messages forwarded from channels, identifier of the original message in the channel
  , Message -> Maybe Text
messageForwardSignature :: Maybe Text -- ^ For messages forwarded from channels, signature of the post author if present
  , Message -> Maybe POSIXTime
messageForwardDate :: Maybe POSIXTime -- ^ For forwarded messages, date the original message was sent in Unix time
  , Message -> Maybe Message
messageReplyToMessage :: Maybe Message -- ^ For replies, the original message. Note that the Message object in this field will not contain further reply_to_message fields even if it itself is a reply.
  , Message -> Maybe POSIXTime
messageEditDate :: Maybe POSIXTime -- ^ Date the message was last edited in Unix time
  , Message -> Maybe MediaGroupId
messageMediaGroupId :: Maybe MediaGroupId -- ^ The unique identifier of a media message group this message belongs to
  , Message -> Maybe Text
messageAuthorSignature :: Maybe Text -- ^ Signature of the post author for messages in channels
  , Message -> Maybe Text
messageText :: Maybe Text -- ^ For text messages, the actual UTF-8 text of the message, 0-4096 characters.
  , Message -> Maybe [MessageEntity]
messageEntities :: Maybe [MessageEntity] -- ^ For text messages, special entities like usernames, URLs, bot commands, etc. that appear in the text
  , Message -> Maybe [MessageEntity]
messageCaptionEntities :: Maybe [MessageEntity] -- ^ For messages with a caption, special entities like usernames, URLs, bot commands, etc. that appear in the caption
  , Message -> Maybe Audio
messageAudio :: Maybe Audio -- ^ Message is an audio file, information about the file
  , Message -> Maybe Document
messageDocument :: Maybe Document -- ^ Message is a general file, information about the file

--  , messageGame :: Maybe Game -- ^ Message is a game, information about the game. More about games »

  , Message -> Maybe [PhotoSize]
messagePhoto :: Maybe [PhotoSize] -- ^ Message is a photo, available sizes of the photo

--  , messageSticker :: Maybe Sticker -- ^ Message is a sticker, information about the sticker

  , Message -> Maybe Video
messageVideo :: Maybe Video -- ^ Message is a video, information about the video
  , Message -> Maybe Voice
messageVoice :: Maybe Voice -- ^ Message is a voice message, information about the file
  , Message -> Maybe VideoNote
messageVideoNote :: Maybe VideoNote -- ^ Message is a video note, information about the video message
  , Message -> Maybe Text
messageCaption :: Maybe Text -- ^ Caption for the audio, document, photo, video or voice, 0-200 characters
  , Message -> Maybe Contact
messageContact :: Maybe Contact -- ^ Message is a shared contact, information about the contact
  , Message -> Maybe Location
messageLocation :: Maybe Location -- ^ Message is a shared location, information about the location
  , Message -> Maybe Venue
messageVenue :: Maybe Venue -- ^ Message is a venue, information about the venue
  , Message -> Maybe [User]
messageNewChatMembers :: Maybe [User] -- ^ New members that were added to the group or supergroup and information about them (the bot itself may be one of these members)
  , Message -> Maybe User
messageLeftChatMember :: Maybe User -- ^ A member was removed from the group, information about them (this member may be the bot itself)
  , Message -> Maybe Text
messageNewChatTitle :: Maybe Text -- ^ A chat title was changed to this value
  , Message -> Maybe [PhotoSize]
messageNewChatPhoto :: Maybe [PhotoSize] -- ^ A chat photo was change to this value
  , Message -> Maybe Bool
messageDeleteChatPhoto :: Maybe Bool -- ^ Service message: the chat photo was deleted
  , Message -> Maybe Bool
messageGroupChatCreated :: Maybe Bool -- ^ Service message: the group has been created
  , Message -> Maybe Bool
messageSupergroupChatCreated :: Maybe Bool -- ^ Service message: the supergroup has been created. This field can‘t be received in a message coming through updates, because bot can’t be a member of a supergroup when it is created. It can only be found in reply_to_message if someone replies to a very first message in a directly created supergroup.
  , Message -> Maybe Bool
messageChannelChatCreated :: Maybe Bool -- ^ Service message: the channel has been created. This field can‘t be received in a message coming through updates, because bot can’t be a member of a channel when it is created. It can only be found in reply_to_message if someone replies to a very first message in a channel.
  , Message -> Maybe ChatId
messageMigrateToChatId :: Maybe ChatId -- ^ The group has been migrated to a supergroup with the specified identifier. 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.
  , Message -> Maybe ChatId
messageMigrateFromChatId :: Maybe ChatId -- ^ The supergroup has been migrated from a group with the specified identifier. 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.
  , Message -> Maybe Message
messagePinnedMessage :: Maybe Message -- ^ Specified message was pinned. Note that the Message object in this field will not contain further reply_to_message fields even if it is itself a reply.

--  , messageInvoice :: Maybe Invoice -- ^ Message is an invoice for a payment, information about the invoice. More about payments »
--  , messageSuccessfulPayment :: Maybe SuccessfulPayment -- ^ Message is a service message about a successful payment, information about the payment. More about payments »
  } deriving ((forall x. Message -> Rep Message x)
-> (forall x. Rep Message x -> Message) -> Generic Message
forall x. Rep Message x -> Message
forall x. Message -> Rep Message x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Message x -> Message
$cfrom :: forall x. Message -> Rep Message x
Generic, Int -> Message -> ShowS
[Message] -> ShowS
Message -> String
(Int -> Message -> ShowS)
-> (Message -> String) -> ([Message] -> ShowS) -> Show Message
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Message] -> ShowS
$cshowList :: [Message] -> ShowS
show :: Message -> String
$cshow :: Message -> String
showsPrec :: Int -> Message -> ShowS
$cshowsPrec :: Int -> Message -> ShowS
Show)

-- | Unique message identifier inside this chat.
newtype MessageId = MessageId Int32
  deriving (MessageId -> MessageId -> Bool
(MessageId -> MessageId -> Bool)
-> (MessageId -> MessageId -> Bool) -> Eq MessageId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MessageId -> MessageId -> Bool
$c/= :: MessageId -> MessageId -> Bool
== :: MessageId -> MessageId -> Bool
$c== :: MessageId -> MessageId -> Bool
Eq, Int -> MessageId -> ShowS
[MessageId] -> ShowS
MessageId -> String
(Int -> MessageId -> ShowS)
-> (MessageId -> String)
-> ([MessageId] -> ShowS)
-> Show MessageId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MessageId] -> ShowS
$cshowList :: [MessageId] -> ShowS
show :: MessageId -> String
$cshow :: MessageId -> String
showsPrec :: Int -> MessageId -> ShowS
$cshowsPrec :: Int -> MessageId -> ShowS
Show, [MessageId] -> Encoding
[MessageId] -> Value
MessageId -> Encoding
MessageId -> Value
(MessageId -> Value)
-> (MessageId -> Encoding)
-> ([MessageId] -> Value)
-> ([MessageId] -> Encoding)
-> ToJSON MessageId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [MessageId] -> Encoding
$ctoEncodingList :: [MessageId] -> Encoding
toJSONList :: [MessageId] -> Value
$ctoJSONList :: [MessageId] -> Value
toEncoding :: MessageId -> Encoding
$ctoEncoding :: MessageId -> Encoding
toJSON :: MessageId -> Value
$ctoJSON :: MessageId -> Value
ToJSON, Value -> Parser [MessageId]
Value -> Parser MessageId
(Value -> Parser MessageId)
-> (Value -> Parser [MessageId]) -> FromJSON MessageId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [MessageId]
$cparseJSONList :: Value -> Parser [MessageId]
parseJSON :: Value -> Parser MessageId
$cparseJSON :: Value -> Parser MessageId
FromJSON, Int -> MessageId -> Int
MessageId -> Int
(Int -> MessageId -> Int)
-> (MessageId -> Int) -> Hashable MessageId
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: MessageId -> Int
$chash :: MessageId -> Int
hashWithSalt :: Int -> MessageId -> Int
$chashWithSalt :: Int -> MessageId -> Int
Hashable)

instance ToHttpApiData MessageId where toUrlPiece :: MessageId -> Text
toUrlPiece MessageId
a = String -> Text
pack (String -> Text) -> (Int32 -> String) -> Int32 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Show Int32 => Int32 -> String
forall a. Show a => a -> String
show @Int32 (Int32 -> Text) -> Int32 -> Text
forall a b. (a -> b) -> a -> b
$ MessageId -> Int32
coerce MessageId
a

-- | The unique identifier of a media message group a message belongs to.
newtype MediaGroupId = MediaGroupId Text
  deriving (MediaGroupId -> MediaGroupId -> Bool
(MediaGroupId -> MediaGroupId -> Bool)
-> (MediaGroupId -> MediaGroupId -> Bool) -> Eq MediaGroupId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MediaGroupId -> MediaGroupId -> Bool
$c/= :: MediaGroupId -> MediaGroupId -> Bool
== :: MediaGroupId -> MediaGroupId -> Bool
$c== :: MediaGroupId -> MediaGroupId -> Bool
Eq, Int -> MediaGroupId -> ShowS
[MediaGroupId] -> ShowS
MediaGroupId -> String
(Int -> MediaGroupId -> ShowS)
-> (MediaGroupId -> String)
-> ([MediaGroupId] -> ShowS)
-> Show MediaGroupId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MediaGroupId] -> ShowS
$cshowList :: [MediaGroupId] -> ShowS
show :: MediaGroupId -> String
$cshow :: MediaGroupId -> String
showsPrec :: Int -> MediaGroupId -> ShowS
$cshowsPrec :: Int -> MediaGroupId -> ShowS
Show, [MediaGroupId] -> Encoding
[MediaGroupId] -> Value
MediaGroupId -> Encoding
MediaGroupId -> Value
(MediaGroupId -> Value)
-> (MediaGroupId -> Encoding)
-> ([MediaGroupId] -> Value)
-> ([MediaGroupId] -> Encoding)
-> ToJSON MediaGroupId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [MediaGroupId] -> Encoding
$ctoEncodingList :: [MediaGroupId] -> Encoding
toJSONList :: [MediaGroupId] -> Value
$ctoJSONList :: [MediaGroupId] -> Value
toEncoding :: MediaGroupId -> Encoding
$ctoEncoding :: MediaGroupId -> Encoding
toJSON :: MediaGroupId -> Value
$ctoJSON :: MediaGroupId -> Value
ToJSON, Value -> Parser [MediaGroupId]
Value -> Parser MediaGroupId
(Value -> Parser MediaGroupId)
-> (Value -> Parser [MediaGroupId]) -> FromJSON MediaGroupId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [MediaGroupId]
$cparseJSONList :: Value -> Parser [MediaGroupId]
parseJSON :: Value -> Parser MediaGroupId
$cparseJSON :: Value -> Parser MediaGroupId
FromJSON)

-- ** MessageEntity

-- | This object represents one special entity in a text message. For example, hashtags, usernames, URLs, etc.
data MessageEntity = MessageEntity
  { MessageEntity -> MessageEntityType
messageEntityType :: MessageEntityType -- ^ Type of the entity. Can be mention (@username), hashtag, bot_command, url, email, bold (bold text), italic (italic text), underline (underlined text), strikethrough, code (monowidth string), pre (monowidth block), text_link (for clickable text URLs), text_mention (for users without usernames)
  , MessageEntity -> Int32
messageEntityOffset :: Int32 -- ^ Offset in UTF-16 code units to the start of the entity
  , MessageEntity -> Int32
messageEntityLength :: Int32 -- ^ Length of the entity in UTF-16 code units
  , MessageEntity -> Maybe Text
messageEntityUrl :: Maybe Text -- ^ For “text_link” only, url that will be opened after user taps on the text
  , MessageEntity -> Maybe User
messageEntityUser :: Maybe User -- ^ For “text_mention” only, the mentioned user
  } deriving ((forall x. MessageEntity -> Rep MessageEntity x)
-> (forall x. Rep MessageEntity x -> MessageEntity)
-> Generic MessageEntity
forall x. Rep MessageEntity x -> MessageEntity
forall x. MessageEntity -> Rep MessageEntity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MessageEntity x -> MessageEntity
$cfrom :: forall x. MessageEntity -> Rep MessageEntity x
Generic, Int -> MessageEntity -> ShowS
[MessageEntity] -> ShowS
MessageEntity -> String
(Int -> MessageEntity -> ShowS)
-> (MessageEntity -> String)
-> ([MessageEntity] -> ShowS)
-> Show MessageEntity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MessageEntity] -> ShowS
$cshowList :: [MessageEntity] -> ShowS
show :: MessageEntity -> String
$cshow :: MessageEntity -> String
showsPrec :: Int -> MessageEntity -> ShowS
$cshowsPrec :: Int -> MessageEntity -> ShowS
Show)

-- | Type of the entity. Can be mention (@username), hashtag, bot_command, url, email, bold (bold text), italic (italic text), underline (underlined text), strikethrough, code (monowidth string), pre (monowidth block), text_link (for clickable text URLs), text_mention (for users without usernames), cashtag, phone_number
data MessageEntityType
  = MessageEntityMention
  | MessageEntityHashtag
  | MessageEntityBotCommand
  | MessageEntityUrl
  | MessageEntityEmail
  | MessageEntityBold
  | MessageEntityItalic
  | MessageEntityUnderline -- ^ See <https://core.telegram.org/tdlib/docs/classtd_1_1td__api_1_1text_entity_type_underline.html>
  | MessageEntityStrikethrough -- ^ See <https://core.telegram.org/tdlib/docs/classtd_1_1td__api_1_1text_entity_type_strikethrough.html>
  | MessageEntityCode
  | MessageEntityPre
  | MessageEntityTextLink
  | MessageEntityTextMention
  | MessageEntityCashtag -- ^ See <https://core.telegram.org/tdlib/docs/classtd_1_1td__api_1_1text_entity_type_cashtag.html>.
  | MessageEntityPhoneNumber -- ^ See <https://core.telegram.org/tdlib/docs/classtd_1_1td__api_1_1text_entity_type_phone_number.html>.
  deriving (MessageEntityType -> MessageEntityType -> Bool
(MessageEntityType -> MessageEntityType -> Bool)
-> (MessageEntityType -> MessageEntityType -> Bool)
-> Eq MessageEntityType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MessageEntityType -> MessageEntityType -> Bool
$c/= :: MessageEntityType -> MessageEntityType -> Bool
== :: MessageEntityType -> MessageEntityType -> Bool
$c== :: MessageEntityType -> MessageEntityType -> Bool
Eq, Int -> MessageEntityType -> ShowS
[MessageEntityType] -> ShowS
MessageEntityType -> String
(Int -> MessageEntityType -> ShowS)
-> (MessageEntityType -> String)
-> ([MessageEntityType] -> ShowS)
-> Show MessageEntityType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MessageEntityType] -> ShowS
$cshowList :: [MessageEntityType] -> ShowS
show :: MessageEntityType -> String
$cshow :: MessageEntityType -> String
showsPrec :: Int -> MessageEntityType -> ShowS
$cshowsPrec :: Int -> MessageEntityType -> ShowS
Show, (forall x. MessageEntityType -> Rep MessageEntityType x)
-> (forall x. Rep MessageEntityType x -> MessageEntityType)
-> Generic MessageEntityType
forall x. Rep MessageEntityType x -> MessageEntityType
forall x. MessageEntityType -> Rep MessageEntityType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MessageEntityType x -> MessageEntityType
$cfrom :: forall x. MessageEntityType -> Rep MessageEntityType x
Generic)

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

-- ** 'PhotoSize'

-- | This object represents one size of a photo or a file / sticker thumbnail.
data PhotoSize = PhotoSize
  { PhotoSize -> FileId
photoSizeFileId   :: FileId      -- ^ Unique identifier for this file
  , PhotoSize -> Int32
photoSizeWidth    :: Int32       -- ^ Photo width
  , PhotoSize -> Int32
photoSizeHeight   :: Int32       -- ^ Photo height
  , PhotoSize -> Maybe Int32
photoSizeFileSize :: Maybe Int32 -- ^ File size
  } deriving ((forall x. PhotoSize -> Rep PhotoSize x)
-> (forall x. Rep PhotoSize x -> PhotoSize) -> Generic PhotoSize
forall x. Rep PhotoSize x -> PhotoSize
forall x. PhotoSize -> Rep PhotoSize x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PhotoSize x -> PhotoSize
$cfrom :: forall x. PhotoSize -> Rep PhotoSize x
Generic, Int -> PhotoSize -> ShowS
[PhotoSize] -> ShowS
PhotoSize -> String
(Int -> PhotoSize -> ShowS)
-> (PhotoSize -> String)
-> ([PhotoSize] -> ShowS)
-> Show PhotoSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PhotoSize] -> ShowS
$cshowList :: [PhotoSize] -> ShowS
show :: PhotoSize -> String
$cshow :: PhotoSize -> String
showsPrec :: Int -> PhotoSize -> ShowS
$cshowsPrec :: Int -> PhotoSize -> ShowS
Show)

-- | Unique identifier for this file.
newtype FileId = FileId Text
  deriving (FileId -> FileId -> Bool
(FileId -> FileId -> Bool)
-> (FileId -> FileId -> Bool) -> Eq FileId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileId -> FileId -> Bool
$c/= :: FileId -> FileId -> Bool
== :: FileId -> FileId -> Bool
$c== :: FileId -> FileId -> Bool
Eq, Int -> FileId -> ShowS
[FileId] -> ShowS
FileId -> String
(Int -> FileId -> ShowS)
-> (FileId -> String) -> ([FileId] -> ShowS) -> Show FileId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileId] -> ShowS
$cshowList :: [FileId] -> ShowS
show :: FileId -> String
$cshow :: FileId -> String
showsPrec :: Int -> FileId -> ShowS
$cshowsPrec :: Int -> FileId -> ShowS
Show, [FileId] -> Encoding
[FileId] -> Value
FileId -> Encoding
FileId -> Value
(FileId -> Value)
-> (FileId -> Encoding)
-> ([FileId] -> Value)
-> ([FileId] -> Encoding)
-> ToJSON FileId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [FileId] -> Encoding
$ctoEncodingList :: [FileId] -> Encoding
toJSONList :: [FileId] -> Value
$ctoJSONList :: [FileId] -> Value
toEncoding :: FileId -> Encoding
$ctoEncoding :: FileId -> Encoding
toJSON :: FileId -> Value
$ctoJSON :: FileId -> Value
ToJSON, Value -> Parser [FileId]
Value -> Parser FileId
(Value -> Parser FileId)
-> (Value -> Parser [FileId]) -> FromJSON FileId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [FileId]
$cparseJSONList :: Value -> Parser [FileId]
parseJSON :: Value -> Parser FileId
$cparseJSON :: Value -> Parser FileId
FromJSON)

-- ** 'Audio'

-- | This object represents an audio file to be treated as music by the Telegram clients.
data Audio = Audio
  { Audio -> FileId
audioFileId :: FileId -- ^ Unique identifier for this file
  , Audio -> Seconds
audioDuration :: Seconds -- ^ Duration of the audio in seconds as defined by sender
  , Audio -> Maybe Text
audioPerformer :: Maybe Text -- ^ Performer of the audio as defined by sender or by audio tags
  , Audio -> Maybe Text
audioTitle :: Maybe Text -- ^ Title of the audio as defined by sender or by audio tags
  , Audio -> Maybe Text
audioMimeType :: Maybe Text -- ^ MIME type of the file as defined by sender
  , Audio -> Maybe Int32
audioFileSize :: Maybe Int32 -- ^ File size
  } deriving ((forall x. Audio -> Rep Audio x)
-> (forall x. Rep Audio x -> Audio) -> Generic Audio
forall x. Rep Audio x -> Audio
forall x. Audio -> Rep Audio x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Audio x -> Audio
$cfrom :: forall x. Audio -> Rep Audio x
Generic, Int -> Audio -> ShowS
[Audio] -> ShowS
Audio -> String
(Int -> Audio -> ShowS)
-> (Audio -> String) -> ([Audio] -> ShowS) -> Show Audio
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Audio] -> ShowS
$cshowList :: [Audio] -> ShowS
show :: Audio -> String
$cshow :: Audio -> String
showsPrec :: Int -> Audio -> ShowS
$cshowsPrec :: Int -> Audio -> ShowS
Show)

-- ** 'Document'

-- | This object represents a general file (as opposed to photos, voice messages and audio files).
data Document = Document
  { Document -> FileId
documentFileId :: FileId -- ^ Unique file identifier
  , Document -> Maybe PhotoSize
documentThumb :: Maybe PhotoSize -- ^ Document thumbnail as defined by sender
  , Document -> Maybe Text
documentFileName :: Maybe Text -- ^ Original filename as defined by sender
  , Document -> Maybe Text
documentMimeType :: Maybe Text -- ^ MIME type of the file as defined by sender
  , Document -> Maybe Int32
documentFileSize :: Maybe Int32 -- ^ File size
  } deriving ((forall x. Document -> Rep Document x)
-> (forall x. Rep Document x -> Document) -> Generic Document
forall x. Rep Document x -> Document
forall x. Document -> Rep Document x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Document x -> Document
$cfrom :: forall x. Document -> Rep Document x
Generic, Int -> Document -> ShowS
[Document] -> ShowS
Document -> String
(Int -> Document -> ShowS)
-> (Document -> String) -> ([Document] -> ShowS) -> Show Document
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Document] -> ShowS
$cshowList :: [Document] -> ShowS
show :: Document -> String
$cshow :: Document -> String
showsPrec :: Int -> Document -> ShowS
$cshowsPrec :: Int -> Document -> ShowS
Show)

-- ** 'Video'

-- | This object represents a video file.
data Video = Video
  { Video -> FileId
videoFileId :: FileId -- ^ Unique identifier for this file
  , Video -> Int32
videoWidth :: Int32 -- ^ Video width as defined by sender
  , Video -> Int32
videoHeight :: Int32 -- ^ Video height as defined by sender
  , Video -> Seconds
videoDuration :: Seconds -- ^ Duration of the video in seconds as defined by sender
  , Video -> Maybe PhotoSize
videoThumb :: Maybe PhotoSize -- ^ Video thumbnail
  , Video -> Maybe Text
videoMimeType :: Maybe Text -- ^ Mime type of a file as defined by sender
  , Video -> Maybe Int32
videoFileSize :: Maybe Int32 -- ^ File size
  } deriving ((forall x. Video -> Rep Video x)
-> (forall x. Rep Video x -> Video) -> Generic Video
forall x. Rep Video x -> Video
forall x. Video -> Rep Video x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Video x -> Video
$cfrom :: forall x. Video -> Rep Video x
Generic, Int -> Video -> ShowS
[Video] -> ShowS
Video -> String
(Int -> Video -> ShowS)
-> (Video -> String) -> ([Video] -> ShowS) -> Show Video
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Video] -> ShowS
$cshowList :: [Video] -> ShowS
show :: Video -> String
$cshow :: Video -> String
showsPrec :: Int -> Video -> ShowS
$cshowsPrec :: Int -> Video -> ShowS
Show)

-- ** 'Voice'

-- | This object represents a voice note.
data Voice = Voice
  { Voice -> FileId
voiceFileId :: FileId -- ^ Unique identifier for this file
  , Voice -> Seconds
voiceDuration :: Seconds -- ^ Duration of the audio in seconds as defined by sender
  , Voice -> Maybe Text
voiceMimeType :: Maybe Text -- ^ MIME type of the file as defined by sender
  , Voice -> Maybe Int32
voiceFileSize :: Maybe Int32 -- ^ File size
  } deriving ((forall x. Voice -> Rep Voice x)
-> (forall x. Rep Voice x -> Voice) -> Generic Voice
forall x. Rep Voice x -> Voice
forall x. Voice -> Rep Voice x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Voice x -> Voice
$cfrom :: forall x. Voice -> Rep Voice x
Generic, Int -> Voice -> ShowS
[Voice] -> ShowS
Voice -> String
(Int -> Voice -> ShowS)
-> (Voice -> String) -> ([Voice] -> ShowS) -> Show Voice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Voice] -> ShowS
$cshowList :: [Voice] -> ShowS
show :: Voice -> String
$cshow :: Voice -> String
showsPrec :: Int -> Voice -> ShowS
$cshowsPrec :: Int -> Voice -> ShowS
Show)

-- ** 'VideoNote'

-- | This object represents a video message (available in Telegram apps as of v.4.0).
data VideoNote = VideoNote
  { VideoNote -> Text
videoNoteFileId :: Text -- ^ Unique identifier for this file
  , VideoNote -> Int32
videoNoteLength :: Int32 -- ^ Video width and height as defined by sender
  , VideoNote -> Seconds
videoNoteDuration :: Seconds -- ^ Duration of the video in seconds as defined by sender
  , VideoNote -> Maybe PhotoSize
videoNoteThumb :: Maybe PhotoSize -- ^ Video thumbnail
  , VideoNote -> Maybe Int32
videoNoteFileSize :: Maybe Int32 -- ^ File size
  } deriving ((forall x. VideoNote -> Rep VideoNote x)
-> (forall x. Rep VideoNote x -> VideoNote) -> Generic VideoNote
forall x. Rep VideoNote x -> VideoNote
forall x. VideoNote -> Rep VideoNote x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VideoNote x -> VideoNote
$cfrom :: forall x. VideoNote -> Rep VideoNote x
Generic, Int -> VideoNote -> ShowS
[VideoNote] -> ShowS
VideoNote -> String
(Int -> VideoNote -> ShowS)
-> (VideoNote -> String)
-> ([VideoNote] -> ShowS)
-> Show VideoNote
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VideoNote] -> ShowS
$cshowList :: [VideoNote] -> ShowS
show :: VideoNote -> String
$cshow :: VideoNote -> String
showsPrec :: Int -> VideoNote -> ShowS
$cshowsPrec :: Int -> VideoNote -> ShowS
Show)

-- ** 'Contact'

-- | This object represents a phone contact.
data Contact = Contact
  { Contact -> Text
contactPhoneNumber :: Text -- ^ Contact's phone number
  , Contact -> Text
contactFirstName :: Text -- ^ Contact's first name
  , Contact -> Maybe Text
contactLastName :: Maybe Text -- ^ Contact's last name
  , Contact -> Maybe UserId
contactUserId :: Maybe UserId -- ^ Contact's user identifier in Telegram
  } deriving ((forall x. Contact -> Rep Contact x)
-> (forall x. Rep Contact x -> Contact) -> Generic Contact
forall x. Rep Contact x -> Contact
forall x. Contact -> Rep Contact x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Contact x -> Contact
$cfrom :: forall x. Contact -> Rep Contact x
Generic, Int -> Contact -> ShowS
[Contact] -> ShowS
Contact -> String
(Int -> Contact -> ShowS)
-> (Contact -> String) -> ([Contact] -> ShowS) -> Show Contact
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Contact] -> ShowS
$cshowList :: [Contact] -> ShowS
show :: Contact -> String
$cshow :: Contact -> String
showsPrec :: Int -> Contact -> ShowS
$cshowsPrec :: Int -> Contact -> ShowS
Show)

-- ** Location

-- | This object represents a point on the map.
data Location = Location
  { Location -> Float
locationLongitude :: Float -- ^ Longitude as defined by sender
  , Location -> Float
locationLatitude  :: Float -- ^ Latitude as defined by sender
  } deriving ((forall x. Location -> Rep Location x)
-> (forall x. Rep Location x -> Location) -> Generic Location
forall x. Rep Location x -> Location
forall x. Location -> Rep Location x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Location x -> Location
$cfrom :: forall x. Location -> Rep Location x
Generic, Int -> Location -> ShowS
[Location] -> ShowS
Location -> String
(Int -> Location -> ShowS)
-> (Location -> String) -> ([Location] -> ShowS) -> Show Location
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Location] -> ShowS
$cshowList :: [Location] -> ShowS
show :: Location -> String
$cshow :: Location -> String
showsPrec :: Int -> Location -> ShowS
$cshowsPrec :: Int -> Location -> ShowS
Show)

-- ** 'Venue'

-- | This object represents a venue.
data Venue = Venue
  { Venue -> Location
venueLocation :: Location -- ^ Venue location
  , Venue -> Text
venueTitle :: Text -- ^ Name of the venue
  , Venue -> Text
venueAddress :: Text -- ^ Address of the venue
  , Venue -> Maybe Text
venueFoursquareId :: Maybe Text -- ^ Foursquare identifier of the venue
  } deriving ((forall x. Venue -> Rep Venue x)
-> (forall x. Rep Venue x -> Venue) -> Generic Venue
forall x. Rep Venue x -> Venue
forall x. Venue -> Rep Venue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Venue x -> Venue
$cfrom :: forall x. Venue -> Rep Venue x
Generic, Int -> Venue -> ShowS
[Venue] -> ShowS
Venue -> String
(Int -> Venue -> ShowS)
-> (Venue -> String) -> ([Venue] -> ShowS) -> Show Venue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Venue] -> ShowS
$cshowList :: [Venue] -> ShowS
show :: Venue -> String
$cshow :: Venue -> String
showsPrec :: Int -> Venue -> ShowS
$cshowsPrec :: Int -> Venue -> ShowS
Show)

-- ** 'UserProfilePhotos'

-- | This object represent a user's profile pictures.
data UserProfilePhotos = UserProfilePhotos
  { UserProfilePhotos -> Int32
userProfilePhotosTotalCount :: Int32 -- ^ Total number of profile pictures the target user has
  , UserProfilePhotos -> [[PhotoSize]]
userProfilePhotosPhotos :: [[PhotoSize]] -- ^ Requested profile pictures (in up to 4 sizes each)
  } deriving ((forall x. UserProfilePhotos -> Rep UserProfilePhotos x)
-> (forall x. Rep UserProfilePhotos x -> UserProfilePhotos)
-> Generic UserProfilePhotos
forall x. Rep UserProfilePhotos x -> UserProfilePhotos
forall x. UserProfilePhotos -> Rep UserProfilePhotos x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UserProfilePhotos x -> UserProfilePhotos
$cfrom :: forall x. UserProfilePhotos -> Rep UserProfilePhotos x
Generic, Int -> UserProfilePhotos -> ShowS
[UserProfilePhotos] -> ShowS
UserProfilePhotos -> String
(Int -> UserProfilePhotos -> ShowS)
-> (UserProfilePhotos -> String)
-> ([UserProfilePhotos] -> ShowS)
-> Show UserProfilePhotos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserProfilePhotos] -> ShowS
$cshowList :: [UserProfilePhotos] -> ShowS
show :: UserProfilePhotos -> String
$cshow :: UserProfilePhotos -> String
showsPrec :: Int -> UserProfilePhotos -> ShowS
$cshowsPrec :: Int -> UserProfilePhotos -> ShowS
Show)

-- ** 'File'

-- | This object represents a file ready to be downloaded.
-- The file can be downloaded via the link @https://api.telegram.org/file/bot<token>/<file_path>@.
-- It is guaranteed that the link will be valid for at least 1 hour.
-- When the link expires, a new one can be requested by calling getFile.
data File = File
  { File -> FileId
fileFileId :: FileId -- ^ Unique identifier for this file
  , File -> Maybe Int32
fileFileSize :: Maybe Int32 -- ^ File size, if known
  , File -> Maybe Text
fileFilePath :: Maybe Text -- ^ File path. Use https://api.telegram.org/file/bot<token>/<file_path> to get the file.
  } deriving ((forall x. File -> Rep File x)
-> (forall x. Rep File x -> File) -> Generic File
forall x. Rep File x -> File
forall x. File -> Rep File x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep File x -> File
$cfrom :: forall x. File -> Rep File x
Generic, Int -> File -> ShowS
[File] -> ShowS
File -> String
(Int -> File -> ShowS)
-> (File -> String) -> ([File] -> ShowS) -> Show File
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [File] -> ShowS
$cshowList :: [File] -> ShowS
show :: File -> String
$cshow :: File -> String
showsPrec :: Int -> File -> ShowS
$cshowsPrec :: Int -> File -> ShowS
Show)

-- ** 'ReplyKeyboardMarkup'

-- | This object represents a custom keyboard with reply options (see Introduction to bots for details and examples).
data ReplyKeyboardMarkup = ReplyKeyboardMarkup
  { ReplyKeyboardMarkup -> [[KeyboardButton]]
replyKeyboardMarkupKeyboard :: [[KeyboardButton]] -- ^ Array of button rows, each represented by an Array of KeyboardButton objects
  , ReplyKeyboardMarkup -> Maybe Bool
replyKeyboardMarkupResizeKeyboard :: Maybe Bool -- ^ Requests clients to resize the keyboard vertically for optimal fit (e.g., make the keyboard smaller if there are just two rows of buttons). Defaults to false, in which case the custom keyboard is always of the same height as the app's standard keyboard.
  , ReplyKeyboardMarkup -> Maybe Bool
replyKeyboardMarkupOneTimeKeyboard :: Maybe Bool -- ^ Requests clients to hide the keyboard as soon as it's been used. The keyboard will still be available, but clients will automatically display the usual letter-keyboard in the chat – the user can press a special button in the input field to see the custom keyboard again. Defaults to false.
  , ReplyKeyboardMarkup -> Maybe Bool
replyKeyboardMarkupSelective :: Maybe Bool -- ^ Use this parameter if you want to show the keyboard to specific users only. Targets: 1) users that are @mentioned in the text of the Message object; 2) if the bot's message is a reply (has reply_to_message_id), sender of the original message.
  } deriving ((forall x. ReplyKeyboardMarkup -> Rep ReplyKeyboardMarkup x)
-> (forall x. Rep ReplyKeyboardMarkup x -> ReplyKeyboardMarkup)
-> Generic ReplyKeyboardMarkup
forall x. Rep ReplyKeyboardMarkup x -> ReplyKeyboardMarkup
forall x. ReplyKeyboardMarkup -> Rep ReplyKeyboardMarkup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReplyKeyboardMarkup x -> ReplyKeyboardMarkup
$cfrom :: forall x. ReplyKeyboardMarkup -> Rep ReplyKeyboardMarkup x
Generic, Int -> ReplyKeyboardMarkup -> ShowS
[ReplyKeyboardMarkup] -> ShowS
ReplyKeyboardMarkup -> String
(Int -> ReplyKeyboardMarkup -> ShowS)
-> (ReplyKeyboardMarkup -> String)
-> ([ReplyKeyboardMarkup] -> ShowS)
-> Show ReplyKeyboardMarkup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReplyKeyboardMarkup] -> ShowS
$cshowList :: [ReplyKeyboardMarkup] -> ShowS
show :: ReplyKeyboardMarkup -> String
$cshow :: ReplyKeyboardMarkup -> String
showsPrec :: Int -> ReplyKeyboardMarkup -> ShowS
$cshowsPrec :: Int -> ReplyKeyboardMarkup -> ShowS
Show)

-- ** 'KeyboardButton'

-- | This object represents one button of the reply keyboard.
-- For simple text buttons String can be used instead of this object
-- to specify text of the button. Optional fields are mutually exclusive.
data KeyboardButton = KeyboardButton
  { KeyboardButton -> Text
keyboardButtonText :: Text -- ^ Text of the button. If none of the optional fields are used, it will be sent as a message when the button is pressed
  , KeyboardButton -> Maybe Bool
keyboardButtonRequestContact :: Maybe Bool -- ^ If True, the user's phone number will be sent as a contact when the button is pressed. Available in private chats only
  , KeyboardButton -> Maybe Bool
keyboardButtonRequestLocation :: Maybe Bool -- ^ If True, the user's current location will be sent when the button is pressed. Available in private chats only
  } deriving ((forall x. KeyboardButton -> Rep KeyboardButton x)
-> (forall x. Rep KeyboardButton x -> KeyboardButton)
-> Generic KeyboardButton
forall x. Rep KeyboardButton x -> KeyboardButton
forall x. KeyboardButton -> Rep KeyboardButton x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep KeyboardButton x -> KeyboardButton
$cfrom :: forall x. KeyboardButton -> Rep KeyboardButton x
Generic, Int -> KeyboardButton -> ShowS
[KeyboardButton] -> ShowS
KeyboardButton -> String
(Int -> KeyboardButton -> ShowS)
-> (KeyboardButton -> String)
-> ([KeyboardButton] -> ShowS)
-> Show KeyboardButton
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyboardButton] -> ShowS
$cshowList :: [KeyboardButton] -> ShowS
show :: KeyboardButton -> String
$cshow :: KeyboardButton -> String
showsPrec :: Int -> KeyboardButton -> ShowS
$cshowsPrec :: Int -> KeyboardButton -> ShowS
Show)

instance IsString KeyboardButton where
  fromString :: String -> KeyboardButton
fromString String
s = Text -> Maybe Bool -> Maybe Bool -> KeyboardButton
KeyboardButton (String -> Text
forall a. IsString a => String -> a
fromString String
s) Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing

-- ** 'ReplyKeyboardRemove'

-- | Upon receiving a message with this object,
-- Telegram clients will remove the current custom keyboard
-- and display the default letter-keyboard.
--
-- By default, custom keyboards are displayed until a new keyboard is sent by a bot.
-- An exception is made for one-time keyboards that are hidden immediately after
-- the user presses a button (see 'ReplyKeyboardMarkup').
data ReplyKeyboardRemove = ReplyKeyboardRemove
  { ReplyKeyboardRemove -> Bool
replyKeyboardRemoveRemoveKeyboard :: Bool -- ^ Requests clients to remove the custom keyboard (user will not be able to summon this keyboard; if you want to hide the keyboard from sight but keep it accessible, use one_time_keyboard in ReplyKeyboardMarkup)
  , ReplyKeyboardRemove -> Maybe Bool
replyKeyboardRemoveSelective :: Maybe Bool -- ^ Use this parameter if you want to remove the keyboard for specific users only. Targets: 1) users that are @mentioned in the text of the Message object; 2) if the bot's message is a reply (has reply_to_message_id), sender of the original message.
  } deriving ((forall x. ReplyKeyboardRemove -> Rep ReplyKeyboardRemove x)
-> (forall x. Rep ReplyKeyboardRemove x -> ReplyKeyboardRemove)
-> Generic ReplyKeyboardRemove
forall x. Rep ReplyKeyboardRemove x -> ReplyKeyboardRemove
forall x. ReplyKeyboardRemove -> Rep ReplyKeyboardRemove x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReplyKeyboardRemove x -> ReplyKeyboardRemove
$cfrom :: forall x. ReplyKeyboardRemove -> Rep ReplyKeyboardRemove x
Generic, Int -> ReplyKeyboardRemove -> ShowS
[ReplyKeyboardRemove] -> ShowS
ReplyKeyboardRemove -> String
(Int -> ReplyKeyboardRemove -> ShowS)
-> (ReplyKeyboardRemove -> String)
-> ([ReplyKeyboardRemove] -> ShowS)
-> Show ReplyKeyboardRemove
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReplyKeyboardRemove] -> ShowS
$cshowList :: [ReplyKeyboardRemove] -> ShowS
show :: ReplyKeyboardRemove -> String
$cshow :: ReplyKeyboardRemove -> String
showsPrec :: Int -> ReplyKeyboardRemove -> ShowS
$cshowsPrec :: Int -> ReplyKeyboardRemove -> ShowS
Show)

-- ** 'InlineKeyboardMarkup'

-- | This object represents an inline keyboard that appears
-- right next to the message it belongs to.
data InlineKeyboardMarkup = InlineKeyboardMarkup
  { InlineKeyboardMarkup -> [[InlineKeyboardButton]]
inlineKeyboardMarkupInlineKeyboard :: [[InlineKeyboardButton]] -- ^ Array of button rows, each represented by an Array of InlineKeyboardButton objects
  } deriving ((forall x. InlineKeyboardMarkup -> Rep InlineKeyboardMarkup x)
-> (forall x. Rep InlineKeyboardMarkup x -> InlineKeyboardMarkup)
-> Generic InlineKeyboardMarkup
forall x. Rep InlineKeyboardMarkup x -> InlineKeyboardMarkup
forall x. InlineKeyboardMarkup -> Rep InlineKeyboardMarkup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InlineKeyboardMarkup x -> InlineKeyboardMarkup
$cfrom :: forall x. InlineKeyboardMarkup -> Rep InlineKeyboardMarkup x
Generic, Int -> InlineKeyboardMarkup -> ShowS
[InlineKeyboardMarkup] -> ShowS
InlineKeyboardMarkup -> String
(Int -> InlineKeyboardMarkup -> ShowS)
-> (InlineKeyboardMarkup -> String)
-> ([InlineKeyboardMarkup] -> ShowS)
-> Show InlineKeyboardMarkup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InlineKeyboardMarkup] -> ShowS
$cshowList :: [InlineKeyboardMarkup] -> ShowS
show :: InlineKeyboardMarkup -> String
$cshow :: InlineKeyboardMarkup -> String
showsPrec :: Int -> InlineKeyboardMarkup -> ShowS
$cshowsPrec :: Int -> InlineKeyboardMarkup -> ShowS
Show)

-- ** 'InlineKeyboardButton'

-- | This object represents one button of an inline keyboard. You must use exactly one of the optional fields.
data InlineKeyboardButton = InlineKeyboardButton
  { InlineKeyboardButton -> Text
inlineKeyboardButtonText :: Text -- ^ Label text on the button
  , InlineKeyboardButton -> Maybe Text
inlineKeyboardButtonUrl :: Maybe Text -- ^ HTTP url to be opened when button is pressed
  , InlineKeyboardButton -> Maybe Text
inlineKeyboardButtonCallbackData :: Maybe Text -- ^ Data to be sent in a callback query to the bot when button is pressed, 1-64 bytes
  , InlineKeyboardButton -> Maybe Text
inlineKeyboardButtonSwitchInlineQuery :: Maybe Text -- ^ If set, pressing the button will prompt the user to select one of their chats, open that chat and insert the bot‘s username and the specified inline query in the input field. Can be empty, in which case just the bot’s username will be inserted.
  , InlineKeyboardButton -> Maybe Text
inlineKeyboardButtonSwitchInlineQueryCurrentChat :: Maybe Text -- ^ If set, pressing the button will insert the bot‘s username and the specified inline query in the current chat's input field. Can be empty, in which case only the bot’s username will be inserted.

--  , inlineKeyboardButtonCallbackGame :: Maybe CallbackGame -- ^ Description of the game that will be launched when the user presses the button.

  , InlineKeyboardButton -> Maybe Bool
inlineKeyboardButtonPay :: Maybe Bool -- ^ Specify True, to send a Pay button.
  } deriving ((forall x. InlineKeyboardButton -> Rep InlineKeyboardButton x)
-> (forall x. Rep InlineKeyboardButton x -> InlineKeyboardButton)
-> Generic InlineKeyboardButton
forall x. Rep InlineKeyboardButton x -> InlineKeyboardButton
forall x. InlineKeyboardButton -> Rep InlineKeyboardButton x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InlineKeyboardButton x -> InlineKeyboardButton
$cfrom :: forall x. InlineKeyboardButton -> Rep InlineKeyboardButton x
Generic, Int -> InlineKeyboardButton -> ShowS
[InlineKeyboardButton] -> ShowS
InlineKeyboardButton -> String
(Int -> InlineKeyboardButton -> ShowS)
-> (InlineKeyboardButton -> String)
-> ([InlineKeyboardButton] -> ShowS)
-> Show InlineKeyboardButton
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InlineKeyboardButton] -> ShowS
$cshowList :: [InlineKeyboardButton] -> ShowS
show :: InlineKeyboardButton -> String
$cshow :: InlineKeyboardButton -> String
showsPrec :: Int -> InlineKeyboardButton -> ShowS
$cshowsPrec :: Int -> InlineKeyboardButton -> ShowS
Show)

labeledInlineKeyboardButton :: Text -> InlineKeyboardButton
labeledInlineKeyboardButton :: Text -> InlineKeyboardButton
labeledInlineKeyboardButton Text
label = Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> InlineKeyboardButton
InlineKeyboardButton Text
label Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing

-- ** 'CallbackQuery'

-- | This object represents an incoming callback query from a callback button
-- in an inline keyboard. If the button that originated the query was attached
-- to a message sent by the bot, the field message will be present.
-- If the button was attached to a message sent via the bot (in inline mode),
-- the field @inline_message_id@ will be present.
-- Exactly one of the fields data or game_short_name will be present.
data CallbackQuery = CallbackQuery
  { CallbackQuery -> CallbackQueryId
callbackQueryId :: CallbackQueryId -- ^ Unique identifier for this query
  , CallbackQuery -> User
callbackQueryFrom :: User -- ^ Sender
  , CallbackQuery -> Maybe Message
callbackQueryMessage :: Maybe Message -- ^ Message with the callback button that originated the query. Note that message content and message date will not be available if the message is too old
  , CallbackQuery -> Maybe MessageId
callbackQueryInlineMessageId :: Maybe MessageId -- ^ Identifier of the message sent via the bot in inline mode, that originated the query.
  , CallbackQuery -> Text
callbackQueryChatInstance :: Text -- ^ Global identifier, uniquely corresponding to the chat to which the message with the callback button was sent. Useful for high scores in games.
  , CallbackQuery -> Maybe Text
callbackQueryData :: Maybe Text -- ^ Data associated with the callback button. Be aware that a bad client can send arbitrary data in this field.
  , CallbackQuery -> Maybe Text
callbackQueryGameShortName :: Maybe Text -- ^ Short name of a Game to be returned, serves as the unique identifier for the game
  } deriving ((forall x. CallbackQuery -> Rep CallbackQuery x)
-> (forall x. Rep CallbackQuery x -> CallbackQuery)
-> Generic CallbackQuery
forall x. Rep CallbackQuery x -> CallbackQuery
forall x. CallbackQuery -> Rep CallbackQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CallbackQuery x -> CallbackQuery
$cfrom :: forall x. CallbackQuery -> Rep CallbackQuery x
Generic, Int -> CallbackQuery -> ShowS
[CallbackQuery] -> ShowS
CallbackQuery -> String
(Int -> CallbackQuery -> ShowS)
-> (CallbackQuery -> String)
-> ([CallbackQuery] -> ShowS)
-> Show CallbackQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CallbackQuery] -> ShowS
$cshowList :: [CallbackQuery] -> ShowS
show :: CallbackQuery -> String
$cshow :: CallbackQuery -> String
showsPrec :: Int -> CallbackQuery -> ShowS
$cshowsPrec :: Int -> CallbackQuery -> ShowS
Show)

newtype CallbackQueryId = CallbackQueryId Text
  deriving (CallbackQueryId -> CallbackQueryId -> Bool
(CallbackQueryId -> CallbackQueryId -> Bool)
-> (CallbackQueryId -> CallbackQueryId -> Bool)
-> Eq CallbackQueryId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CallbackQueryId -> CallbackQueryId -> Bool
$c/= :: CallbackQueryId -> CallbackQueryId -> Bool
== :: CallbackQueryId -> CallbackQueryId -> Bool
$c== :: CallbackQueryId -> CallbackQueryId -> Bool
Eq, Int -> CallbackQueryId -> ShowS
[CallbackQueryId] -> ShowS
CallbackQueryId -> String
(Int -> CallbackQueryId -> ShowS)
-> (CallbackQueryId -> String)
-> ([CallbackQueryId] -> ShowS)
-> Show CallbackQueryId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CallbackQueryId] -> ShowS
$cshowList :: [CallbackQueryId] -> ShowS
show :: CallbackQueryId -> String
$cshow :: CallbackQueryId -> String
showsPrec :: Int -> CallbackQueryId -> ShowS
$cshowsPrec :: Int -> CallbackQueryId -> ShowS
Show, (forall x. CallbackQueryId -> Rep CallbackQueryId x)
-> (forall x. Rep CallbackQueryId x -> CallbackQueryId)
-> Generic CallbackQueryId
forall x. Rep CallbackQueryId x -> CallbackQueryId
forall x. CallbackQueryId -> Rep CallbackQueryId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CallbackQueryId x -> CallbackQueryId
$cfrom :: forall x. CallbackQueryId -> Rep CallbackQueryId x
Generic, [CallbackQueryId] -> Encoding
[CallbackQueryId] -> Value
CallbackQueryId -> Encoding
CallbackQueryId -> Value
(CallbackQueryId -> Value)
-> (CallbackQueryId -> Encoding)
-> ([CallbackQueryId] -> Value)
-> ([CallbackQueryId] -> Encoding)
-> ToJSON CallbackQueryId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [CallbackQueryId] -> Encoding
$ctoEncodingList :: [CallbackQueryId] -> Encoding
toJSONList :: [CallbackQueryId] -> Value
$ctoJSONList :: [CallbackQueryId] -> Value
toEncoding :: CallbackQueryId -> Encoding
$ctoEncoding :: CallbackQueryId -> Encoding
toJSON :: CallbackQueryId -> Value
$ctoJSON :: CallbackQueryId -> Value
ToJSON, Value -> Parser [CallbackQueryId]
Value -> Parser CallbackQueryId
(Value -> Parser CallbackQueryId)
-> (Value -> Parser [CallbackQueryId]) -> FromJSON CallbackQueryId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [CallbackQueryId]
$cparseJSONList :: Value -> Parser [CallbackQueryId]
parseJSON :: Value -> Parser CallbackQueryId
$cparseJSON :: Value -> Parser CallbackQueryId
FromJSON)

-- ** 'ForceReply'

-- | Upon receiving a message with this object,
-- Telegram clients will display a reply interface to the user
-- (act as if the user has selected the bot‘s message and tapped ’Reply').
-- This can be extremely useful if you want to create user-friendly
-- step-by-step interfaces without having to sacrifice privacy mode.
data ForceReply = ForceReply
  { ForceReply -> Bool
forceReplyForceReply :: Bool -- ^ Shows reply interface to the user, as if they manually selected the bot‘s message and tapped ’Reply'
  , ForceReply -> Maybe Bool
forceReplySelective :: Maybe Bool -- ^ Use this parameter if you want to force reply from specific users only. Targets: 1) users that are @mentioned in the text of the Message object; 2) if the bot's message is a reply (has reply_to_message_id), sender of the original message.
  } deriving ((forall x. ForceReply -> Rep ForceReply x)
-> (forall x. Rep ForceReply x -> ForceReply) -> Generic ForceReply
forall x. Rep ForceReply x -> ForceReply
forall x. ForceReply -> Rep ForceReply x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ForceReply x -> ForceReply
$cfrom :: forall x. ForceReply -> Rep ForceReply x
Generic, Int -> ForceReply -> ShowS
[ForceReply] -> ShowS
ForceReply -> String
(Int -> ForceReply -> ShowS)
-> (ForceReply -> String)
-> ([ForceReply] -> ShowS)
-> Show ForceReply
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ForceReply] -> ShowS
$cshowList :: [ForceReply] -> ShowS
show :: ForceReply -> String
$cshow :: ForceReply -> String
showsPrec :: Int -> ForceReply -> ShowS
$cshowsPrec :: Int -> ForceReply -> ShowS
Show)

-- ** Chat photo

-- | Chat photo. Returned only in getChat.
data ChatPhoto = ChatPhoto
  { ChatPhoto -> FileId
chatPhotoSmallFileId :: FileId -- ^ Unique file identifier of small (160x160) chat photo. This file_id can be used only for photo download.
  , ChatPhoto -> FileId
chatPhotoBigFileId   :: FileId -- ^ Unique file identifier of big (640x640) chat photo. This file_id can be used only for photo download.
  } deriving ((forall x. ChatPhoto -> Rep ChatPhoto x)
-> (forall x. Rep ChatPhoto x -> ChatPhoto) -> Generic ChatPhoto
forall x. Rep ChatPhoto x -> ChatPhoto
forall x. ChatPhoto -> Rep ChatPhoto x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChatPhoto x -> ChatPhoto
$cfrom :: forall x. ChatPhoto -> Rep ChatPhoto x
Generic, Int -> ChatPhoto -> ShowS
[ChatPhoto] -> ShowS
ChatPhoto -> String
(Int -> ChatPhoto -> ShowS)
-> (ChatPhoto -> String)
-> ([ChatPhoto] -> ShowS)
-> Show ChatPhoto
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChatPhoto] -> ShowS
$cshowList :: [ChatPhoto] -> ShowS
show :: ChatPhoto -> String
$cshow :: ChatPhoto -> String
showsPrec :: Int -> ChatPhoto -> ShowS
$cshowsPrec :: Int -> ChatPhoto -> ShowS
Show)

-- ** '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 “creator”, “administrator”, “member”, “restricted”, “left” or “kicked”
  , ChatMember -> Maybe POSIXTime
chatMemberUntilDate :: Maybe POSIXTime -- ^ Restictred and kicked only. Date when restrictions will be lifted for this user, unix time
  , ChatMember -> Maybe Bool
chatMemberCanBeEdited :: Maybe Bool -- ^ Administrators only. True, if the bot is allowed to edit administrator privileges of that 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
  , ChatMember -> Maybe Bool
chatMemberCanDeleteMessages :: Maybe Bool -- ^ Administrators only. True, if the administrator can delete messages of other users
  , ChatMember -> Maybe Bool
chatMemberCanInviteUsers :: Maybe Bool -- ^ Administrators only. True, if the administrator can invite new users to the chat
  , ChatMember -> Maybe Bool
chatMemberCanRestrictMembers :: Maybe Bool -- ^ Administrators only. True, if the administrator can restrict, ban or unban chat members
  , ChatMember -> Maybe Bool
chatMemberCanPinMessages :: Maybe Bool -- ^ Administrators only. True, if the administrator can pin messages, supergroups only
  , 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
chatMemberCanSendMessages :: Maybe Bool -- ^ Restricted only. True, if the user can send text messages, contacts, locations and venues
  , ChatMember -> Maybe Bool
chatMemberCanSendMediaMessages :: Maybe Bool -- ^ Restricted only. True, if the user can send audios, documents, photos, videos, video notes and voice notes, implies can_send_messages
  , 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. ChatMember -> Rep ChatMember x)
-> (forall x. Rep ChatMember x -> ChatMember) -> Generic ChatMember
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
(Int -> ChatMember -> ShowS)
-> (ChatMember -> String)
-> ([ChatMember] -> ShowS)
-> Show ChatMember
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)

-- ** 'ResponseParameters'

-- | Contains information about why a request was unsuccessful.
data ResponseParameters = ResponseParameters
  { ResponseParameters -> Maybe ChatId
responseParametersMigrateToChatId :: Maybe ChatId -- ^ The group has been migrated to a supergroup with the specified identifier. 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.
  , ResponseParameters -> Maybe Seconds
responseParametersRetryAfter :: Maybe Seconds -- ^ In case of exceeding flood control, the number of seconds left to wait before the request can be repeated
  } deriving (Int -> ResponseParameters -> ShowS
[ResponseParameters] -> ShowS
ResponseParameters -> String
(Int -> ResponseParameters -> ShowS)
-> (ResponseParameters -> String)
-> ([ResponseParameters] -> ShowS)
-> Show ResponseParameters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResponseParameters] -> ShowS
$cshowList :: [ResponseParameters] -> ShowS
show :: ResponseParameters -> String
$cshow :: ResponseParameters -> String
showsPrec :: Int -> ResponseParameters -> ShowS
$cshowsPrec :: Int -> ResponseParameters -> ShowS
Show, (forall x. ResponseParameters -> Rep ResponseParameters x)
-> (forall x. Rep ResponseParameters x -> ResponseParameters)
-> Generic ResponseParameters
forall x. Rep ResponseParameters x -> ResponseParameters
forall x. ResponseParameters -> Rep ResponseParameters x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResponseParameters x -> ResponseParameters
$cfrom :: forall x. ResponseParameters -> Rep ResponseParameters x
Generic)


foldMap deriveJSON' 
  [ ''User
  , ''Chat
  , ''Message
  , ''MessageEntity
  , ''PhotoSize
  , ''Audio
  , ''Document
  , ''Video
  , ''Voice
  , ''VideoNote
  , ''Contact
  , ''Location
  , ''Venue
  , ''UserProfilePhotos
  , ''File
  , ''ReplyKeyboardMarkup
  , ''KeyboardButton
  , ''ReplyKeyboardRemove
  , ''InlineKeyboardMarkup
  , ''InlineKeyboardButton
  , ''CallbackQuery
  , ''ForceReply
  , ''ChatPhoto
  , ''ChatMember
  , ''ResponseParameters
  ]