{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}

module Telegram.Bot.Simple.RunTG where

import Telegram.Bot.API
import Data.Text
import Servant.Client hiding (Response)
import Telegram.Bot.Simple.Eff (liftClientM, BotM)

-- * 'RunTG'

-- | The most preferrable way to run telegram requests.
--
-- E.g. instead of invoking @liftClientM $ methodName MethodNameRequest {..}@, you just need to specify @runTG $ defMethodName params@. See @examples@ for more details.
class RunTG a b | a -> b where
  runTG :: a -> BotM b

-- ** Instances

-- | A servant client associated with a response type. Alias for 'liftClientM'.
instance RunTG (ClientM (Response a)) (Response a) where
  runTG :: ClientM (Response a) -> BotM (Response a)
runTG = ClientM (Response a) -> BotM (Response a)
forall a. ClientM a -> BotM a
liftClientM

-- | Wrapper around 'AnswerInlineQueryRequest' request type for 'answerInlineQuery' method.
instance RunTG AnswerInlineQueryRequest (Response Bool) where
  runTG :: AnswerInlineQueryRequest -> BotM (Response Bool)
runTG = ClientM (Response Bool) -> BotM (Response Bool)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Bool) -> BotM (Response Bool))
-> (AnswerInlineQueryRequest -> ClientM (Response Bool))
-> AnswerInlineQueryRequest
-> BotM (Response Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnswerInlineQueryRequest -> ClientM (Response Bool)
answerInlineQuery

-- | Wrapper around 'AnswerWebAppQueryRequest' request type for 'answerWebAppQuery' method.
instance RunTG AnswerWebAppQueryRequest (Response SentWebAppMessage) where
  runTG :: AnswerWebAppQueryRequest -> BotM (Response SentWebAppMessage)
runTG = ClientM (Response SentWebAppMessage)
-> BotM (Response SentWebAppMessage)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response SentWebAppMessage)
 -> BotM (Response SentWebAppMessage))
-> (AnswerWebAppQueryRequest
    -> ClientM (Response SentWebAppMessage))
-> AnswerWebAppQueryRequest
-> BotM (Response SentWebAppMessage)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnswerWebAppQueryRequest -> ClientM (Response SentWebAppMessage)
answerWebAppQuery

-- | Wrapper around 'SendInvoiceRequest' request type for 'sendInvoice' method.
instance RunTG SendInvoiceRequest (Response Message) where
  runTG :: SendInvoiceRequest -> BotM (Response Message)
runTG = ClientM (Response Message) -> BotM (Response Message)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Message) -> BotM (Response Message))
-> (SendInvoiceRequest -> ClientM (Response Message))
-> SendInvoiceRequest
-> BotM (Response Message)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SendInvoiceRequest -> ClientM (Response Message)
sendInvoice

-- | Wrapper around 'CreateInvoiceLinkRequest' request type for 'createInvoiceLink' method.
instance RunTG CreateInvoiceLinkRequest (Response Text) where
  runTG :: CreateInvoiceLinkRequest -> BotM (Response Text)
runTG = ClientM (Response Text) -> BotM (Response Text)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Text) -> BotM (Response Text))
-> (CreateInvoiceLinkRequest -> ClientM (Response Text))
-> CreateInvoiceLinkRequest
-> BotM (Response Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CreateInvoiceLinkRequest -> ClientM (Response Text)
createInvoiceLink

-- | Wrapper around 'AnswerShippingQueryRequest' request type for 'answerShippingQuery' method.
instance RunTG AnswerShippingQueryRequest (Response Bool) where
  runTG :: AnswerShippingQueryRequest -> BotM (Response Bool)
runTG = ClientM (Response Bool) -> BotM (Response Bool)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Bool) -> BotM (Response Bool))
-> (AnswerShippingQueryRequest -> ClientM (Response Bool))
-> AnswerShippingQueryRequest
-> BotM (Response Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnswerShippingQueryRequest -> ClientM (Response Bool)
answerShippingQuery

-- | Wrapper around 'AnswerPreCheckoutQueryRequest' request type for 'answerPreCheckoutQuery' method.
instance RunTG AnswerPreCheckoutQueryRequest (Response Bool) where
  runTG :: AnswerPreCheckoutQueryRequest -> BotM (Response Bool)
runTG = ClientM (Response Bool) -> BotM (Response Bool)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Bool) -> BotM (Response Bool))
-> (AnswerPreCheckoutQueryRequest -> ClientM (Response Bool))
-> AnswerPreCheckoutQueryRequest
-> BotM (Response Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnswerPreCheckoutQueryRequest -> ClientM (Response Bool)
answerPreCheckoutQuery

-- | Wrapper around 'GetUpdatesRequest' request type for 'getUpdates' method.
instance RunTG GetUpdatesRequest (Response [Update]) where
  runTG :: GetUpdatesRequest -> BotM (Response [Update])
runTG = ClientM (Response [Update]) -> BotM (Response [Update])
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response [Update]) -> BotM (Response [Update]))
-> (GetUpdatesRequest -> ClientM (Response [Update]))
-> GetUpdatesRequest
-> BotM (Response [Update])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetUpdatesRequest -> ClientM (Response [Update])
getUpdates

-- | Wrapper around 'SendGameRequest' request type for 'sendGame' method.
instance RunTG SendGameRequest (Response Message) where
  runTG :: SendGameRequest -> BotM (Response Message)
runTG = ClientM (Response Message) -> BotM (Response Message)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Message) -> BotM (Response Message))
-> (SendGameRequest -> ClientM (Response Message))
-> SendGameRequest
-> BotM (Response Message)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SendGameRequest -> ClientM (Response Message)
sendGame

-- | Wrapper around 'SetGameScoreRequest' request type for 'setGameScore' method.
instance RunTG SetGameScoreRequest (Response SetGameScoreResult) where
  runTG :: SetGameScoreRequest -> BotM (Response SetGameScoreResult)
runTG = ClientM (Response SetGameScoreResult)
-> BotM (Response SetGameScoreResult)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response SetGameScoreResult)
 -> BotM (Response SetGameScoreResult))
-> (SetGameScoreRequest -> ClientM (Response SetGameScoreResult))
-> SetGameScoreRequest
-> BotM (Response SetGameScoreResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SetGameScoreRequest -> ClientM (Response SetGameScoreResult)
setGameScore

-- | Wrapper around 'SendStickerRequest' request type for 'sendSticker' method.
instance RunTG SendStickerRequest (Response Message) where
  runTG :: SendStickerRequest -> BotM (Response Message)
runTG = ClientM (Response Message) -> BotM (Response Message)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Message) -> BotM (Response Message))
-> (SendStickerRequest -> ClientM (Response Message))
-> SendStickerRequest
-> BotM (Response Message)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SendStickerRequest -> ClientM (Response Message)
sendSticker

-- | Wrapper around 'UploadStickerFileRequest' request type for 'uploadStickerFile' method.
instance RunTG UploadStickerFileRequest (Response File) where
  runTG :: UploadStickerFileRequest -> BotM (Response File)
runTG = ClientM (Response File) -> BotM (Response File)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response File) -> BotM (Response File))
-> (UploadStickerFileRequest -> ClientM (Response File))
-> UploadStickerFileRequest
-> BotM (Response File)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UploadStickerFileRequest -> ClientM (Response File)
uploadStickerFile

-- | Wrapper around 'CreateNewStickerSetRequest' request type for 'createNewStickerSet' method.
instance RunTG CreateNewStickerSetRequest (Response Bool) where
  runTG :: CreateNewStickerSetRequest -> BotM (Response Bool)
runTG = ClientM (Response Bool) -> BotM (Response Bool)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Bool) -> BotM (Response Bool))
-> (CreateNewStickerSetRequest -> ClientM (Response Bool))
-> CreateNewStickerSetRequest
-> BotM (Response Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CreateNewStickerSetRequest -> ClientM (Response Bool)
createNewStickerSet

-- | Wrapper around 'AddStickerToSetRequest' request type for 'addStickerToSet' method.
instance RunTG AddStickerToSetRequest (Response Bool) where
  runTG :: AddStickerToSetRequest -> BotM (Response Bool)
runTG = ClientM (Response Bool) -> BotM (Response Bool)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Bool) -> BotM (Response Bool))
-> (AddStickerToSetRequest -> ClientM (Response Bool))
-> AddStickerToSetRequest
-> BotM (Response Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddStickerToSetRequest -> ClientM (Response Bool)
addStickerToSet

-- | Wrapper around 'SetStickerSetThumbRequest' request type for 'setStickerSetThumb' method.
instance RunTG SetStickerSetThumbRequest (Response Bool) where
  runTG :: SetStickerSetThumbRequest -> BotM (Response Bool)
runTG = ClientM (Response Bool) -> BotM (Response Bool)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Bool) -> BotM (Response Bool))
-> (SetStickerSetThumbRequest -> ClientM (Response Bool))
-> SetStickerSetThumbRequest
-> BotM (Response Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SetStickerSetThumbRequest -> ClientM (Response Bool)
setStickerSetThumb

-- | Wrapper around 'EditMessageTextRequest' request type for 'editMessageText' method.
instance RunTG EditMessageTextRequest (Response EditMessageResponse) where
  runTG :: EditMessageTextRequest -> BotM (Response EditMessageResponse)
runTG = ClientM (Response EditMessageResponse)
-> BotM (Response EditMessageResponse)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response EditMessageResponse)
 -> BotM (Response EditMessageResponse))
-> (EditMessageTextRequest
    -> ClientM (Response EditMessageResponse))
-> EditMessageTextRequest
-> BotM (Response EditMessageResponse)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditMessageTextRequest -> ClientM (Response EditMessageResponse)
editMessageText

-- | Wrapper around 'EditMessageCaptionRequest' request type for 'editMessageCaption' method.
instance RunTG EditMessageCaptionRequest (Response EditMessageResponse) where
  runTG :: EditMessageCaptionRequest -> BotM (Response EditMessageResponse)
runTG = ClientM (Response EditMessageResponse)
-> BotM (Response EditMessageResponse)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response EditMessageResponse)
 -> BotM (Response EditMessageResponse))
-> (EditMessageCaptionRequest
    -> ClientM (Response EditMessageResponse))
-> EditMessageCaptionRequest
-> BotM (Response EditMessageResponse)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditMessageCaptionRequest -> ClientM (Response EditMessageResponse)
editMessageCaption

-- | Wrapper around 'EditMessageMediaRequest' request type for 'editMessageMedia' method.
instance RunTG EditMessageMediaRequest (Response EditMessageResponse) where
  runTG :: EditMessageMediaRequest -> BotM (Response EditMessageResponse)
runTG = ClientM (Response EditMessageResponse)
-> BotM (Response EditMessageResponse)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response EditMessageResponse)
 -> BotM (Response EditMessageResponse))
-> (EditMessageMediaRequest
    -> ClientM (Response EditMessageResponse))
-> EditMessageMediaRequest
-> BotM (Response EditMessageResponse)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditMessageMediaRequest -> ClientM (Response EditMessageResponse)
editMessageMedia

-- | Wrapper around 'EditMessageReplyMarkupRequest' request type for 'editMessageReplyMarkup' method.
instance RunTG EditMessageReplyMarkupRequest (Response EditMessageResponse) where
  runTG :: EditMessageReplyMarkupRequest
-> BotM (Response EditMessageResponse)
runTG = ClientM (Response EditMessageResponse)
-> BotM (Response EditMessageResponse)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response EditMessageResponse)
 -> BotM (Response EditMessageResponse))
-> (EditMessageReplyMarkupRequest
    -> ClientM (Response EditMessageResponse))
-> EditMessageReplyMarkupRequest
-> BotM (Response EditMessageResponse)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditMessageReplyMarkupRequest
-> ClientM (Response EditMessageResponse)
editMessageReplyMarkup

-- | Wrapper around 'StopPollRequest' request type for 'stopPoll' method.
instance RunTG StopPollRequest (Response Poll) where
  runTG :: StopPollRequest -> BotM (Response Poll)
runTG = ClientM (Response Poll) -> BotM (Response Poll)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Poll) -> BotM (Response Poll))
-> (StopPollRequest -> ClientM (Response Poll))
-> StopPollRequest
-> BotM (Response Poll)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StopPollRequest -> ClientM (Response Poll)
stopPoll

-- | Wrapper around 'CreateForumTopicRequest' request type for 'createForumTopic' method.
instance RunTG CreateForumTopicRequest (Response ForumTopic) where
  runTG :: CreateForumTopicRequest -> BotM (Response ForumTopic)
runTG = ClientM (Response ForumTopic) -> BotM (Response ForumTopic)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response ForumTopic) -> BotM (Response ForumTopic))
-> (CreateForumTopicRequest -> ClientM (Response ForumTopic))
-> CreateForumTopicRequest
-> BotM (Response ForumTopic)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CreateForumTopicRequest -> ClientM (Response ForumTopic)
createForumTopic

-- | Wrapper around 'EditForumTopicRequest' request type for 'editForumTopic' method.
instance RunTG EditForumTopicRequest (Response Bool) where
  runTG :: EditForumTopicRequest -> BotM (Response Bool)
runTG = ClientM (Response Bool) -> BotM (Response Bool)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Bool) -> BotM (Response Bool))
-> (EditForumTopicRequest -> ClientM (Response Bool))
-> EditForumTopicRequest
-> BotM (Response Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditForumTopicRequest -> ClientM (Response Bool)
editForumTopic

-- | Wrapper around 'CloseForumTopicRequest' request type for 'closeForumTopic' method.
instance RunTG CloseForumTopicRequest (Response Bool) where
  runTG :: CloseForumTopicRequest -> BotM (Response Bool)
runTG = ClientM (Response Bool) -> BotM (Response Bool)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Bool) -> BotM (Response Bool))
-> (CloseForumTopicRequest -> ClientM (Response Bool))
-> CloseForumTopicRequest
-> BotM (Response Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CloseForumTopicRequest -> ClientM (Response Bool)
closeForumTopic

-- | Wrapper around 'ReopenForumTopicRequest' request type for 'reopenForumTopic' method.
instance RunTG ReopenForumTopicRequest (Response Bool) where
  runTG :: ReopenForumTopicRequest -> BotM (Response Bool)
runTG = ClientM (Response Bool) -> BotM (Response Bool)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Bool) -> BotM (Response Bool))
-> (ReopenForumTopicRequest -> ClientM (Response Bool))
-> ReopenForumTopicRequest
-> BotM (Response Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReopenForumTopicRequest -> ClientM (Response Bool)
reopenForumTopic

-- | Wrapper around 'DeleteForumTopicRequest' request type for 'deleteForumTopic' method.
instance RunTG DeleteForumTopicRequest (Response Bool) where
  runTG :: DeleteForumTopicRequest -> BotM (Response Bool)
runTG = ClientM (Response Bool) -> BotM (Response Bool)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Bool) -> BotM (Response Bool))
-> (DeleteForumTopicRequest -> ClientM (Response Bool))
-> DeleteForumTopicRequest
-> BotM (Response Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeleteForumTopicRequest -> ClientM (Response Bool)
deleteForumTopic

-- | Wrapper around 'UnpinAllForumTopicMessagesRequest' request type for 'unpinAllForumTopicMessages' method.
instance RunTG UnpinAllForumTopicMessagesRequest (Response Bool) where
  runTG :: UnpinAllForumTopicMessagesRequest -> BotM (Response Bool)
runTG = ClientM (Response Bool) -> BotM (Response Bool)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Bool) -> BotM (Response Bool))
-> (UnpinAllForumTopicMessagesRequest -> ClientM (Response Bool))
-> UnpinAllForumTopicMessagesRequest
-> BotM (Response Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnpinAllForumTopicMessagesRequest -> ClientM (Response Bool)
unpinAllForumTopicMessages

-- | Wrapper around 'EditGeneralForumTopicRequest' request type for 'editGeneralForumTopic' method.
instance RunTG EditGeneralForumTopicRequest (Response Bool) where
  runTG :: EditGeneralForumTopicRequest -> BotM (Response Bool)
runTG = ClientM (Response Bool) -> BotM (Response Bool)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Bool) -> BotM (Response Bool))
-> (EditGeneralForumTopicRequest -> ClientM (Response Bool))
-> EditGeneralForumTopicRequest
-> BotM (Response Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditGeneralForumTopicRequest -> ClientM (Response Bool)
editGeneralForumTopic

-- | Wrapper around 'CloseGeneralForumTopicRequest' request type for 'closeGeneralForumTopic' method.
instance RunTG CloseGeneralForumTopicRequest (Response Bool) where
  runTG :: CloseGeneralForumTopicRequest -> BotM (Response Bool)
runTG = ClientM (Response Bool) -> BotM (Response Bool)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Bool) -> BotM (Response Bool))
-> (CloseGeneralForumTopicRequest -> ClientM (Response Bool))
-> CloseGeneralForumTopicRequest
-> BotM (Response Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CloseGeneralForumTopicRequest -> ClientM (Response Bool)
closeGeneralForumTopic

-- | Wrapper around 'ReopenGeneralForumTopicRequest' request type for 'reopenGeneralForumTopic' method.
instance RunTG ReopenGeneralForumTopicRequest (Response Bool) where
  runTG :: ReopenGeneralForumTopicRequest -> BotM (Response Bool)
runTG = ClientM (Response Bool) -> BotM (Response Bool)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Bool) -> BotM (Response Bool))
-> (ReopenGeneralForumTopicRequest -> ClientM (Response Bool))
-> ReopenGeneralForumTopicRequest
-> BotM (Response Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReopenGeneralForumTopicRequest -> ClientM (Response Bool)
reopenGeneralForumTopic

-- | Wrapper around 'HideGeneralForumTopicRequest' request type for 'hideGeneralForumTopic' method.
instance RunTG HideGeneralForumTopicRequest (Response Bool) where
  runTG :: HideGeneralForumTopicRequest -> BotM (Response Bool)
runTG = ClientM (Response Bool) -> BotM (Response Bool)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Bool) -> BotM (Response Bool))
-> (HideGeneralForumTopicRequest -> ClientM (Response Bool))
-> HideGeneralForumTopicRequest
-> BotM (Response Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HideGeneralForumTopicRequest -> ClientM (Response Bool)
hideGeneralForumTopic

-- | Wrapper around 'UnhideGeneralForumTopicRequest' request type for 'unhideGeneralForumTopic' method.
instance RunTG UnhideGeneralForumTopicRequest (Response Bool) where
  runTG :: UnhideGeneralForumTopicRequest -> BotM (Response Bool)
runTG = ClientM (Response Bool) -> BotM (Response Bool)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Bool) -> BotM (Response Bool))
-> (UnhideGeneralForumTopicRequest -> ClientM (Response Bool))
-> UnhideGeneralForumTopicRequest
-> BotM (Response Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnhideGeneralForumTopicRequest -> ClientM (Response Bool)
unhideGeneralForumTopic

-- | Wrapper around 'ForwardMessageRequest' request type for 'forwardMessage' method.
instance RunTG ForwardMessageRequest (Response Message) where
  runTG :: ForwardMessageRequest -> BotM (Response Message)
runTG = ClientM (Response Message) -> BotM (Response Message)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Message) -> BotM (Response Message))
-> (ForwardMessageRequest -> ClientM (Response Message))
-> ForwardMessageRequest
-> BotM (Response Message)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForwardMessageRequest -> ClientM (Response Message)
forwardMessage

-- | Wrapper around 'SendDiceRequest' request type for 'sendDice' method.
instance RunTG SendDiceRequest (Response Message) where
  runTG :: SendDiceRequest -> BotM (Response Message)
runTG = ClientM (Response Message) -> BotM (Response Message)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Message) -> BotM (Response Message))
-> (SendDiceRequest -> ClientM (Response Message))
-> SendDiceRequest
-> BotM (Response Message)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SendDiceRequest -> ClientM (Response Message)
sendDice

-- | Wrapper around 'UnbanChatMemberRequest' request type for 'unbanChatMember' method.
instance RunTG UnbanChatMemberRequest (Response Bool) where
  runTG :: UnbanChatMemberRequest -> BotM (Response Bool)
runTG = ClientM (Response Bool) -> BotM (Response Bool)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Bool) -> BotM (Response Bool))
-> (UnbanChatMemberRequest -> ClientM (Response Bool))
-> UnbanChatMemberRequest
-> BotM (Response Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnbanChatMemberRequest -> ClientM (Response Bool)
unbanChatMember

-- | Wrapper around 'SendLocationRequest' request type for 'sendLocation' method.
instance RunTG SendLocationRequest (Response Message) where
  runTG :: SendLocationRequest -> BotM (Response Message)
runTG = ClientM (Response Message) -> BotM (Response Message)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Message) -> BotM (Response Message))
-> (SendLocationRequest -> ClientM (Response Message))
-> SendLocationRequest
-> BotM (Response Message)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SendLocationRequest -> ClientM (Response Message)
sendLocation

-- | Wrapper around 'SendVoiceRequest' request type for 'sendVoice' method.
instance RunTG SendVoiceRequest (Response Message) where
  runTG :: SendVoiceRequest -> BotM (Response Message)
runTG = ClientM (Response Message) -> BotM (Response Message)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Message) -> BotM (Response Message))
-> (SendVoiceRequest -> ClientM (Response Message))
-> SendVoiceRequest
-> BotM (Response Message)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SendVoiceRequest -> ClientM (Response Message)
sendVoice

-- | Wrapper around 'SendAudioRequest' request type for 'sendAudio' method.
instance RunTG SendAudioRequest (Response Message) where
  runTG :: SendAudioRequest -> BotM (Response Message)
runTG = ClientM (Response Message) -> BotM (Response Message)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Message) -> BotM (Response Message))
-> (SendAudioRequest -> ClientM (Response Message))
-> SendAudioRequest
-> BotM (Response Message)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SendAudioRequest -> ClientM (Response Message)
sendAudio

-- | Wrapper around 'SendVideoRequest' request type for 'sendVideo' method.
instance RunTG SendVideoRequest (Response Message) where
  runTG :: SendVideoRequest -> BotM (Response Message)
runTG = ClientM (Response Message) -> BotM (Response Message)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Message) -> BotM (Response Message))
-> (SendVideoRequest -> ClientM (Response Message))
-> SendVideoRequest
-> BotM (Response Message)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SendVideoRequest -> ClientM (Response Message)
sendVideo

-- | Wrapper around 'SetChatPhotoRequest' request type for 'setChatPhoto' method.
instance RunTG SetChatPhotoRequest (Response Bool) where
  runTG :: SetChatPhotoRequest -> BotM (Response Bool)
runTG = ClientM (Response Bool) -> BotM (Response Bool)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Bool) -> BotM (Response Bool))
-> (SetChatPhotoRequest -> ClientM (Response Bool))
-> SetChatPhotoRequest
-> BotM (Response Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SetChatPhotoRequest -> ClientM (Response Bool)
setChatPhoto

-- | Wrapper around 'DeleteMyCommandsRequest' request type for 'deleteMyCommands' method.
instance RunTG DeleteMyCommandsRequest (Response Bool) where
  runTG :: DeleteMyCommandsRequest -> BotM (Response Bool)
runTG = ClientM (Response Bool) -> BotM (Response Bool)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Bool) -> BotM (Response Bool))
-> (DeleteMyCommandsRequest -> ClientM (Response Bool))
-> DeleteMyCommandsRequest
-> BotM (Response Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeleteMyCommandsRequest -> ClientM (Response Bool)
deleteMyCommands

-- | Wrapper around 'EditMessageLiveLocationRequest' request type for 'editMessageLiveLocation' method.
instance RunTG EditMessageLiveLocationRequest (Response (Either Bool Message)) where
  runTG :: EditMessageLiveLocationRequest
-> BotM (Response (Either Bool Message))
runTG = ClientM (Response (Either Bool Message))
-> BotM (Response (Either Bool Message))
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response (Either Bool Message))
 -> BotM (Response (Either Bool Message)))
-> (EditMessageLiveLocationRequest
    -> ClientM (Response (Either Bool Message)))
-> EditMessageLiveLocationRequest
-> BotM (Response (Either Bool Message))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditMessageLiveLocationRequest
-> ClientM (Response (Either Bool Message))
editMessageLiveLocation

-- | Wrapper around 'SetChatMenuButtonRequest' request type for 'setChatMenuButton' method.
instance RunTG SetChatMenuButtonRequest (Response Bool) where
  runTG :: SetChatMenuButtonRequest -> BotM (Response Bool)
runTG = ClientM (Response Bool) -> BotM (Response Bool)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Bool) -> BotM (Response Bool))
-> (SetChatMenuButtonRequest -> ClientM (Response Bool))
-> SetChatMenuButtonRequest
-> BotM (Response Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SetChatMenuButtonRequest -> ClientM (Response Bool)
setChatMenuButton

-- | Wrapper around 'SetMyCommandsRequest' request type for 'setMyCommands' method.
instance RunTG SetMyCommandsRequest (Response Bool) where
  runTG :: SetMyCommandsRequest -> BotM (Response Bool)
runTG = ClientM (Response Bool) -> BotM (Response Bool)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Bool) -> BotM (Response Bool))
-> (SetMyCommandsRequest -> ClientM (Response Bool))
-> SetMyCommandsRequest
-> BotM (Response Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SetMyCommandsRequest -> ClientM (Response Bool)
setMyCommands

-- | Wrapper around 'CopyMessageRequest' request type for 'copyMessage' method.
instance RunTG CopyMessageRequest (Response CopyMessageId) where
  runTG :: CopyMessageRequest -> BotM (Response CopyMessageId)
runTG = ClientM (Response CopyMessageId) -> BotM (Response CopyMessageId)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response CopyMessageId) -> BotM (Response CopyMessageId))
-> (CopyMessageRequest -> ClientM (Response CopyMessageId))
-> CopyMessageRequest
-> BotM (Response CopyMessageId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CopyMessageRequest -> ClientM (Response CopyMessageId)
copyMessage

-- | Wrapper around 'SendMessageRequest' request type for 'sendMessage' method.
instance RunTG SendMessageRequest (Response Message) where
  runTG :: SendMessageRequest -> BotM (Response Message)
runTG = ClientM (Response Message) -> BotM (Response Message)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Message) -> BotM (Response Message))
-> (SendMessageRequest -> ClientM (Response Message))
-> SendMessageRequest
-> BotM (Response Message)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SendMessageRequest -> ClientM (Response Message)
sendMessage

-- | Wrapper around 'EditChatInviteLinkRequest' request type for 'editChatInviteLink' method.
instance RunTG EditChatInviteLinkRequest (Response ChatInviteLink) where
  runTG :: EditChatInviteLinkRequest -> BotM (Response ChatInviteLink)
runTG = ClientM (Response ChatInviteLink) -> BotM (Response ChatInviteLink)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response ChatInviteLink)
 -> BotM (Response ChatInviteLink))
-> (EditChatInviteLinkRequest -> ClientM (Response ChatInviteLink))
-> EditChatInviteLinkRequest
-> BotM (Response ChatInviteLink)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EditChatInviteLinkRequest -> ClientM (Response ChatInviteLink)
editChatInviteLink

-- | Wrapper around 'SendPhotoRequest' request type for 'sendPhoto' method.
instance RunTG SendPhotoRequest (Response Message) where
  runTG :: SendPhotoRequest -> BotM (Response Message)
runTG = ClientM (Response Message) -> BotM (Response Message)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Message) -> BotM (Response Message))
-> (SendPhotoRequest -> ClientM (Response Message))
-> SendPhotoRequest
-> BotM (Response Message)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SendPhotoRequest -> ClientM (Response Message)
sendPhoto

-- | Wrapper around 'StopMessageLiveLocationRequest' request type for 'stopMessageLiveLocation' method.
instance RunTG StopMessageLiveLocationRequest (Response (Either Bool Message)) where
  runTG :: StopMessageLiveLocationRequest
-> BotM (Response (Either Bool Message))
runTG = ClientM (Response (Either Bool Message))
-> BotM (Response (Either Bool Message))
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response (Either Bool Message))
 -> BotM (Response (Either Bool Message)))
-> (StopMessageLiveLocationRequest
    -> ClientM (Response (Either Bool Message)))
-> StopMessageLiveLocationRequest
-> BotM (Response (Either Bool Message))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StopMessageLiveLocationRequest
-> ClientM (Response (Either Bool Message))
stopMessageLiveLocation

-- | Wrapper around 'SendDocumentRequest' request type for 'sendDocument' method.
instance RunTG SendDocumentRequest (Response Message) where
  runTG :: SendDocumentRequest -> BotM (Response Message)
runTG = ClientM (Response Message) -> BotM (Response Message)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Message) -> BotM (Response Message))
-> (SendDocumentRequest -> ClientM (Response Message))
-> SendDocumentRequest
-> BotM (Response Message)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SendDocumentRequest -> ClientM (Response Message)
sendDocument

-- | Wrapper around 'SendAnimationRequest' request type for 'sendAnimation' method.
instance RunTG SendAnimationRequest (Response Message) where
  runTG :: SendAnimationRequest -> BotM (Response Message)
runTG = ClientM (Response Message) -> BotM (Response Message)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Message) -> BotM (Response Message))
-> (SendAnimationRequest -> ClientM (Response Message))
-> SendAnimationRequest
-> BotM (Response Message)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SendAnimationRequest -> ClientM (Response Message)
sendAnimation

-- | Wrapper around 'RestrictChatMemberRequest' request type for 'restrictChatMember' method.
instance RunTG RestrictChatMemberRequest (Response Bool) where
  runTG :: RestrictChatMemberRequest -> BotM (Response Bool)
runTG = ClientM (Response Bool) -> BotM (Response Bool)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Bool) -> BotM (Response Bool))
-> (RestrictChatMemberRequest -> ClientM (Response Bool))
-> RestrictChatMemberRequest
-> BotM (Response Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RestrictChatMemberRequest -> ClientM (Response Bool)
restrictChatMember

-- | Wrapper around 'AnswerCallbackQueryRequest' request type for 'answerCallbackQuery' method.
instance RunTG AnswerCallbackQueryRequest (Response Bool) where
  runTG :: AnswerCallbackQueryRequest -> BotM (Response Bool)
runTG = ClientM (Response Bool) -> BotM (Response Bool)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Bool) -> BotM (Response Bool))
-> (AnswerCallbackQueryRequest -> ClientM (Response Bool))
-> AnswerCallbackQueryRequest
-> BotM (Response Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnswerCallbackQueryRequest -> ClientM (Response Bool)
answerCallbackQuery

-- | Wrapper around 'SetMyDefaultAdministratorRightsRequest' request type for 'setMyDefaultAdministratorRights' method.
instance RunTG SetMyDefaultAdministratorRightsRequest (Response Bool) where
  runTG :: SetMyDefaultAdministratorRightsRequest -> BotM (Response Bool)
runTG = ClientM (Response Bool) -> BotM (Response Bool)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Bool) -> BotM (Response Bool))
-> (SetMyDefaultAdministratorRightsRequest
    -> ClientM (Response Bool))
-> SetMyDefaultAdministratorRightsRequest
-> BotM (Response Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SetMyDefaultAdministratorRightsRequest -> ClientM (Response Bool)
setMyDefaultAdministratorRights

-- | Wrapper around 'CreateChatInviteLinkRequest' request type for 'createChatInviteLink' method.
instance RunTG CreateChatInviteLinkRequest (Response ChatInviteLink) where
  runTG :: CreateChatInviteLinkRequest -> BotM (Response ChatInviteLink)
runTG = ClientM (Response ChatInviteLink) -> BotM (Response ChatInviteLink)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response ChatInviteLink)
 -> BotM (Response ChatInviteLink))
-> (CreateChatInviteLinkRequest
    -> ClientM (Response ChatInviteLink))
-> CreateChatInviteLinkRequest
-> BotM (Response ChatInviteLink)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CreateChatInviteLinkRequest -> ClientM (Response ChatInviteLink)
createChatInviteLink

-- | Wrapper around 'PinChatMessageRequest' request type for 'pinChatMessage' method.
instance RunTG PinChatMessageRequest (Response Bool) where
  runTG :: PinChatMessageRequest -> BotM (Response Bool)
runTG = ClientM (Response Bool) -> BotM (Response Bool)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Bool) -> BotM (Response Bool))
-> (PinChatMessageRequest -> ClientM (Response Bool))
-> PinChatMessageRequest
-> BotM (Response Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PinChatMessageRequest -> ClientM (Response Bool)
pinChatMessage

-- | Wrapper around 'SetChatPermissionsRequest' request type for 'setChatPermissions' method.
instance RunTG SetChatPermissionsRequest (Response Bool) where
  runTG :: SetChatPermissionsRequest -> BotM (Response Bool)
runTG = ClientM (Response Bool) -> BotM (Response Bool)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Bool) -> BotM (Response Bool))
-> (SetChatPermissionsRequest -> ClientM (Response Bool))
-> SetChatPermissionsRequest
-> BotM (Response Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SetChatPermissionsRequest -> ClientM (Response Bool)
setChatPermissions

-- | Wrapper around 'PromoteChatMemberRequest' request type for 'promoteChatMember' method.
instance RunTG PromoteChatMemberRequest (Response Bool) where
  runTG :: PromoteChatMemberRequest -> BotM (Response Bool)
runTG = ClientM (Response Bool) -> BotM (Response Bool)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Bool) -> BotM (Response Bool))
-> (PromoteChatMemberRequest -> ClientM (Response Bool))
-> PromoteChatMemberRequest
-> BotM (Response Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PromoteChatMemberRequest -> ClientM (Response Bool)
promoteChatMember

-- | Wrapper around 'GetMyDefaultAdministratorRightsRequest' request type for 'getMyDefaultAdministratorRights' method.
instance RunTG GetMyDefaultAdministratorRightsRequest (Response ChatAdministratorRights) where
  runTG :: GetMyDefaultAdministratorRightsRequest
-> BotM (Response ChatAdministratorRights)
runTG = ClientM (Response ChatAdministratorRights)
-> BotM (Response ChatAdministratorRights)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response ChatAdministratorRights)
 -> BotM (Response ChatAdministratorRights))
-> (GetMyDefaultAdministratorRightsRequest
    -> ClientM (Response ChatAdministratorRights))
-> GetMyDefaultAdministratorRightsRequest
-> BotM (Response ChatAdministratorRights)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetMyDefaultAdministratorRightsRequest
-> ClientM (Response ChatAdministratorRights)
getMyDefaultAdministratorRights

-- | Wrapper around 'BanChatMemberRequest' request type for 'banChatMember' method.
instance RunTG BanChatMemberRequest (Response Bool) where
  runTG :: BanChatMemberRequest -> BotM (Response Bool)
runTG = ClientM (Response Bool) -> BotM (Response Bool)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Bool) -> BotM (Response Bool))
-> (BanChatMemberRequest -> ClientM (Response Bool))
-> BanChatMemberRequest
-> BotM (Response Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BanChatMemberRequest -> ClientM (Response Bool)
banChatMember

-- | Wrapper around 'GetChatMenuButtonRequest' request type for 'getChatMenuButton' method.
instance RunTG GetChatMenuButtonRequest (Response MenuButton) where
  runTG :: GetChatMenuButtonRequest -> BotM (Response MenuButton)
runTG = ClientM (Response MenuButton) -> BotM (Response MenuButton)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response MenuButton) -> BotM (Response MenuButton))
-> (GetChatMenuButtonRequest -> ClientM (Response MenuButton))
-> GetChatMenuButtonRequest
-> BotM (Response MenuButton)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetChatMenuButtonRequest -> ClientM (Response MenuButton)
getChatMenuButton

-- | Wrapper around 'SendPollRequest' request type for 'sendPoll' method.
instance RunTG SendPollRequest (Response Message) where
  runTG :: SendPollRequest -> BotM (Response Message)
runTG = ClientM (Response Message) -> BotM (Response Message)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Message) -> BotM (Response Message))
-> (SendPollRequest -> ClientM (Response Message))
-> SendPollRequest
-> BotM (Response Message)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SendPollRequest -> ClientM (Response Message)
sendPoll

-- | Wrapper around 'GetMyCommandsRequest' request type for 'getMyCommands' method.
instance RunTG GetMyCommandsRequest (Response [BotCommand]) where
  runTG :: GetMyCommandsRequest -> BotM (Response [BotCommand])
runTG = ClientM (Response [BotCommand]) -> BotM (Response [BotCommand])
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response [BotCommand]) -> BotM (Response [BotCommand]))
-> (GetMyCommandsRequest -> ClientM (Response [BotCommand]))
-> GetMyCommandsRequest
-> BotM (Response [BotCommand])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetMyCommandsRequest -> ClientM (Response [BotCommand])
getMyCommands

-- | Wrapper around 'SendVenueRequest' request type for 'sendVenue' method.
instance RunTG SendVenueRequest (Response Message) where
  runTG :: SendVenueRequest -> BotM (Response Message)
runTG = ClientM (Response Message) -> BotM (Response Message)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Message) -> BotM (Response Message))
-> (SendVenueRequest -> ClientM (Response Message))
-> SendVenueRequest
-> BotM (Response Message)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SendVenueRequest -> ClientM (Response Message)
sendVenue

-- | Wrapper around 'SendMediaGroupRequest' request type for 'sendMediaGroup' method.
instance RunTG SendMediaGroupRequest (Response [Message]) where
  runTG :: SendMediaGroupRequest -> BotM (Response [Message])
runTG = ClientM (Response [Message]) -> BotM (Response [Message])
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response [Message]) -> BotM (Response [Message]))
-> (SendMediaGroupRequest -> ClientM (Response [Message]))
-> SendMediaGroupRequest
-> BotM (Response [Message])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SendMediaGroupRequest -> ClientM (Response [Message])
sendMediaGroup

-- | Wrapper around 'SetChatAdministratorCustomTitleRequest' request type for 'setChatAdministratorCustomTitle' method.
instance RunTG SetChatAdministratorCustomTitleRequest (Response Bool) where
  runTG :: SetChatAdministratorCustomTitleRequest -> BotM (Response Bool)
runTG = ClientM (Response Bool) -> BotM (Response Bool)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Bool) -> BotM (Response Bool))
-> (SetChatAdministratorCustomTitleRequest
    -> ClientM (Response Bool))
-> SetChatAdministratorCustomTitleRequest
-> BotM (Response Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SetChatAdministratorCustomTitleRequest -> ClientM (Response Bool)
setChatAdministratorCustomTitle

-- | Wrapper around 'SendVideoNoteRequest' request type for 'sendVideoNote' method.
instance RunTG SendVideoNoteRequest (Response Message) where
  runTG :: SendVideoNoteRequest -> BotM (Response Message)
runTG = ClientM (Response Message) -> BotM (Response Message)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Message) -> BotM (Response Message))
-> (SendVideoNoteRequest -> ClientM (Response Message))
-> SendVideoNoteRequest
-> BotM (Response Message)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SendVideoNoteRequest -> ClientM (Response Message)
sendVideoNote

-- | Wrapper around 'SendContactRequest' request type for 'sendContact' method.
instance RunTG SendContactRequest (Response Message) where
  runTG :: SendContactRequest -> BotM (Response Message)
runTG = ClientM (Response Message) -> BotM (Response Message)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response Message) -> BotM (Response Message))
-> (SendContactRequest -> ClientM (Response Message))
-> SendContactRequest
-> BotM (Response Message)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SendContactRequest -> ClientM (Response Message)
sendContact

-- | Wrapper around 'GetUserProfilePhotosRequest' request type for 'getUserProfilePhotos' method.
instance RunTG GetUserProfilePhotosRequest (Response UserProfilePhotos) where
  runTG :: GetUserProfilePhotosRequest -> BotM (Response UserProfilePhotos)
runTG = ClientM (Response UserProfilePhotos)
-> BotM (Response UserProfilePhotos)
forall a b. RunTG a b => a -> BotM b
runTG (ClientM (Response UserProfilePhotos)
 -> BotM (Response UserProfilePhotos))
-> (GetUserProfilePhotosRequest
    -> ClientM (Response UserProfilePhotos))
-> GetUserProfilePhotosRequest
-> BotM (Response UserProfilePhotos)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetUserProfilePhotosRequest -> ClientM (Response UserProfilePhotos)
getUserProfilePhotos