telegram-bot-simple 0.5.2 → 0.6
raw patch · 10 files changed
+463/−22 lines, 10 filesdep +warp-tlsnew-component:exe:example-echo-bot-webhook
Dependencies added: warp-tls
Files
- CHANGELOG.md +17/−0
- examples/EchoBotWebhook.hs +123/−0
- src/Telegram/Bot/API/Methods.hs +5/−5
- src/Telegram/Bot/API/Payments.hs +38/−0
- src/Telegram/Bot/API/Stickers.hs +31/−0
- src/Telegram/Bot/API/Types.hs +26/−8
- src/Telegram/Bot/API/Webhook.hs +122/−0
- src/Telegram/Bot/Simple/BotApp.hs +36/−0
- src/Telegram/Bot/Simple/UpdateParser.hs +10/−8
- telegram-bot-simple.cabal +55/−1
CHANGELOG.md view
@@ -1,3 +1,20 @@+0.6+---++- Fix newlines unexpected removing in `UpdateParser` module (see [#124](https://github.com/fizruk/telegram-bot-simple/pull/124));+- Add WebHooks support (see [#127](https://github.com/fizruk/telegram-bot-simple/pull/127));+- Fix `parse_mode` encoding in `sendPhoto`, `sendDocument`, `sendVideo` and `sendAnimation` methods (see [#123](https://github.com/fizruk/telegram-bot-simple/pull/123) and [5ee5289](https://github.com/fizruk/telegram-bot-simple/commit/5ee5289f711381a1f1e0daf540bc6c041e3cb275));+- Make package complaint with Telegram Bot API 6.2 (breaking changes included) (see [fab1aee](https://github.com/fizruk/telegram-bot-simple/commit/fab1aee308afc59663013a796ebff7a3f99c8201)):++ - Added `createInvoiceLink` method;+ - Added `getCustomEmojiStickers` method;+ - `User` extended with `is_premium` and `added_to_attachment_menu`;+ - `Chat` extended with `has_restricted_voice_and_video_messages`, `join_to_send_messages`, `join_by_request`;+ - `MessageEntityType` extended with `custom_emoji`;+ `file_size` field for `Animation`, `Audio`, `Document`, `Video`, `VideoNote` `Voice`, `File` changed from `Int` to `Integer`;+ - `SticketSet` modified: `contains_masks` is optional now and becoming a subject of further deprecation in a future, `type` added;+ - Added `StickerSetType`: could be `regular`, `mask` and `custom_emoji`.+ 0.5.2 ---
+ examples/EchoBotWebhook.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Data.Maybe+import Data.Text (Text)+import qualified Data.Text as Text++import Telegram.Bot.API+import Telegram.Bot.API.InlineMode.InlineQueryResult+import Telegram.Bot.API.InlineMode.InputMessageContent (defaultInputTextMessageContent)+import Telegram.Bot.API.Webhook+import Telegram.Bot.Simple+import Telegram.Bot.Simple.BotApp (WebhookConfig (WebhookConfig))+import Telegram.Bot.Simple.UpdateParser (updateMessageSticker,+ updateMessageText)++import Network.Wai.Handler.Warp (Port,+ defaultSettings,+ setPort)+import Network.Wai.Handler.WarpTLS (OnInsecure (AllowInsecure),+ TLSSettings (onInsecure),+ tlsSettings)++type Model = ()++data Action+ = InlineEcho InlineQueryId Text+ | StickerEcho InputFile ChatId+ | Echo Text++echoBot :: BotApp Model Action+echoBot = BotApp+ { botInitialModel = ()+ , botAction = updateToAction+ , botHandler = handleAction+ , botJobs = []+ }++updateToAction :: Update -> Model -> Maybe Action+updateToAction update _+ | isJust $ updateInlineQuery update = do+ query <- updateInlineQuery update+ let queryId = inlineQueryId query+ let msg = inlineQueryQuery query+ Just $ InlineEcho queryId msg+ | isJust $ updateMessageSticker update = do+ fileId <- stickerFileId <$> updateMessageSticker update+ chatId <- updateChatId update+ pure $ StickerEcho (InputFileId fileId) chatId+ | otherwise = case updateMessageText update of+ Just text -> Just (Echo text)+ Nothing -> Nothing++handleAction :: Action -> Model -> Eff Action Model+handleAction action model = case action of+ InlineEcho queryId msg -> model <# do+ let result = InlineQueryResult InlineQueryResultArticle (InlineQueryResultId msg) (Just msg) (Just (defaultInputTextMessageContent msg)) Nothing+ answerInlineQueryRequest = AnswerInlineQueryRequest+ { answerInlineQueryRequestInlineQueryId = queryId+ , answerInlineQueryRequestResults = [result]+ , answerInlineQueryCacheTime = Nothing+ , answerInlineQueryIsPersonal = Nothing+ , answerInlineQueryNextOffset = Nothing+ , answerInlineQuerySwitchPmText = Nothing+ , answerInlineQuerySwitchPmParameter = Nothing+ }+ _ <- liftClientM (answerInlineQuery answerInlineQueryRequest)+ return ()+ StickerEcho file chat -> model <# do+ _ <- liftClientM+ (sendSticker+ (SendStickerRequest+ (SomeChatId chat)+ file+ Nothing+ Nothing+ Nothing+ Nothing+ Nothing))+ return ()+ Echo msg -> model <# do+ pure msg -- or replyText msg++run :: Token -> FilePath -> FilePath -> Port -> String -> IO ()+run token certPath keyPath port ip = do+ env <- defaultTelegramClientEnv token+ res <- startBotWebhook bot config env+ print res+ where+ bot = conversationBot updateChatId echoBot+ tlsOpts = (tlsSettings certPath keyPath) {onInsecure = AllowInsecure}+ warpOpts = setPort port defaultSettings+ certFile = Just $ InputFile certPath "application/x-pem-file"+ url = "https://" ++ ip ++ ":" ++ show port+ config = WebhookConfig+ { webhookConfigTlsSettings = tlsOpts,+ webhookConfigTlsWarpSettings = warpOpts,+ webhookConfigSetWebhookRequest = requestData+ }+ requestData =+ SetWebhookRequest+ { setWebhookUrl = url,+ setWebhookCertificate = certFile,+ setWebhookIpAddress = Nothing,+ setWebhookMaxConnections = Nothing,+ setWebhookAllowedUpdates = Just ["message"],+ setWebhookDropPendingUpdates = Nothing,+ setWebhookSecretToken = Nothing+ }++main :: IO ()+main = do+ putStrLn "Please, enter Telegram bot's API token:"+ token <- Token . Text.pack <$> getLine+ putStrLn "Please, enter a path to certificate:"+ cert <- getLine+ putStrLn "Please, enter a path to key:"+ key <- getLine+ putStrLn "Please, enter port(80, 88, 443, 8443):"+ port <- read <$> getLine+ putStrLn "Please, enter ip:"+ ip <- getLine+ run token cert key port ip
src/Telegram/Bot/API/Methods.hs view
@@ -287,7 +287,7 @@ ] <> ( (maybe id (\_ -> ((Input "thumb" "attach://thumb"):)) sendPhotoThumb) $ (maybe id (\t -> ((Input "caption" t):)) sendPhotoCaption)- $ (maybe id (\t -> ((Input "parse_mode" (TL.toStrict $ encodeToLazyText t)):)) sendPhotoParseMode)+ $ (maybe id (\t -> ((Input "parse_mode" (TL.toStrict . TL.replace "\"" "" $ encodeToLazyText t)):)) sendPhotoParseMode) $ (maybe id (\t -> ((Input "caption_entities" (TL.toStrict $ encodeToLazyText t)):)) sendPhotoCaptionEntities) $ (maybe id (\t -> ((Input "disable_notification" (bool "false" "true" t)):)) sendPhotoDisableNotification) $ (maybe id (\t -> ((Input "reply_to_message_id" (TL.toStrict $ encodeToLazyText t)):)) sendPhotoReplyToMessageId)@@ -364,7 +364,7 @@ [ sendAudioCaption <&> \t -> Input "caption" t , sendAudioParseMode <&>- \t -> Input "parse_mode" (TL.toStrict $ encodeToLazyText t)+ \t -> Input "parse_mode" (TL.toStrict . TL.replace "\"" "" $ encodeToLazyText t) , sendAudioCaptionEntities <&> \t -> Input "caption_entities" (TL.toStrict $ encodeToLazyText t) , sendAudioDuration <&>@@ -449,7 +449,7 @@ [ sendVideoCaption <&> \t -> Input "caption" t , sendVideoParseMode <&>- \t -> Input "parse_mode" (TL.toStrict $ encodeToLazyText t)+ \t -> Input "parse_mode" (TL.toStrict . TL.replace "\"" "" $ encodeToLazyText t) , sendVideoCaptionEntities <&> \t -> Input "caption_entities" (TL.toStrict $ encodeToLazyText t) , sendVideoDuration <&>@@ -532,7 +532,7 @@ [ sendAnimationCaption <&> \t -> Input "caption" t , sendAnimationParseMode <&>- \t -> Input "parse_mode" (TL.toStrict $ encodeToLazyText t)+ \t -> Input "parse_mode" (TL.toStrict . TL.replace "\"" "" $ encodeToLazyText t) , sendAnimationCaptionEntities <&> \t -> Input "caption_entities" (TL.toStrict $ encodeToLazyText t) , sendAnimationDuration <&>@@ -608,7 +608,7 @@ [ sendVoiceCaption <&> \t -> Input "caption" t , sendVoiceParseMode <&>- \t -> Input "parse_mode" (TL.toStrict $ encodeToLazyText t)+ \t -> Input "parse_mode" (TL.toStrict . TL.replace "\"" "" $ encodeToLazyText t) , sendVoiceCaptionEntities <&> \t -> Input "caption_entities" (TL.toStrict $ encodeToLazyText t) , sendVoiceDuration <&>
src/Telegram/Bot/API/Payments.hs view
@@ -62,6 +62,44 @@ sendInvoice :: SendInvoiceRequest -> ClientM (Response Message) sendInvoice = client (Proxy @SendInvoice) +-- ** 'createInvoiceLink'++data CreateInvoiceLinkRequest = CreateInvoiceLinkRequest+ { createInvoiceLinkRequestTitle :: Text -- ^ Product name, 1-32 characters.+ , createInvoiceLinkRequestDescription :: Text -- ^ Product description, 1-255 characters.+ , createInvoiceLinkRequestPayload :: Text -- ^ Bot-defined invoice payload, 1-128 bytes. This will not be displayed to the user, use for your internal processes.+ , createInvoiceLinkRequestProviderToken :: Text -- ^ Payment provider token, obtained via BotFather.+ , createInvoiceLinkRequestCurrency :: Text -- ^ Three-letter ISO 4217 currency code, see more on currencies.+ , createInvoiceLinkRequestPrices :: [LabeledPrice] -- ^ Price breakdown, a JSON-serialized list of components (e.g. product price, tax, discount, delivery cost, delivery tax, bonus, etc.).+ , createInvoiceLinkRequestMaxTipAmount :: Maybe Integer -- ^ The maximum accepted amount for tips in the smallest units of the currency (integer, not float\/double). For example, for a maximum tip of US$ 1.45 pass max_tip_amount = 145. See the exp parameter in currencies.json, it shows the number of digits past the decimal point for each currency (2 for the majority of currencies). Defaults to 0.+ , createInvoiceLinkRequestSuggestedTipAmounts :: Maybe [Integer] -- ^ A JSON-serialized array of suggested amounts of tips in the smallest units of the currency (integer, not float\/double). At most 4 suggested tip amounts can be specified. The suggested tip amounts must be positive, passed in a strictly increased order and must not exceed @max_tip_amount@.+ , createInvoiceLinkRequestProviderData :: Maybe Text -- ^ JSON-serialized data about the invoice, which will be shared with the payment provider. A detailed description of required fields should be provided by the payment provider.+ , createInvoiceLinkRequestPhotoUrl :: Maybe Text -- ^ URL of the product photo for the invoice. Can be a photo of the goods or a marketing image for a service.+ , createInvoiceLinkRequestPhotoSize :: Maybe Int -- ^ Photo size in bytes.+ , createInvoiceLinkRequestPhotoWidth :: Maybe Int -- ^ Photo width.+ , createInvoiceLinkRequestPhotoHeight :: Maybe Int -- ^ Photo height+ , createInvoiceLinkRequestNeedName :: Maybe Bool -- ^ Pass 'True' if you require the user's full name to complete the order.+ , createInvoiceLinkRequestNeedPhoneNumber :: Maybe Bool -- ^ Pass 'True' if you require the user's phone number to complete the order.+ , createInvoiceLinkRequestNeedEmail :: Maybe Bool -- ^ Pass 'True' if you require the user's email address to complete the order.+ , createInvoiceLinkRequestNeedShippingAddress :: Maybe Bool -- ^ Pass 'True' if you require the user's shipping address to complete the order.+ , createInvoiceLinkRequestSendPhoneNumberToProvider :: Maybe Bool -- ^ Pass 'True' if the user's phone number should be sent to the provider.+ , createInvoiceLinkRequestSendEmailToProvider :: Maybe Bool -- ^ Pass 'True' if the user's email address should be sent to the provider.+ , createInvoiceLinkRequestIsFlexible :: Maybe Bool -- ^ Pass 'True' if the final price depends on the shipping method.+ }+ deriving (Generic, Show)++instance ToJSON CreateInvoiceLinkRequest where toJSON = gtoJSON+instance FromJSON CreateInvoiceLinkRequest where parseJSON = gparseJSON++type CreateInvoiceLink+ = "createInvoiceLink"+ :> ReqBody '[JSON] CreateInvoiceLinkRequest+ :> Post '[JSON] (Response Text)++-- | Use this method to create a link for an invoice. Returns the created invoice link as 'Text' on success.+createInvoiceLink :: CreateInvoiceLinkRequest -> ClientM (Response Text)+createInvoiceLink = client (Proxy @CreateInvoiceLink)+ -- ** 'answerShippingQuery' data AnswerShippingQueryRequest = AnswerShippingQueryRequest
src/Telegram/Bot/API/Stickers.hs view
@@ -17,6 +17,7 @@ #endif import Data.Aeson.Text import Data.Bool+import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Data.Proxy@@ -48,6 +49,8 @@ -- | Sticker file with static/animated label. data StickerFile = StickerFile {stickerFileSticker :: InputFile, stickerFileLabel :: StickerType} +-- ** 'sendSticker'+ -- | Request parameters for 'sendSticker'. data SendStickerRequest = SendStickerRequest { sendStickerChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @channelusername)@@ -100,7 +103,23 @@ client (Proxy @SendStickerContent) (boundary, r) _ -> client (Proxy @SendStickerLink) r +-- ** 'getCustomEmojiStickers' +-- | Request parameters for 'getCustomEmojiStickers'.+data GetCustomEmojiStickersRequest = GetCustomEmojiStickersRequest+ { getCustomEmojiStickersRequestCustomEmojiIds :: [Text] -- ^ List of custom emoji identifiers. At most 200 custom emoji identifiers can be specified.+ }+ deriving Generic++instance ToJSON GetCustomEmojiStickersRequest where toJSON = gtoJSON++type GetCustomEmojiStickers+ = "getCustomEmojiStickers"+ :> ReqBody '[JSON] GetCustomEmojiStickersRequest+ :> Post '[JSON] (Response [Sticker])++-- ** 'uploadStickerFile'+ -- | Request parameters for 'uploadStickerFile'. data UploadStickerFileRequest = UploadStickerFileRequest { uploadStickerFileUserId :: UserId -- ^ User identifier of sticker file owner@@ -137,6 +156,8 @@ _ -> client (Proxy @UploadStickerFileLink) r +-- ** 'createNewStickerSet'+ -- | Request parameters for 'createNewStickerSet'. data CreateNewStickerSetRequest = CreateNewStickerSetRequest { createNewStickerSetUserId :: UserId -- ^ User identifier of created sticker set owner@@ -204,6 +225,8 @@ client (Proxy @CreateNewStickerSetContent) (boundary, r) _ -> client (Proxy @CreateNewStickerSetLink) r +-- ** 'addStickerToSet'+ -- | Request parameters for 'addStickerToSet'. data AddStickerToSetRequest = AddStickerToSetRequest { addStickerToSetUserId :: UserId -- ^ User identifier of sticker set owner@@ -267,6 +290,8 @@ _ -> client (Proxy @AddStickerToSetLink) r +-- ** 'getStickerSet'+ type GetStickerSet = "getStickerSet" :> RequiredQueryParam "name" T.Text@@ -277,6 +302,8 @@ -> ClientM (Response StickerSet) getStickerSet = client (Proxy @GetStickerSet) +-- ** 'setStickerPositionInSet'+ type SetStickerPositionInSet = "setStickerPositionInSet" :> RequiredQueryParam "sticker" T.Text@@ -291,6 +318,8 @@ setStickerPositionInSet = client (Proxy @SetStickerPositionInSet) +-- ** 'deleteStickerFromSet'+ type DeleteStickerFromSet = "deleteStickerFromSet" :> RequiredQueryParam "sticker" T.Text@@ -301,6 +330,8 @@ deleteStickerFromSet :: T.Text -- ^ File identifier of the sticker -> ClientM (Response Bool) deleteStickerFromSet = client (Proxy @DeleteStickerFromSet)++-- ** 'setStickerSetThumb' -- | Request parameters for 'setStickerSetThumb'. data SetStickerSetThumbRequest = SetStickerSetThumbRequest
src/Telegram/Bot/API/Types.hs view
@@ -52,6 +52,8 @@ , userLastName :: Maybe Text -- ^ User‘s or bot’s last name. , userUsername :: Maybe Text -- ^ User‘s or bot’s username. , userLanguageCode :: Maybe Text -- ^ IETF language tag of the user's language.+ , userIsPremium :: Maybe Bool -- ^ 'True', if this user is a Telegram Premium user.+ , userAddedToAttachmentMenu :: Maybe Bool -- ^ 'True', if this user added the bot to the attachment menu. , userCanJoinGroups :: Maybe Bool -- ^ 'True', if the bot can be invited to groups. Returned only in `getMe`. , userCanReadAllGroupMessages :: Maybe Bool -- ^ 'True', if privacy mode is disabled for the bot. Returned only in `getMe`. , userSupportsInlineQueries :: Maybe Bool -- ^ 'True', if the bot supports inline queries. Returned only in `getMe`.@@ -80,6 +82,9 @@ , chatPhoto :: Maybe ChatPhoto -- ^ Chat photo. Returned only in getChat. , chatBio :: Maybe Text -- ^ Bio of the other party in a private chat. Returned only in `getChat`. , chatHasPrivateForwards :: Maybe Bool -- ^ 'True', if privacy settings of the other party in the private chat allows to use `tg://user?id=<user_id>` links only in chats with the user. Returned only in getChat.+ , chatHasRestrictedVoiceAndVideoMessages :: Maybe Bool -- ^ 'True', if the privacy settings of the other party restrict sending voice and video note messages in the private chat. Returned only in 'getChat'.+ , chatJoinToSendMessages :: Maybe Bool -- ^ 'True', if users need to join the supergroup before they can send messages. Returned only in 'getChat'.+ , chatJoinByRequest :: Maybe Bool -- ^ 'True', if all users directly joining the supergroup need to be approved by supergroup administrators. Returned only in 'getChat'. , chatDescription :: Maybe Text -- ^ Description, for supergroups and channel chats. Returned only in getChat. , chatInviteLink :: Maybe Text -- ^ Chat invite link, for supergroups and channel chats. Returned only in getChat. , chatPinnedMessage :: Maybe Message -- ^ Pinned message, for supergroups. Returned only in getChat.@@ -201,6 +206,7 @@ , messageEntityUrl :: Maybe Text -- ^ For “text_link” only, url that will be opened after user taps on the text , messageEntityUser :: Maybe User -- ^ For “text_mention” only, the mentioned user , messageEntityLanguage :: Maybe Text -- ^ For “pre” only, the programming language of the entity text.+ , messageEntityCustomEmojiId :: Maybe Text -- ^ For “custom_emoji” only, unique identifier of the custom emoji. Use @getCustomEmojiStickers@ to get full information about the sticker. } deriving (Generic, Show) @@ -222,6 +228,7 @@ | MessageEntityCashtag -- ^ See <https://core.telegram.org/tdlib/docs/classtd_1_1td__api_1_1text_entity_type_cashtag.html>. | MessageEntityPhoneNumber -- ^ See <https://core.telegram.org/tdlib/docs/classtd_1_1td__api_1_1text_entity_type_phone_number.html>. | MessageEntitySpoiler+ | MessageEntityCustomEmoji deriving (Eq, Show, Generic) -- ** 'PhotoSize'@@ -255,7 +262,7 @@ , animationThumb :: Maybe PhotoSize -- ^ Animation thumbnail as defined by sender. , animationFileName :: Maybe Text -- ^ Original animation filename as defined by sender. , animationMimeType :: Maybe Text -- ^ MIME type of the file as defined by sender.- , animationFileSize :: Maybe Int -- ^ File size in bytes.+ , animationFileSize :: Maybe Integer -- ^ File size in bytes. } deriving (Generic, Show) @@ -270,7 +277,7 @@ , audioTitle :: Maybe Text -- ^ Title of the audio as defined by sender or by audio tags. , audioFileName :: Maybe Text -- ^ Original filename as defined by sender. , audioMimeType :: Maybe Text -- ^ MIME type of the file as defined by sender.- , audioFileSize :: Maybe Int -- ^ File size in bytes.+ , audioFileSize :: Maybe Integer -- ^ File size in bytes. , audioThumb :: Maybe PhotoSize -- ^ Thumbnail of the album cover to which the music file belongs. } deriving (Generic, Show)@@ -284,7 +291,7 @@ , documentThumb :: Maybe PhotoSize -- ^ Document thumbnail as defined by sender. , documentFileName :: Maybe Text -- ^ Original filename as defined by sender. , documentMimeType :: Maybe Text -- ^ MIME type of the file as defined by sender.- , documentFileSize :: Maybe Int -- ^ File size in bytes. + , documentFileSize :: Maybe Integer -- ^ File size in bytes. } deriving (Generic, Show) @@ -300,7 +307,7 @@ , videoThumb :: Maybe PhotoSize -- ^ Video thumbnail. , videoFileName :: Maybe Text -- ^ Original filename as defined by sender. , videoMimeType :: Maybe Text -- ^ Mime type of a file as defined by sender.- , videoFileSize :: Maybe Int -- ^ File size in bytes.+ , videoFileSize :: Maybe Integer -- ^ File size in bytes. } deriving (Generic, Show) @@ -313,7 +320,7 @@ , videoNoteLength :: Int -- ^ Video width and height as defined by sender. , videoNoteDuration :: Seconds -- ^ Duration of the video in seconds as defined by sender. , videoNoteThumb :: Maybe PhotoSize -- ^ Video thumbnail.- , videoNoteFileSize :: Maybe Int -- ^ File size in bytes.+ , videoNoteFileSize :: Maybe Integer -- ^ File size in bytes. } deriving (Generic, Show) @@ -325,7 +332,7 @@ , voiceFileUniqueId :: FileId -- ^ Unique identifier for this file, which is supposed to be the same over time and for different bots. Can't be used to download or reuse the file. , voiceDuration :: Seconds -- ^ Duration of the audio in seconds as defined by sender. , voiceMimeType :: Maybe Text -- ^ MIME type of the file as defined by sender.- , voiceFileSize :: Maybe Int -- ^ File size in bytes.+ , voiceFileSize :: Maybe Integer -- ^ File size in bytes. } deriving (Generic, Show) @@ -491,7 +498,7 @@ data File = File { fileFileId :: FileId -- ^ Unique identifier for this file. , fileFileUniqueId :: FileId -- ^ Unique identifier for this file, which is supposed to be the same over time and for different bots. Can't be used to download or reuse the file.- , fileFileSize :: Maybe Int -- ^ File size in bytes, if known.+ , fileFileSize :: Maybe Integer -- ^ File size in bytes, if known. , fileFilePath :: Maybe Text -- ^ File path. Use https://api.telegram.org/file/bot<token>/<file_path> to get the file. } deriving (Generic, Show)@@ -829,7 +836,9 @@ , stickerThumb :: Maybe PhotoSize -- ^ Sticker thumbnail in the .WEBP or .JPG format. , stickerEmoji :: Maybe Text -- ^ Emoji associated with the sticker. , stickerSetName :: Maybe Text -- ^ Name of the sticker set to which the sticker belongs.+ , stickerPremiumAnimation :: Maybe File -- ^ For premium regular stickers, premium animation for the sticker. , stickerMaskPosition :: Maybe MaskPosition -- ^ For mask stickers, the position where the mask should be placed.+ , stickerCustomEmojiId :: Maybe Text -- ^ For custom emoji stickers, unique identifier of the custom emoji. , stickerFileSize :: Maybe Integer -- ^ File size in bytes. } deriving (Generic, Show)@@ -840,14 +849,22 @@ data StickerSet = StickerSet { stickerSetName :: Text -- ^ Sticker set name. , stickerSetTitle :: Text -- ^ Sticker set title.+ , stickerSetType :: StickerSetType -- ^ Type of stickers in the set, currently one of “regular”, “mask”, “custom_emoji”. , stickerSetIsAnimated :: Bool -- ^ 'True', if the sticker set contains animated stickers. , stickerSetIsVideo :: Bool -- ^ 'True', if the sticker is a video sticker.- , stickerSetContainsMasks :: Bool -- ^ True, if the sticker set contains masks.+ , stickerSetContainsMasks :: Maybe Bool -- ^ True, if the sticker set contains masks. , stickerSetStickers :: [Sticker] -- ^ List of all set stickers. , stickerSetThumb :: Maybe PhotoSize -- ^ Sticker set thumbnail in the .WEBP or .TGS format. } deriving (Generic, Show) +-- | Type of stickers in the set, currently one of “regular”, “mask”, “custom_emoji”.+data StickerSetType+ = StickerSetTypeRegular+ | StickerSetTypeMask+ | StickerSetTypeCustomEmoji+ deriving (Eq, Show, Generic)+ -- ** 'MaskPosition' -- | This object describes the position on faces where a mask should be placed by default.@@ -1217,6 +1234,7 @@ , ''PhotoSize , ''Audio , ''Document+ , ''StickerSetType , ''Sticker , ''Video , ''Voice
+ src/Telegram/Bot/API/Webhook.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}++module Telegram.Bot.API.Webhook+ ( setUpWebhook,+ webhookApp,+ deleteWebhook,+ SetWebhookRequest (..),+ )+where++import Control.Concurrent (forkIO)+import Control.Concurrent.STM+import Control.Monad.IO.Class (MonadIO (liftIO))+import Data.Aeson (ToJSON (toJSON))+import Data.Bool (bool)+import Data.Functor (void, (<&>))+import Data.Maybe (catMaybes, fromJust,+ isJust)+import qualified Data.Text as Text+import GHC.Generics (Generic)+import Servant+import Servant.Client (ClientEnv, ClientError,+ client, runClientM)+import Servant.Multipart.API+import Servant.Multipart.Client (genBoundary)+import Telegram.Bot.API.GettingUpdates (Update)+import Telegram.Bot.API.Internal.Utils (gtoJSON)+import Telegram.Bot.API.MakingRequests (Response)+import Telegram.Bot.API.Types (InputFile, makeFile)+import Telegram.Bot.Simple.BotApp.Internal++type WebhookAPI = ReqBody '[JSON] Update :> Post '[JSON] ()++server :: BotApp model action -> BotEnv model action -> Server WebhookAPI+server BotApp {..} botEnv@BotEnv {..} =+ updateHandler+ where+ updateHandler :: Update -> Handler ()+ updateHandler update = liftIO $ handleUpdate update+ handleUpdate update = liftIO . void . forkIO $ do+ maction <- botAction update <$> readTVarIO botModelVar+ case maction of+ Nothing -> return ()+ Just action -> issueAction botEnv (Just update) (Just action)++webhookAPI :: Proxy WebhookAPI+webhookAPI = Proxy++app :: BotApp model action -> BotEnv model action -> Application+app botApp botEnv = serve webhookAPI $ server botApp botEnv++data SetWebhookRequest = SetWebhookRequest+ { setWebhookUrl :: String,+ setWebhookCertificate :: Maybe InputFile,+ setWebhookIpAddress :: Maybe String,+ setWebhookMaxConnections :: Maybe Int,+ setWebhookAllowedUpdates :: Maybe [String],+ setWebhookDropPendingUpdates :: Maybe Bool,+ setWebhookSecretToken :: Maybe String+ }+ deriving (Generic)++instance ToJSON SetWebhookRequest where toJSON = gtoJSON++newtype DeleteWebhookRequest = DeleteWebhookRequest+ { deleteWebhookDropPendingUpdates :: Maybe Bool+ }+ deriving (Generic)++instance ToJSON DeleteWebhookRequest where toJSON = gtoJSON++instance ToMultipart Tmp SetWebhookRequest where+ toMultipart SetWebhookRequest {..} =+ makeFile "certificate" (fromJust setWebhookCertificate) (MultipartData fields [])+ where+ fields =+ [Input "url" $ Text.pack setWebhookUrl]+ <> catMaybes+ [ setWebhookSecretToken <&> \t -> Input "secret_token" $ Text.pack t,+ setWebhookIpAddress <&> \t -> Input "ip_address" $ Text.pack t,+ setWebhookMaxConnections <&> \t -> Input "max_connections" $ Text.pack $ show t,+ setWebhookDropPendingUpdates <&> \t -> Input "drop_pending_updates" (bool "false" "true" t),+ setWebhookAllowedUpdates <&> \t -> Input "allowed_updates" (arrToJson t)+ ]+ arrToJson arr = Text.intercalate "" ["[", Text.intercalate "," (map (\s -> Text.pack $ "\"" ++ s ++ "\"") arr), "]"]++type SetWebhookForm =+ "setWebhook" :> MultipartForm Tmp SetWebhookRequest :> Get '[JSON] (Response Bool)++type SetWebhookJson =+ "setWebhook" :> ReqBody '[JSON] SetWebhookRequest :> Get '[JSON] (Response Bool)++type DeleteWebhook =+ "deleteWebhook" :> ReqBody '[JSON] DeleteWebhookRequest :> Get '[JSON] (Response Bool)++setUpWebhook :: SetWebhookRequest -> ClientEnv -> IO (Either ClientError ())+setUpWebhook requestData = (void <$>) <$> runClientM setUpWebhookRequest+ where+ setUpWebhookRequest =+ if isJust $ setWebhookCertificate requestData+ then do+ boundary <- liftIO genBoundary+ client (Proxy @SetWebhookForm) (boundary, requestData)+ else client (Proxy @SetWebhookJson) requestData++deleteWebhook :: ClientEnv -> IO (Either ClientError ())+deleteWebhook = (void <$>) <$> runClientM deleteWebhookRequest+ where+ requestData = DeleteWebhookRequest {deleteWebhookDropPendingUpdates = Nothing}+ deleteWebhookRequest = client (Proxy @DeleteWebhook) requestData++webhookApp :: BotApp model action -> BotEnv model action -> Application+webhookApp = app
src/Telegram/Bot/Simple/BotApp.hs view
@@ -1,6 +1,8 @@+{-# LANGUAGE RecordWildCards #-} module Telegram.Bot.Simple.BotApp ( BotApp(..), BotJob(..),+ WebhookConfig(..), startBot, startBot_,@@ -8,6 +10,9 @@ startBotAsync, startBotAsync_, + startBotWebhook,+ startBotWebhook_,+ getEnvToken, ) where @@ -17,7 +22,14 @@ import Servant.Client import System.Environment (getEnv) +import Control.Exception (finally)+import Data.Either (isLeft)+import Network.Wai.Handler.Warp+import Network.Wai.Handler.WarpTLS import qualified Telegram.Bot.API as Telegram+import Telegram.Bot.API.Webhook (SetWebhookRequest,+ deleteWebhook,+ setUpWebhook, webhookApp) import Telegram.Bot.Simple.BotApp.Internal -- | Start bot with asynchronous polling.@@ -44,6 +56,30 @@ -- | Like 'startBot', but ignores result. startBot_ :: BotApp model action -> ClientEnv -> IO () startBot_ bot = void . startBot bot++data WebhookConfig = WebhookConfig+ { webhookConfigTlsSettings :: TLSSettings,+ webhookConfigTlsWarpSettings :: Settings,+ webhookConfigSetWebhookRequest :: SetWebhookRequest+ }++-- | Start bot with webhook on update in the main thread.+-- Port must be one of 443, 80, 88, 8443+-- certPath must be provided if using self signed certificate.+startBotWebhook :: BotApp model action -> WebhookConfig -> ClientEnv -> IO (Either ClientError ())+startBotWebhook bot (WebhookConfig{..}) env = do+ botEnv <- startBotEnv bot env+ res <- setUpWebhook webhookConfigSetWebhookRequest env+ if isLeft res+ then return res+ else Right <$> runTLS webhookConfigTlsSettings webhookConfigTlsWarpSettings (webhookApp bot botEnv)+ `finally`+ deleteWebhook env+++-- | Like 'startBotWebhook', but ignores result.+startBotWebhook_ :: BotApp model action -> WebhookConfig -> ClientEnv -> IO ()+startBotWebhook_ bot webhookConfig = void . startBotWebhook bot webhookConfig -- | Get a 'Telegram.Token' from environment variable. --
src/Telegram/Bot/Simple/UpdateParser.hs view
@@ -11,12 +11,14 @@ import Data.Monoid ((<>)) #endif #endif+import qualified Data.Char as Char import Data.Text (Text) import qualified Data.Text as Text import Text.Read (readMaybe) import Telegram.Bot.API + newtype UpdateParser a = UpdateParser { runUpdateParser :: Update -> Maybe a } deriving (Functor)@@ -60,18 +62,18 @@ command :: Text -> UpdateParser Text command name = do t <- text- case Text.words t of- (w:ws) | w == "/" <> name- -> pure (Text.unwords ws)- _ -> fail "not that command"+ let (cmd, rest) = Text.break Char.isSpace t+ if cmd == "/" <> name+ then pure $ Text.stripStart rest+ else fail "not that command" commandWithBotName :: Text -> Text -> UpdateParser Text commandWithBotName botname commandname = do t <- text- case Text.words t of- (w:ws)| w `elem` ["/" <> commandname <> "@" <> botname, "/" <> commandname]- -> pure (Text.unwords ws)- _ -> fail "not that command"+ let (cmd, rest) = Text.break Char.isSpace t+ if cmd `elem` ["/" <> commandname <> "@" <> botname, "/" <> commandname]+ then pure $ Text.stripStart rest+ else fail "not that command" callbackQueryDataRead :: Read a => UpdateParser a callbackQueryDataRead = mkParser $ \update -> do
telegram-bot-simple.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: telegram-bot-simple-version: 0.5.2+version: 0.6 synopsis: Easy to use library for building Telegram bots. description: Please see the README on Github at <https://github.com/fizruk/telegram-bot-simple#readme> category: Web@@ -48,6 +48,7 @@ Telegram.Bot.API.Types Telegram.Bot.API.UpdatingMessages Telegram.Bot.API.WebApps+ Telegram.Bot.API.Webhook Telegram.Bot.Simple Telegram.Bot.Simple.BotApp Telegram.Bot.Simple.BotApp.Internal@@ -82,6 +83,7 @@ , servant-client , servant-multipart-api , servant-multipart-client+ , servant-server , split , stm , template-haskell@@ -89,6 +91,8 @@ , time , transformers , unordered-containers+ , warp+ , warp-tls default-language: Haskell2010 executable example-echo-bot@@ -115,6 +119,7 @@ , servant-client , servant-multipart-api , servant-multipart-client+ , servant-server , split , stm , template-haskell@@ -122,6 +127,8 @@ , time , transformers , unordered-containers+ , warp+ , warp-tls if flag(examples) build-depends: telegram-bot-simple@@ -129,6 +136,47 @@ buildable: False default-language: Haskell2010 +executable example-echo-bot-webhook+ main-is: examples/EchoBotWebhook.hs+ other-modules:+ Paths_telegram_bot_simple+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ aeson+ , aeson-pretty+ , base >=4.9 && <5+ , bytestring+ , cron >=0.7.0+ , filepath+ , hashable+ , http-api-data+ , http-client+ , http-client-tls+ , monad-control+ , mtl+ , pretty-show+ , profunctors+ , servant+ , servant-client+ , servant-multipart-api+ , servant-multipart-client+ , servant-server+ , split+ , stm+ , template-haskell+ , text+ , time+ , transformers+ , unordered-containers+ , warp+ , warp-tls+ if flag(examples)+ build-depends:+ telegram-bot-simple+ else+ buildable: False+ default-language: Haskell2010+ executable example-game-bot main-is: examples/GameBot.hs other-modules:@@ -153,6 +201,7 @@ , servant-client , servant-multipart-api , servant-multipart-client+ , servant-server , split , stm , template-haskell@@ -160,6 +209,8 @@ , time , transformers , unordered-containers+ , warp+ , warp-tls if flag(examples) build-depends: QuickCheck@@ -204,6 +255,7 @@ , servant-client , servant-multipart-api , servant-multipart-client+ , servant-server , split , stm , template-haskell@@ -211,6 +263,8 @@ , time , transformers , unordered-containers+ , warp+ , warp-tls if flag(examples) build-depends: telegram-bot-simple