{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Telegram.Bot.API.Methods.AnswerCallbackQuery where

import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Proxy
import Data.Text
import GHC.Generics (Generic)
import Servant.API
import Servant.Client hiding (Response)

import Telegram.Bot.API.Internal.Utils
import Telegram.Bot.API.Internal.TH
import Telegram.Bot.API.MakingRequests
import Telegram.Bot.API.Types

-- ** 'answerCallbackQuery'

-- | Request parameters for 'answerCallbackQuery'.
data AnswerCallbackQueryRequest = AnswerCallbackQueryRequest
  { AnswerCallbackQueryRequest -> CallbackQueryId
answerCallbackQueryCallbackQueryId :: CallbackQueryId -- ^ Unique identifier for the query to be answered
  , AnswerCallbackQueryRequest -> Maybe Text
answerCallbackQueryText :: Maybe Text -- ^ Text of the notification. If not specified, nothing will be shown to the user, 0-200 characters
  , AnswerCallbackQueryRequest -> Maybe Bool
answerCallbackQueryShowAlert :: Maybe Bool -- ^ If True, an alert will be shown by the client instead of a notification at the top of the chat screen. Defaults to false.
  , AnswerCallbackQueryRequest -> Maybe Text
answerCallbackQueryUrl :: Maybe Text
    -- ^ URL that will be opened by the user's client. If you have created a Game and accepted the conditions via @Botfather, specify the URL that opens your game — note that this will only work if the query comes from a callback_game button.
    --
    --   Otherwise, you may use links like t.me/your_bot?start=XXXX that open your bot with a parameter.
  , AnswerCallbackQueryRequest -> Maybe Integer
answerCallbackQueryCacheTime :: Maybe Integer -- ^ The maximum amount of time in seconds that the result of the callback query may be cached client-side. Telegram apps will support caching starting in version 3.14. Defaults to 0.
  }
  deriving forall x.
Rep AnswerCallbackQueryRequest x -> AnswerCallbackQueryRequest
forall x.
AnswerCallbackQueryRequest -> Rep AnswerCallbackQueryRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AnswerCallbackQueryRequest x -> AnswerCallbackQueryRequest
$cfrom :: forall x.
AnswerCallbackQueryRequest -> Rep AnswerCallbackQueryRequest x
Generic

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

type AnswerCallbackQuery = "answerCallbackQuery"
  :> ReqBody '[JSON] AnswerCallbackQueryRequest
  :> Post '[JSON] (Response Bool)

-- | Use this method to send answers to callback
--   queries sent from inline keyboards. The answer
--   will be displayed to the user as a notification
--   at the top of the chat screen or as an alert.
--   On success, True is returned.
--
--  Alternatively, the user can be redirected to
--  the specified Game URL. For this option to work,
--  you must first create a game for your bot via
--  @Botfather and accept the terms. Otherwise, you
--  may use links like t.me/your_bot?start=XXXX that
--  open your bot with a parameter.
answerCallbackQuery :: AnswerCallbackQueryRequest ->  ClientM (Response Bool)
answerCallbackQuery :: AnswerCallbackQueryRequest -> ClientM (Response Bool)
answerCallbackQuery = forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall {k} (t :: k). Proxy t
Proxy @AnswerCallbackQuery)

makeDefault ''AnswerCallbackQueryRequest