diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +0.4.2 +--- + +- Fix GHC 9.0 compilation (see [#102](https://github.com/fizruk/telegram-bot-simple/pull/102) ); + 0.4.1 --- diff --git a/src/Telegram/Bot/API/Games.hs b/src/Telegram/Bot/API/Games.hs --- a/src/Telegram/Bot/API/Games.hs +++ b/src/Telegram/Bot/API/Games.hs @@ -59,6 +59,12 @@ } deriving (Generic, Show) +foldMap deriveJSON' + [ ''SendGameRequest + , ''SetGameScoreRequest + , ''SetGameScoreResult + ] + -- * Methods -- ** 'sendGame' @@ -85,8 +91,3 @@ = "getGameHighScores" :> ReqBody '[JSON] GetGameHighScoresRequest :> Post '[JSON] (Response [GameHighScore]) -foldMap deriveJSON' - [ ''SendGameRequest - , ''SetGameScoreRequest - , ''SetGameScoreResult - ] diff --git a/src/Telegram/Bot/API/Methods.hs b/src/Telegram/Bot/API/Methods.hs --- a/src/Telegram/Bot/API/Methods.hs +++ b/src/Telegram/Bot/API/Methods.hs @@ -325,20 +325,6 @@ } deriving Generic -type CopyMessage - = "copyMessage" - :> ReqBody '[JSON] CopyMessageRequest - :> Post '[JSON] (Response MessageId) - --- | Use this method to copy messages of any kind. --- Service messages and invoice messages can't be --- copied. The method is analogous to the method --- forwardMessage, but the copied message doesn't --- have a link to the original message. --- Returns the MessageId of the sent message on success. -copyMessage :: CopyMessageRequest -> ClientM (Response MessageId) -copyMessage = client (Proxy @CopyMessage) - -- | Request parameters for 'sendAudio'. data SendAudioRequest = SendAudioRequest { sendAudioChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @channelusername) @@ -766,15 +752,6 @@ } deriving Generic -type SendLocation = "sendLocation" - :> ReqBody '[JSON] SendLocationRequest - :> Post '[JSON] (Response Message) - --- | Use this method to send point on the map. --- On success, the sent Message is returned. -sendLocation :: SendLocationRequest -> ClientM (Response Message) -sendLocation = client (Proxy @SendLocation) - -- | Request parameters for 'editMessageLiveLocation'. data EditMessageLiveLocationRequest = EditMessageLiveLocationRequest { editMessageLiveLocationChatId :: Maybe SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @channelusername) @@ -789,21 +766,6 @@ } deriving Generic -type EditMessageLiveLocation = "editMessageLiveLocation" - :> ReqBody '[JSON] EditMessageLiveLocationRequest - :> Post '[JSON] (Response (Either Bool Message)) - --- FIXME: Add Bool returning in case of inline message. - --- | Use this method to edit live location messages. --- A location can be edited until its live_period --- expires or editing is explicitly disabled by a --- call to stopMessageLiveLocation. On success, if --- the edited message is not an inline message, the --- edited Message is returned, otherwise True is returned. -editMessageLiveLocation :: EditMessageLiveLocationRequest -> ClientM (Response (Either Bool Message)) -editMessageLiveLocation = client (Proxy @EditMessageLiveLocation) - -- | Request parameters for 'stopMessageLiveLocation'. data StopMessageLiveLocationRequest = StopMessageLiveLocationRequest { stopMessageLiveLocationChatId :: Maybe SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @channelusername) @@ -813,20 +775,6 @@ } deriving Generic -type StopMessageLiveLocation = "stopMessageLiveLocation" - :> ReqBody '[JSON] StopMessageLiveLocationRequest - :> Post '[JSON] (Response (Either Bool Message)) - --- FIXME: Add Bool returning in case of inline message. - --- | Use this method to stop updating a live --- location message before live_period --- expires. On success, if the message is --- not an inline message, the edited Message --- is returned, otherwise True is returned. -stopMessageLiveLocation :: StopMessageLiveLocationRequest -> ClientM (Response (Either Bool Message)) -stopMessageLiveLocation = client (Proxy @StopMessageLiveLocation) - -- | Request parameters for 'sendVenue'. data SendVenueRequest = SendVenueRequest { sendVenueChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @channelusername) @@ -846,15 +794,6 @@ } deriving Generic -type SendVenue = "sendVenue" - :> ReqBody '[JSON] SendVenueRequest - :> Post '[JSON] (Response Message) - --- | Use this method to send information about a venue. --- On success, the sent Message is returned. -sendVenue :: SendVenueRequest -> ClientM (Response Message) -sendVenue = client (Proxy @SendVenue) - -- | Request parameters for 'sendContact'. data SendContactRequest = SendContactRequest { sendContactChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @channelusername) @@ -870,15 +809,6 @@ } deriving Generic -type SendContact = "sendContact" - :> ReqBody '[JSON] SendContactRequest - :> Post '[JSON] (Response Message) - --- | Use this method to send phone contacts. --- On success, the sent Message is returned. -sendContact :: SendContactRequest -> ClientM (Response Message) -sendContact = client (Proxy @SendContact) - -- | Request parameters for 'sendPoll'. data SendPollRequest = SendPollRequest { sendPollChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @channelusername) @@ -902,15 +832,6 @@ } deriving Generic -type SendPoll = "sendPoll" - :> ReqBody '[JSON] SendPollRequest - :> Post '[JSON] (Response Message) - --- | Use this method to send a native poll. --- On success, the sent Message is returned. -sendPoll :: SendPollRequest -> ClientM (Response Message) -sendPoll = client (Proxy @SendPoll) - -- | Request parameters for 'sendDice'. data SendDiceRequest = SendDiceRequest { sendDiceChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @channelusername) @@ -923,16 +844,6 @@ } deriving Generic -type SendDice = "sendDice" - :> ReqBody '[JSON] SendDiceRequest - :> Post '[JSON] (Response Message) - --- | Use this method to send an animated emoji that --- will display a random value. --- On success, the sent Message is returned. -sendDice :: SendDiceRequest -> ClientM (Response Message) -sendDice = client (Proxy @SendDice) - type SendChatAction = "sendChatAction" :> RequiredQueryParam "chat_id" SomeChatId :> RequiredQueryParam "action" Text @@ -968,15 +879,6 @@ } deriving Generic -type GetUserProfilePhotos = "getUserProfilePhotos" - :> ReqBody '[JSON] GetUserProfilePhotosRequest - :> Post '[JSON] (Response UserProfilePhotos) - --- | Use this method to get a list of profile pictures for a user. --- Returns a UserProfilePhotos object. -getUserProfilePhotos :: GetUserProfilePhotosRequest -> ClientM (Response UserProfilePhotos) -getUserProfilePhotos = client (Proxy @GetUserProfilePhotos) - -- | Request parameters for 'banChatMember'. data BanChatMemberRequest = BanChatMemberRequest { banChatMemberChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @channelusername) @@ -986,23 +888,6 @@ } deriving Generic -type BanChatMember = "banChatMember" - :> ReqBody '[JSON] BanChatMemberRequest - :> Post '[JSON] (Response Bool) - --- | Use this method to ban a user in a --- group, a supergroup or a channel. --- In the case of supergroups and channels, --- the user will not be able to return to --- the chat on their own using invite links, --- etc., unless unbanned first. The bot must --- be an administrator in the chat for this --- to work and must have the appropriate --- administrator rights. --- Returns True on success. -banChatMember :: BanChatMemberRequest -> ClientM (Response Bool) -banChatMember = client (Proxy @BanChatMember) - -- | Request parameters for 'unbanChatMember'. data UnbanChatMemberRequest = UnbanChatMemberRequest { unbanChatMemberChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @channelusername) @@ -1011,26 +896,6 @@ } deriving Generic -type UnbanChatMember = "unbanChatMember" - :> ReqBody '[JSON] UnbanChatMemberRequest - :> Post '[JSON] (Response Bool) - --- | Use this method to unban a previously --- banned user in a supergroup or channel. --- The user will not return to the group --- or channel automatically, but will be --- able to join via link, etc. The bot must --- be an administrator for this to work. By --- default, this method guarantees that after --- the call the user is not a member of the chat, --- but will be able to join it. So if the user is --- a member of the chat they will also be removed --- from the chat. If you don't want this, use the --- parameter only_if_banned. --- Returns True on success. -unbanChatMember :: UnbanChatMemberRequest -> ClientM (Response Bool) -unbanChatMember = client (Proxy @UnbanChatMember) - -- | Request parameters for 'restrictChatMember'. data RestrictChatMemberRequest = RestrictChatMemberRequest { restrictChatMemberChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @channelusername) @@ -1040,21 +905,6 @@ } deriving Generic -type RestrictChatMember = "restrictChatMember" - :> ReqBody '[JSON] RestrictChatMemberRequest - :> Post '[JSON] (Response Bool) - --- | Use this method to restrict a user --- in a supergroup. The bot must be an --- administrator in the supergroup for --- this to work and must have the appropriate --- administrator rights. Pass True for all --- permissions to lift restrictions from a --- user. --- Returns True on success. -restrictChatMember :: RestrictChatMemberRequest -> ClientM (Response Bool) -restrictChatMember = client (Proxy @RestrictChatMember) - -- | Request parameters for 'promoteChatMember'. data PromoteChatMemberRequest = PromoteChatMemberRequest { promoteChatMemberChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @channelusername) @@ -1073,21 +923,6 @@ } deriving Generic -type PromoteChatMember = "promoteChatMember" - :> ReqBody '[JSON] PromoteChatMemberRequest - :> Post '[JSON] (Response Bool) - --- | Use this method to promote or demote --- a user in a supergroup or a channel. --- The bot must be an administrator in --- the chat for this to work and must have --- the appropriate administrator rights. --- Pass False for all boolean parameters --- to demote a user. --- Returns True on success. -promoteChatMember ::PromoteChatMemberRequest -> ClientM (Response Bool) -promoteChatMember = client (Proxy @PromoteChatMember) - -- | Request parameters for 'setChatAdministratorCustomTitle'. data SetChatAdministratorCustomTitleRequest = SetChatAdministratorCustomTitleRequest { setChatAdministratorCustomTitleChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @channelusername) @@ -1096,17 +931,6 @@ } deriving Generic -type SetChatAdministratorCustomTitle = "setChatAdministratorCustomTitle" - :> ReqBody '[JSON] SetChatAdministratorCustomTitleRequest - :> Post '[JSON] (Response Bool) - --- | Use this method to set a custom title --- for an administrator in a supergroup --- promoted by the bot. --- Returns True on success. -setChatAdministratorCustomTitle :: SetChatAdministratorCustomTitleRequest -> ClientM (Response Bool) -setChatAdministratorCustomTitle = client (Proxy @SetChatAdministratorCustomTitle) - type BanChatSenderChat = "banChatSenderChat" :> RequiredQueryParam "chat_id" SomeChatId :> RequiredQueryParam "sender_chat_id" ChatId @@ -1149,19 +973,6 @@ } deriving Generic -type SetChatPermissions = "setChatPermissions" - :> ReqBody '[JSON] SetChatPermissionsRequest - :> Post '[JSON] (Response Bool) - --- | Use this method to set default chat --- permissions for all members. The bot --- must be an administrator in the group --- or a supergroup for this to work and must --- have the can_restrict_members administrator rights. --- Returns True on success. -setChatPermissions :: SetChatPermissionsRequest -> ClientM (Response Bool) -setChatPermissions = client (Proxy @SetChatPermissions) - type ExportChatInviteLink = "exportChatInviteLink" :> RequiredQueryParam "chat_id" SomeChatId :> Post '[JSON] (Response Text) @@ -1187,20 +998,6 @@ } deriving Generic -type CreateChatInviteLink = "createChatInviteLink" - :> ReqBody '[JSON] CreateChatInviteLinkRequest - :> Post '[JSON] (Response ChatInviteLink) - --- | Use this method to create an additional --- invite link for a chat. The bot must be --- an administrator in the chat for this to --- work and must have the appropriate administrator --- rights. The link can be revoked using the --- method revokeChatInviteLink. --- Returns the new invite link as ChatInviteLink object. -createChatInviteLink :: CreateChatInviteLinkRequest -> ClientM (Response ChatInviteLink) -createChatInviteLink = client (Proxy @CreateChatInviteLink) - -- | Request parameters for 'editChatInviteLink'. data EditChatInviteLinkRequest = EditChatInviteLinkRequest { editChatInviteLinkChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @channelusername) @@ -1212,19 +1009,6 @@ } deriving Generic -type EditChatInviteLink = "editChatInviteLink" - :> ReqBody '[JSON] EditChatInviteLinkRequest - :> Post '[JSON] (Response ChatInviteLink) - --- | Use this method to edit a non-primary --- invite link created by the bot. The --- bot must be an administrator in the --- chat for this to work and must have --- the appropriate administrator rights. --- Returns the edited invite link as a ChatInviteLink object. -editChatInviteLink :: EditChatInviteLinkRequest -> ClientM (Response ChatInviteLink) -editChatInviteLink = client (Proxy @EditChatInviteLink) - type RevokeChatInviteLink = "revokeChatInviteLink" :> RequiredQueryParam "chat_id" SomeChatId :> RequiredQueryParam "invite_link" Text @@ -1361,20 +1145,6 @@ } deriving Generic -type PinChatMessage = "pinChatMessage" - :> ReqBody '[JSON] PinChatMessageRequest - :> Post '[JSON] (Response Bool) - --- | Use this method to add a message to the list --- of pinned messages in a chat. If the chat is --- not a private chat, the bot must be an administrator --- in the chat for this to work and must have the --- 'can_pin_messages' administrator right in a supergroup --- or 'can_edit_messages' administrator right in a channel. --- Returns True on success. -pinChatMessage :: PinChatMessageRequest -> ClientM (Response Bool) -pinChatMessage = client (Proxy @PinChatMessage) - type UnpinChatMessage = "unpinChatMessage" :> RequiredQueryParam "chat_id" SomeChatId :> QueryParam "message_id" MessageId @@ -1515,6 +1285,279 @@ } deriving Generic +-- | Request parameters for 'setMyCommands'. +data SetMyCommandsRequest = SetMyCommandsRequest + { setMyCommandsCommands :: [BotCommand] -- ^ A JSON-serialized list of bot commands to be set as the list of the bot's commands. At most 100 commands can be specified. + , setMyCommandsScope :: Maybe BotCommandScope -- ^ A JSON-serialized object, describing scope of users for which the commands are relevant. Defaults to BotCommandScopeDefault. + , setMyCommandsLanguageCode :: Maybe Text -- ^ A two-letter ISO 639-1 language code. If empty, commands will be applied to all users from the given scope, for whose language there are no dedicated commands + } + deriving Generic + +-- | Request parameters for 'deleteMyCommands'. +data DeleteMyCommandsRequest = DeleteMyCommandsRequest + { deleteMyCommandsScope :: Maybe BotCommandScope -- ^ A JSON-serialized object, describing scope of users. Defaults to BotCommandScopeDefault. + , deleteMyCommandsLanguageCode :: Maybe Text -- ^ A two-letter ISO 639-1 language code. If empty, commands will be applied to all users from the given scope, for whose language there are no dedicated commands + } + deriving Generic + +-- | Request parameters for 'getMyCommands'. +data GetMyCommandsRequest = GetMyCommandsRequest + { getMyCommandsScope :: Maybe BotCommandScope -- ^ A JSON-serialized object, describing scope of users. Defaults to BotCommandScopeDefault. + , getMyCommandsLanguageCode :: Maybe Text -- ^ A two-letter ISO 639-1 language code or an empty string + } + deriving Generic + +foldMap deriveJSON' + [ ''GetMyCommandsRequest + , ''DeleteMyCommandsRequest + , ''SetMyCommandsRequest + , ''AnswerCallbackQueryRequest + , ''EditChatInviteLinkRequest + , ''PinChatMessageRequest + , ''CreateChatInviteLinkRequest + , ''SetChatPermissionsRequest + , ''SetChatAdministratorCustomTitleRequest + , ''PromoteChatMemberRequest + , ''RestrictChatMemberRequest + , ''UnbanChatMemberRequest + , ''BanChatMemberRequest + , ''GetUserProfilePhotosRequest + , ''SendDiceRequest + , ''SendPollRequest + , ''SendContactRequest + , ''SendVenueRequest + , ''StopMessageLiveLocationRequest + , ''EditMessageLiveLocationRequest + , ''SendLocationRequest + , ''CopyMessageRequest + ] + +type CopyMessage + = "copyMessage" + :> ReqBody '[JSON] CopyMessageRequest + :> Post '[JSON] (Response MessageId) + +-- | Use this method to copy messages of any kind. +-- Service messages and invoice messages can't be +-- copied. The method is analogous to the method +-- forwardMessage, but the copied message doesn't +-- have a link to the original message. +-- Returns the MessageId of the sent message on success. +copyMessage :: CopyMessageRequest -> ClientM (Response MessageId) +copyMessage = client (Proxy @CopyMessage) + +type SendLocation = "sendLocation" + :> ReqBody '[JSON] SendLocationRequest + :> Post '[JSON] (Response Message) + +-- | Use this method to send point on the map. +-- On success, the sent Message is returned. +sendLocation :: SendLocationRequest -> ClientM (Response Message) +sendLocation = client (Proxy @SendLocation) + +type EditMessageLiveLocation = "editMessageLiveLocation" + :> ReqBody '[JSON] EditMessageLiveLocationRequest + :> Post '[JSON] (Response (Either Bool Message)) + +-- | Use this method to edit live location messages. +-- A location can be edited until its live_period +-- expires or editing is explicitly disabled by a +-- call to stopMessageLiveLocation. On success, if +-- the edited message is not an inline message, the +-- edited Message is returned, otherwise True is returned. +editMessageLiveLocation :: EditMessageLiveLocationRequest -> ClientM (Response (Either Bool Message)) +editMessageLiveLocation = client (Proxy @EditMessageLiveLocation) + +type StopMessageLiveLocation = "stopMessageLiveLocation" + :> ReqBody '[JSON] StopMessageLiveLocationRequest + :> Post '[JSON] (Response (Either Bool Message)) + +-- | Use this method to stop updating a live +-- location message before live_period +-- expires. On success, if the message is +-- not an inline message, the edited Message +-- is returned, otherwise True is returned. +stopMessageLiveLocation :: StopMessageLiveLocationRequest -> ClientM (Response (Either Bool Message)) +stopMessageLiveLocation = client (Proxy @StopMessageLiveLocation) + +type SendVenue = "sendVenue" + :> ReqBody '[JSON] SendVenueRequest + :> Post '[JSON] (Response Message) + +-- | Use this method to send information about a venue. +-- On success, the sent Message is returned. +sendVenue :: SendVenueRequest -> ClientM (Response Message) +sendVenue = client (Proxy @SendVenue) + +type SendContact = "sendContact" + :> ReqBody '[JSON] SendContactRequest + :> Post '[JSON] (Response Message) + +-- | Use this method to send phone contacts. +-- On success, the sent Message is returned. +sendContact :: SendContactRequest -> ClientM (Response Message) +sendContact = client (Proxy @SendContact) + +type SendPoll = "sendPoll" + :> ReqBody '[JSON] SendPollRequest + :> Post '[JSON] (Response Message) + +-- | Use this method to send a native poll. +-- On success, the sent Message is returned. +sendPoll :: SendPollRequest -> ClientM (Response Message) +sendPoll = client (Proxy @SendPoll) + +type SendDice = "sendDice" + :> ReqBody '[JSON] SendDiceRequest + :> Post '[JSON] (Response Message) + +-- | Use this method to send an animated emoji that +-- will display a random value. +-- On success, the sent Message is returned. +sendDice :: SendDiceRequest -> ClientM (Response Message) +sendDice = client (Proxy @SendDice) + +type GetUserProfilePhotos = "getUserProfilePhotos" + :> ReqBody '[JSON] GetUserProfilePhotosRequest + :> Post '[JSON] (Response UserProfilePhotos) + +-- | Use this method to get a list of profile pictures for a user. +-- Returns a UserProfilePhotos object. +getUserProfilePhotos :: GetUserProfilePhotosRequest -> ClientM (Response UserProfilePhotos) +getUserProfilePhotos = client (Proxy @GetUserProfilePhotos) + +type BanChatMember = "banChatMember" + :> ReqBody '[JSON] BanChatMemberRequest + :> Post '[JSON] (Response Bool) + +-- | Use this method to ban a user in a +-- group, a supergroup or a channel. +-- In the case of supergroups and channels, +-- the user will not be able to return to +-- the chat on their own using invite links, +-- etc., unless unbanned first. The bot must +-- be an administrator in the chat for this +-- to work and must have the appropriate +-- administrator rights. +-- Returns True on success. +banChatMember :: BanChatMemberRequest -> ClientM (Response Bool) +banChatMember = client (Proxy @BanChatMember) + +type UnbanChatMember = "unbanChatMember" + :> ReqBody '[JSON] UnbanChatMemberRequest + :> Post '[JSON] (Response Bool) + +-- | Use this method to unban a previously +-- banned user in a supergroup or channel. +-- The user will not return to the group +-- or channel automatically, but will be +-- able to join via link, etc. The bot must +-- be an administrator for this to work. By +-- default, this method guarantees that after +-- the call the user is not a member of the chat, +-- but will be able to join it. So if the user is +-- a member of the chat they will also be removed +-- from the chat. If you don't want this, use the +-- parameter only_if_banned. +-- Returns True on success. +unbanChatMember :: UnbanChatMemberRequest -> ClientM (Response Bool) +unbanChatMember = client (Proxy @UnbanChatMember) + +type RestrictChatMember = "restrictChatMember" + :> ReqBody '[JSON] RestrictChatMemberRequest + :> Post '[JSON] (Response Bool) + +-- | Use this method to restrict a user +-- in a supergroup. The bot must be an +-- administrator in the supergroup for +-- this to work and must have the appropriate +-- administrator rights. Pass True for all +-- permissions to lift restrictions from a +-- user. +-- Returns True on success. +restrictChatMember :: RestrictChatMemberRequest -> ClientM (Response Bool) +restrictChatMember = client (Proxy @RestrictChatMember) + +type PromoteChatMember = "promoteChatMember" + :> ReqBody '[JSON] PromoteChatMemberRequest + :> Post '[JSON] (Response Bool) + +-- | Use this method to promote or demote +-- a user in a supergroup or a channel. +-- The bot must be an administrator in +-- the chat for this to work and must have +-- the appropriate administrator rights. +-- Pass False for all boolean parameters +-- to demote a user. +-- Returns True on success. +promoteChatMember ::PromoteChatMemberRequest -> ClientM (Response Bool) +promoteChatMember = client (Proxy @PromoteChatMember) + +type SetChatAdministratorCustomTitle = "setChatAdministratorCustomTitle" + :> ReqBody '[JSON] SetChatAdministratorCustomTitleRequest + :> Post '[JSON] (Response Bool) + +-- | Use this method to set a custom title +-- for an administrator in a supergroup +-- promoted by the bot. +-- Returns True on success. +setChatAdministratorCustomTitle :: SetChatAdministratorCustomTitleRequest -> ClientM (Response Bool) +setChatAdministratorCustomTitle = client (Proxy @SetChatAdministratorCustomTitle) + +type SetChatPermissions = "setChatPermissions" + :> ReqBody '[JSON] SetChatPermissionsRequest + :> Post '[JSON] (Response Bool) + +-- | Use this method to set default chat +-- permissions for all members. The bot +-- must be an administrator in the group +-- or a supergroup for this to work and must +-- have the can_restrict_members administrator rights. +-- Returns True on success. +setChatPermissions :: SetChatPermissionsRequest -> ClientM (Response Bool) +setChatPermissions = client (Proxy @SetChatPermissions) + +type CreateChatInviteLink = "createChatInviteLink" + :> ReqBody '[JSON] CreateChatInviteLinkRequest + :> Post '[JSON] (Response ChatInviteLink) + +-- | Use this method to create an additional +-- invite link for a chat. The bot must be +-- an administrator in the chat for this to +-- work and must have the appropriate administrator +-- rights. The link can be revoked using the +-- method revokeChatInviteLink. +-- Returns the new invite link as ChatInviteLink object. +createChatInviteLink :: CreateChatInviteLinkRequest -> ClientM (Response ChatInviteLink) +createChatInviteLink = client (Proxy @CreateChatInviteLink) + +type EditChatInviteLink = "editChatInviteLink" + :> ReqBody '[JSON] EditChatInviteLinkRequest + :> Post '[JSON] (Response ChatInviteLink) + +-- | Use this method to edit a non-primary +-- invite link created by the bot. The +-- bot must be an administrator in the +-- chat for this to work and must have +-- the appropriate administrator rights. +-- Returns the edited invite link as a ChatInviteLink object. +editChatInviteLink :: EditChatInviteLinkRequest -> ClientM (Response ChatInviteLink) +editChatInviteLink = client (Proxy @EditChatInviteLink) + +type PinChatMessage = "pinChatMessage" + :> ReqBody '[JSON] PinChatMessageRequest + :> Post '[JSON] (Response Bool) + +-- | Use this method to add a message to the list +-- of pinned messages in a chat. If the chat is +-- not a private chat, the bot must be an administrator +-- in the chat for this to work and must have the +-- 'can_pin_messages' administrator right in a supergroup +-- or 'can_edit_messages' administrator right in a channel. +-- Returns True on success. +pinChatMessage :: PinChatMessageRequest -> ClientM (Response Bool) +pinChatMessage = client (Proxy @PinChatMessage) + type AnswerCallbackQuery = "answerCallbackQuery" :> ReqBody '[JSON] AnswerCallbackQueryRequest :> Post '[JSON] (Response Bool) @@ -1534,14 +1577,6 @@ answerCallbackQuery :: AnswerCallbackQueryRequest -> ClientM (Response Bool) answerCallbackQuery = client (Proxy @AnswerCallbackQuery) --- | Request parameters for 'setMyCommands'. -data SetMyCommandsRequest = SetMyCommandsRequest - { setMyCommandsCommands :: [BotCommand] -- ^ A JSON-serialized list of bot commands to be set as the list of the bot's commands. At most 100 commands can be specified. - , setMyCommandsScope :: Maybe BotCommandScope -- ^ A JSON-serialized object, describing scope of users for which the commands are relevant. Defaults to BotCommandScopeDefault. - , setMyCommandsLanguageCode :: Maybe Text -- ^ A two-letter ISO 639-1 language code. If empty, commands will be applied to all users from the given scope, for whose language there are no dedicated commands - } - deriving Generic - type SetMyCommands = "setMyCommands" :> ReqBody '[JSON] SetMyCommandsRequest :> Post '[JSON] (Response Bool) @@ -1553,13 +1588,6 @@ setMyCommands :: SetMyCommandsRequest -> ClientM (Response Bool) setMyCommands = client (Proxy @SetMyCommands) --- | Request parameters for 'deleteMyCommands'. -data DeleteMyCommandsRequest = DeleteMyCommandsRequest - { deleteMyCommandsScope :: Maybe BotCommandScope -- ^ A JSON-serialized object, describing scope of users. Defaults to BotCommandScopeDefault. - , deleteMyCommandsLanguageCode :: Maybe Text -- ^ A two-letter ISO 639-1 language code. If empty, commands will be applied to all users from the given scope, for whose language there are no dedicated commands - } - deriving Generic - type DeleteMyCommands = "deleteMyCommands" :> ReqBody '[JSON] DeleteMyCommandsRequest :> Post '[JSON] (Response Bool) @@ -1572,13 +1600,6 @@ deleteMyCommands :: DeleteMyCommandsRequest -> ClientM (Response Bool) deleteMyCommands = client (Proxy @DeleteMyCommands) --- | Request parameters for 'getMyCommands'. -data GetMyCommandsRequest = GetMyCommandsRequest - { getMyCommandsScope :: Maybe BotCommandScope -- ^ A JSON-serialized object, describing scope of users. Defaults to BotCommandScopeDefault. - , getMyCommandsLanguageCode :: Maybe Text -- ^ A two-letter ISO 639-1 language code or an empty string - } - deriving Generic - type GetMyCommands = "getMyCommands" :> ReqBody '[JSON] GetMyCommandsRequest :> Post '[JSON] (Response [BotCommand]) @@ -1590,28 +1611,3 @@ -- is returned. getMyCommands :: GetMyCommandsRequest -> ClientM (Response [BotCommand]) getMyCommands = client (Proxy @GetMyCommands) - -foldMap deriveJSON' - [ ''GetMyCommandsRequest - , ''DeleteMyCommandsRequest - , ''SetMyCommandsRequest - , ''AnswerCallbackQueryRequest - , ''EditChatInviteLinkRequest - , ''PinChatMessageRequest - , ''CreateChatInviteLinkRequest - , ''SetChatPermissionsRequest - , ''SetChatAdministratorCustomTitleRequest - , ''PromoteChatMemberRequest - , ''RestrictChatMemberRequest - , ''UnbanChatMemberRequest - , ''BanChatMemberRequest - , ''GetUserProfilePhotosRequest - , ''SendDiceRequest - , ''SendPollRequest - , ''SendContactRequest - , ''SendVenueRequest - , ''StopMessageLiveLocationRequest - , ''EditMessageLiveLocationRequest - , ''SendLocationRequest - , ''CopyMessageRequest - ] diff --git a/src/Telegram/Bot/API/Types.hs b/src/Telegram/Bot/API/Types.hs --- a/src/Telegram/Bot/API/Types.hs +++ b/src/Telegram/Bot/API/Types.hs @@ -223,11 +223,6 @@ | MessageEntityPhoneNumber -- ^ See . deriving (Eq, Show, Generic) -instance ToJSON MessageEntityType where - toJSON = gtoJSON -instance FromJSON MessageEntityType where - parseJSON = gparseJSON - -- ** 'PhotoSize' -- | This object represents one size of a photo or a file / sticker thumbnail. @@ -504,18 +499,6 @@ toJSON (FileUrl t) = toJSON t toJSON (InputFile f _) = toJSON ("attach://" <> pack (takeFileName f)) --- | Multipart file helper -makeFile :: Text -> InputFile -> MultipartData Tmp -> MultipartData Tmp -makeFile name (InputFile path ct) (MultipartData fields files) = - MultipartData - (Input name ("attach://" <> name) : fields) - (FileData name (pack $ takeFileName path) ct path : files) - -makeFile name file (MultipartData fields files) = - MultipartData - (Input name (TL.toStrict $ encodeToLazyText file) : fields) - files - -- ** 'ReplyKeyboardMarkup' -- | This object represents a custom keyboard with reply options (see Introduction to bots for details and examples). @@ -1023,12 +1006,6 @@ } deriving (Generic, Show) -instance ToHttpApiData PassportElementError where - toUrlPiece = TL.toStrict . encodeToLazyText - -instance ToHttpApiData [PassportElementError] where - toUrlPiece = TL.toStrict . encodeToLazyText - -- * Games -- | Your bot can offer users HTML5 games to play solo or to compete against each other in groups and one-on-one chats. Create games via @BotFather using the /newgame command. Please note that this kind of power requires responsibility: you will need to accept the terms for each game that your bots will be offering. @@ -1143,35 +1120,11 @@ } deriving Generic -instance ToJSON InputMediaGeneric where toJSON = gtoJSON - -instance ToMultipart Tmp InputMediaGeneric where - toMultipart InputMediaGeneric{..} = makeFile "media" inputMediaGenericMedia (MultipartData fields []) where - fields = catMaybes - [ inputMediaGenericCaption <&> - \t -> Input "caption" t - , inputMediaGenericParseMode <&> - \t -> Input "parse_mode" t - , inputMediaGenericCaptionEntities <&> - \t -> Input "caption_entities" (TL.toStrict $ encodeToLazyText t) - ] - data InputMediaGenericThumb = InputMediaGenericThumb { inputMediaGenericGeneric :: InputMediaGeneric , inputMediaGenericThumb :: Maybe InputFile -- ^ Thumbnail of the file sent; can be ignored if thumbnail generation for the file is supported server-side. The thumbnail should be in JPEG format and less than 200 kB in size. A thumbnail's width and height should not exceed 320. Ignored if the file is not uploaded using multipart/form-data. Thumbnails can't be reused and can be only uploaded as a new file, so you can pass “attach://” if the thumbnail was uploaded using multipart/form-data under . } -instance ToJSON InputMediaGenericThumb where - toJSON InputMediaGenericThumb{..} - = addJsonFields (toJSON inputMediaGenericGeneric) - ["thumb" .= inputMediaGenericThumb] - -instance ToMultipart Tmp InputMediaGenericThumb where - toMultipart = \case - InputMediaGenericThumb generic Nothing -> toMultipart generic - InputMediaGenericThumb generic (Just thumb) -> makeFile "thumb" thumb (toMultipart generic) where - - data InputMedia = InputMediaPhoto InputMediaGeneric -- ^ Represents a photo to be sent. | InputMediaVideo -- ^ Represents a video to be sent. @@ -1198,6 +1151,98 @@ , inputMediaDocumentDisableContentTypeDetection :: Maybe Bool -- ^ Disables automatic server-side content type detection for files uploaded using multipart/form-data. Always True, if the document is sent as part of an album. } +foldMap deriveJSON' + [ ''User + , ''Chat + , ''Message + , ''MessageEntityType + , ''MessageEntity + , ''PhotoSize + , ''Audio + , ''Document + , ''Sticker + , ''Video + , ''Voice + , ''VideoNote + , ''Contact + , ''Location + , ''Venue + , ''UserProfilePhotos + , ''File + , ''ReplyKeyboardMarkup + , ''KeyboardButton + , ''ReplyKeyboardRemove + , ''InlineKeyboardMarkup + , ''InlineKeyboardButton + , ''CallbackQuery + , ''ForceReply + , ''ChatPhoto + , ''ChatMember + , ''ResponseParameters + , ''MaskPosition + , ''CallbackGame + , ''Animation + , ''Dice + , ''Game + , ''Poll + , ''PollOption + , ''MessageAutoDeleteTimerChanged + , ''Invoice + , ''SuccessfulPayment + , ''OrderInfo + , ''ShippingAddress + , ''PassportData + , ''EncryptedPassportElement + , ''PassportElementType + , ''PassportFile + , ''PassportElementError + , ''PassportErrorSource + , ''EncryptedCredentials + , ''ProximityAlertTriggered + , ''VoiceChatScheduled + , ''VoiceChatStarted + , ''VoiceChatEnded + , ''VoiceChatParticipantsInvited + , ''ChatPermissions + , ''ChatLocation + , ''StickerSet + , ''BotCommand + , ''ChatInviteLink + , ''LabeledPrice + , ''ShippingOption + , ''ShippingQuery + , ''PreCheckoutQuery + ] + +instance ToJSON InputMediaGeneric where toJSON = gtoJSON + +instance ToHttpApiData PassportElementError where + toUrlPiece = TL.toStrict . encodeToLazyText + +instance ToHttpApiData [PassportElementError] where + toUrlPiece = TL.toStrict . encodeToLazyText + +instance ToMultipart Tmp InputMediaGeneric where + toMultipart InputMediaGeneric{..} = makeFile "media" inputMediaGenericMedia (MultipartData fields []) where + fields = catMaybes + [ inputMediaGenericCaption <&> + \t -> Input "caption" t + , inputMediaGenericParseMode <&> + \t -> Input "parse_mode" t + , inputMediaGenericCaptionEntities <&> + \t -> Input "caption_entities" (TL.toStrict $ encodeToLazyText t) + ] + +instance ToJSON InputMediaGenericThumb where + toJSON InputMediaGenericThumb{..} + = addJsonFields (toJSON inputMediaGenericGeneric) + ["thumb" .= inputMediaGenericThumb] + +instance ToMultipart Tmp InputMediaGenericThumb where + toMultipart = \case + InputMediaGenericThumb generic Nothing -> toMultipart generic + InputMediaGenericThumb generic (Just thumb) -> makeFile "thumb" thumb (toMultipart generic) + instance ToJSON InputMedia where toJSON = \case InputMediaPhoto img -> @@ -1280,64 +1325,15 @@ \t -> Input "disable_content_type_detection" (bool "false" "true" t) ]) (toMultipart imgt) -foldMap deriveJSON' - [ ''User - , ''Chat - , ''Message - , ''MessageEntity - , ''PhotoSize - , ''Audio - , ''Document - , ''Sticker - , ''Video - , ''Voice - , ''VideoNote - , ''Contact - , ''Location - , ''Venue - , ''UserProfilePhotos - , ''File - , ''ReplyKeyboardMarkup - , ''KeyboardButton - , ''ReplyKeyboardRemove - , ''InlineKeyboardMarkup - , ''InlineKeyboardButton - , ''CallbackQuery - , ''ForceReply - , ''ChatPhoto - , ''ChatMember - , ''ResponseParameters - , ''MaskPosition - , ''CallbackGame - , ''Animation - , ''Dice - , ''Game - , ''Poll - , ''PollOption - , ''MessageAutoDeleteTimerChanged - , ''Invoice - , ''SuccessfulPayment - , ''OrderInfo - , ''ShippingAddress - , ''PassportData - , ''EncryptedPassportElement - , ''PassportElementType - , ''PassportFile - , ''PassportErrorSource - , ''PassportElementError - , ''EncryptedCredentials - , ''ProximityAlertTriggered - , ''VoiceChatScheduled - , ''VoiceChatStarted - , ''VoiceChatEnded - , ''VoiceChatParticipantsInvited - , ''ChatPermissions - , ''ChatLocation - , ''StickerSet - , ''BotCommand - , ''ChatInviteLink - , ''LabeledPrice - , ''ShippingOption - , ''ShippingQuery - , ''PreCheckoutQuery - ] + +-- | Multipart file helper +makeFile :: Text -> InputFile -> MultipartData Tmp -> MultipartData Tmp +makeFile name (InputFile path ct) (MultipartData fields files) = + MultipartData + (Input name ("attach://" <> name) : fields) + (FileData name (pack $ takeFileName path) ct path : files) + +makeFile name file (MultipartData fields files) = + MultipartData + (Input name (TL.toStrict $ encodeToLazyText file) : fields) + files diff --git a/src/Telegram/Bot/API/UpdatingMessages.hs b/src/Telegram/Bot/API/UpdatingMessages.hs --- a/src/Telegram/Bot/API/UpdatingMessages.hs +++ b/src/Telegram/Bot/API/UpdatingMessages.hs @@ -19,15 +19,6 @@ -- ** 'editMessageText' -type EditMessageText - = "editMessageText" - :> ReqBody '[JSON] EditMessageTextRequest - :> Post '[JSON] (Response (Either Bool Message)) - --- | Use this method to edit text and game messages. On success, if the edited message is not an inline message, the edited 'Message' is returned, otherwise 'True' is returned. -editMessageText :: EditMessageTextRequest -> ClientM (Response (Either Bool Message)) -editMessageText = client (Proxy @EditMessageText) - -- | Request parameters for 'editMessageText'. data EditMessageTextRequest = EditMessageTextRequest { editMessageTextChatId :: Maybe SomeChatId -- ^ Required if 'editMessageTextInlineMessageId' is not specified. Unique identifier for the target chat or username of the target channel (in the format @\@channelusername@). @@ -51,17 +42,6 @@ , editMessageCaptionReplyMarkup :: Maybe SomeReplyMarkup -- ^ Additional interface options. A JSON-serialized object for an inline keyboard, custom reply keyboard, instructions to remove reply keyboard or to force a reply from the user. } deriving (Generic) -type EditMessageCaption = "editMessageCaption" - :> ReqBody '[JSON] EditMessageCaptionRequest - :> Post '[JSON] (Response (Either Bool Message)) - --- | Use this method to edit captions of messages. --- On success, if the edited message is not an --- inline message, the edited Message is returned, --- otherwise True is returned. -editMessageCaption :: EditMessageCaptionRequest -> ClientM (Response (Either Bool Message)) -editMessageCaption = client (Proxy @EditMessageCaption) - -- | Request parameters for 'editMessageMedia'. data EditMessageMediaRequest = EditMessageMediaRequest { editMessageMediaChatId :: Maybe SomeChatId -- ^ Required if 'editMessageMediaMessageId' is not specified. Unique identifier for the target chat or username of the target channel (in the format @\@channelusername@). @@ -73,6 +53,49 @@ instance ToJSON EditMessageMediaRequest where toJSON = gtoJSON +-- | Request parameters for 'editMessageReplyMarkup'. +data EditMessageReplyMarkupRequest = EditMessageReplyMarkupRequest + { editMessageReplyMarkupChatId :: Maybe SomeChatId -- ^ Required if 'editMessageReplyMarkupMessageId' is not specified. Unique identifier for the target chat or username of the target channel (in the format @\@channelusername@). + , editMessageReplyMarkupMessageId :: Maybe MessageId -- ^ Required if 'editMessageReplyMarkupInlineMessageId' is not specified. Identifier of the sent message. + , editMessageReplyMarkupInlineMessageId :: Maybe MessageId -- ^ Required if 'editMessageReplyMarkupChatId' and 'editMessageReplyMarkupMessageId' are not specified. Identifier of the sent message. + , editMessageReplyMarkupReplyMarkup :: Maybe SomeReplyMarkup -- ^ Additional interface options. A JSON-serialized object for an inline keyboard, custom reply keyboard, instructions to remove reply keyboard or to force a reply from the user. +} deriving (Generic) + +-- | Request parameters for 'stopPoll'. +data StopPollRequest = StopPollRequest + { stopPollChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @channelusername) + , stopPollMessageId :: MessageId -- ^ Identifier of the original message with the poll + , stopPollReplyMarkup :: Maybe SomeReplyMarkup -- ^ A JSON-serialized object for a new message inline keyboard. + } deriving (Generic) + +foldMap deriveJSON' + [ ''EditMessageTextRequest + , ''EditMessageCaptionRequest + , ''EditMessageReplyMarkupRequest + , ''StopPollRequest + ] + + +type EditMessageText + = "editMessageText" + :> ReqBody '[JSON] EditMessageTextRequest + :> Post '[JSON] (Response (Either Bool Message)) + +-- | Use this method to edit text and game messages. On success, if the edited message is not an inline message, the edited 'Message' is returned, otherwise 'True' is returned. +editMessageText :: EditMessageTextRequest -> ClientM (Response (Either Bool Message)) +editMessageText = client (Proxy @EditMessageText) + +type EditMessageCaption = "editMessageCaption" + :> ReqBody '[JSON] EditMessageCaptionRequest + :> Post '[JSON] (Response (Either Bool Message)) + +-- | Use this method to edit captions of messages. +-- On success, if the edited message is not an +-- inline message, the edited Message is returned, +-- otherwise True is returned. +editMessageCaption :: EditMessageCaptionRequest -> ClientM (Response (Either Bool Message)) +editMessageCaption = client (Proxy @EditMessageCaption) + type EditMessageMedia = "editMessageMedia" :> ReqBody '[JSON] EditMessageMediaRequest :> Post '[JSON] (Response (Either Bool Message)) @@ -90,15 +113,7 @@ editMessageMedia :: EditMessageMediaRequest -> ClientM (Response (Either Bool Message)) editMessageMedia = client (Proxy @EditMessageMedia) --- | Request parameters for 'editMessageReplyMarkup'. -data EditMessageReplyMarkupRequest = EditMessageReplyMarkupRequest - { editMessageReplyMarkupChatId :: Maybe SomeChatId -- ^ Required if 'editMessageReplyMarkupMessageId' is not specified. Unique identifier for the target chat or username of the target channel (in the format @\@channelusername@). - , editMessageReplyMarkupMessageId :: Maybe MessageId -- ^ Required if 'editMessageReplyMarkupInlineMessageId' is not specified. Identifier of the sent message. - , editMessageReplyMarkupInlineMessageId :: Maybe MessageId -- ^ Required if 'editMessageReplyMarkupChatId' and 'editMessageReplyMarkupMessageId' are not specified. Identifier of the sent message. - , editMessageReplyMarkupReplyMarkup :: Maybe SomeReplyMarkup -- ^ Additional interface options. A JSON-serialized object for an inline keyboard, custom reply keyboard, instructions to remove reply keyboard or to force a reply from the user. -} deriving (Generic) - type EditMessageReplyMarkup = "editMessageReplyMarkup" :> ReqBody '[JSON] EditMessageReplyMarkupRequest :> Post '[JSON] (Response (Either Bool Message)) @@ -109,14 +124,6 @@ editMessageReplyMarkup :: EditMessageReplyMarkupRequest -> ClientM (Response (Either Bool Message)) editMessageReplyMarkup = client (Proxy @EditMessageReplyMarkup) --- | Request parameters for 'stopPoll'. -data StopPollRequest = StopPollRequest - { stopPollChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @channelusername) - , stopPollMessageId :: MessageId -- ^ Identifier of the original message with the poll - , stopPollReplyMarkup :: Maybe SomeReplyMarkup -- ^ A JSON-serialized object for a new message inline keyboard. - } deriving (Generic) - - type StopPoll = "stopPoll" :> ReqBody '[JSON] StopPollRequest :> Post '[JSON] (Response Poll) @@ -127,9 +134,3 @@ stopPoll = client (Proxy @StopPoll) -foldMap deriveJSON' - [ ''EditMessageTextRequest - , ''EditMessageCaptionRequest - , ''EditMessageReplyMarkupRequest - , ''StopPollRequest - ] diff --git a/telegram-bot-simple.cabal b/telegram-bot-simple.cabal --- a/telegram-bot-simple.cabal +++ b/telegram-bot-simple.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: telegram-bot-simple -version: 0.4.1 +version: 0.4.2 synopsis: Easy to use library for building Telegram bots. description: Please see the README on Github at category: Web