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

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

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

-- ** 'setMessageReaction'

-- | Request parameters for 'setMessageReaction'
data SetMessageReactionRequest = SetMessageReactionRequest
  { SetMessageReactionRequest -> SomeChatId
setMessageReactionRequestChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format \@channelusername).
  , SetMessageReactionRequest -> MessageId
setMessageReactionRequestMessageId :: MessageId -- ^ Identifier of the target message. If the message belongs to a media group, the reaction is set to the first non-deleted message in the group instead.
  , SetMessageReactionRequest -> Maybe [ReactionType]
setMessageReactionRequestReaction :: Maybe [ReactionType] -- ^ New list of reaction types to set on the message. Currently, as non-premium users, bots can set up to one reaction per message. A custom emoji reaction can be used if it is either already present on the message or explicitly allowed by chat administrators.
  , SetMessageReactionRequest -> Maybe Bool
setMessageReactionRequestIsBig :: Maybe Bool -- ^ Pass 'True' to set the reaction with a big animation.
  }
  deriving (forall x.
 SetMessageReactionRequest -> Rep SetMessageReactionRequest x)
-> (forall x.
    Rep SetMessageReactionRequest x -> SetMessageReactionRequest)
-> Generic SetMessageReactionRequest
forall x.
Rep SetMessageReactionRequest x -> SetMessageReactionRequest
forall x.
SetMessageReactionRequest -> Rep SetMessageReactionRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
SetMessageReactionRequest -> Rep SetMessageReactionRequest x
from :: forall x.
SetMessageReactionRequest -> Rep SetMessageReactionRequest x
$cto :: forall x.
Rep SetMessageReactionRequest x -> SetMessageReactionRequest
to :: forall x.
Rep SetMessageReactionRequest x -> SetMessageReactionRequest
Generic

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

type SetMessageReaction = "setMessageReaction"
  :> ReqBody '[JSON] SetMessageReactionRequest
  :> Post '[JSON] (Response Bool)

setMessageReaction :: SetMessageReactionRequest -> ClientM (Response Bool)
setMessageReaction :: SetMessageReactionRequest -> ClientM (Response Bool)
setMessageReaction = Proxy SetMessageReaction -> Client ClientM SetMessageReaction
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SetMessageReaction)

makeDefault ''SetMessageReactionRequest