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

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

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

-- ** '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. 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
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)

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