telegram-api 0.3.1.0 → 0.4.0.0
raw patch · 14 files changed
+2281/−1358 lines, 14 filesdep +ansi-wl-pprintdep +hjpathdep +http-api-datadep ~eitherdep ~servantdep ~servant-clientbinary-added
Dependencies added: ansi-wl-pprint, hjpath, http-api-data, http-client-tls, optparse-applicative, utf8-string
Dependency ranges changed: either, servant, servant-client
Files
- CHANGELOG.md +44/−0
- README.md +152/−124
- src/Servant/Client/MultipartFormData.hs +39/−30
- src/Web/Telegram/API/Bot/API.hs +323/−239
- src/Web/Telegram/API/Bot/Data.hs +777/−405
- src/Web/Telegram/API/Bot/JsonExt.hs +27/−27
- src/Web/Telegram/API/Bot/Requests.hs +529/−313
- src/Web/Telegram/API/Bot/Responses.hs +165/−126
- telegram-api.cabal +21/−10
- test-data/christmas-cat.jpg binary
- test-data/klappvisor.jpg binary
- test/InlineSpec.hs +18/−12
- test/MainSpec.hs +112/−39
- test/Spec.hs +74/−33
+ CHANGELOG.md view
@@ -0,0 +1,44 @@+## 0.4.0.0 [Breaking]++Features:++* Bot-2.0 API support is almost complete. Everything from [announce](https://core.telegram.org/bots/2-0-intro) is on place except file upload (works for photo BTW).+ * Inline keyboards+ * Updating messages+ * Send Location and Phone number+ * Inline Bots 2.0+ * Group Admins+ * and many others+* Added new and more convenient way to create request data records avoiding many optional parameters.+* migrated to servant 0.7.*++## 0.3.1.0++Features:++* Added possibility to upload and send photo++## 0.3.0.0++Bugfixes:++* *[Breaking]* Changed User to be optional in `from` field of the `Message` data record since sender can be empty for messages sent to channels++## 0.2.1.1++Bugfixes:++* Minor fix of chat action deserialization code++## 0.2.1.0++Features:++* Added reply keyboard++## 0.2.0.0++Features:++* Main functionality is on place except content upload.+* Inline mode added
README.md view
@@ -1,124 +1,152 @@-# telegram-api - -[](https://gitter.im/klappvisor/haskell-telegram-api?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) - - - - - - - -High-level bindings to the [Telegram Bot API][telegram-bot-api] based on [servant][servant] library. -Both `getUpdates` request or webhook can be used to receive updates for your bot. -Inline mode is supported. -Uploading stickers, documents, video, etc is not supported yet, but you can send items which are already uploaded on the Telegram servers. - -See list of supported methods below in TODO section. - -## Usage - -`getMe` example - -```haskell -import Control.Monad -import qualified Data.Text.IO as T -import Data.Maybe -import Web.Telegram.API.Bot - -main :: IO () -main = do - Right GetMeResponse { user_result = u } <- - getMe token - T.putStrLn (user_first_name u) - where token = Token "bot<token>" -- entire Token should be bot123456:ABC-DEF1234ghIkl-zyx57W2v1u123ew11 -``` - -`sendMessage` example - -```haskell -import Control.Monad -import qualified Data.Text.IO as T -import Data.Maybe -import Web.Telegram.API.Bot - -main :: IO () -main = do - Right MessageResponse { message_result = m } <- - sendMessage token (SendMessageRequest chatId message (Just Markdown) Nothing Nothing Nothing) - T.putStrLn (message_id m) - T.putStrLn (text m) - where token = Token "bot<token>" -- entire Token should be bot123456:ABC-DEF1234ghIkl-zyx57W2v1u123ew11 - chatId = "<chat_id> or <@channelusername>" - message = "text *bold* _italic_ [github](github.com/klappvisor/haskell-telegram-api)" -``` - -## Contribution - -Contributions are welcome! - -1. Fork repository -2. Do some changes -3. Create pull request -4. Wait for CI build and review -5. ?????? -6. PROFIT - -You can use `stack` to build project - -``` -stack build -``` - -To run test you have to create your own bot. Go to [BotFather](https://telegram.me/botfather) and create the bot. As the result you will have private bot's access token. Keep it safe! - -``` -stack test --test-arguments "$BOT_TOKEN $CHAT_ID $BOT_NAME" -``` - -where - -* `$BOT_TOKEN` is token obtained from BotFather with prefix `<token from BotFather>` -* `$CHAT_ID` can be id of your chat with your bot. Send some message to this chat in Telegram and do `curl "https://api.telegram.org/bot<replace_with_token>/getUpdates"`, you have to parse some JSON with your brain ;-) or any other suitable tool and you will find chat id there. -* `$BOT_NAME` name of your bot - -Note: Inline Spec is disabled for now... - -If everything is fine after test you will see receive a few new messages from your bot. - -## TODO - -* Uploading of Files, Documents, Stickers, etc - -### Methods - -##### Currently supported: - -* `getMe` -* `sendMessage` -* `forwardMessage` -* `sendPhoto` - without upload -* `sendAudio` - without upload -* `sendDocument` - without upload -* `sendSticker` - without upload -* `sendVideo` - without upload -* `sendVoice` - without upload -* `sendLocation` -* `getUpdates` -* `getFile` -* `sendChatAction` -* `getUserProfilePhotos` -* `setWebhook` - without uploading certificate -* `answerInlineQuery` - -##### To be done: - -* `sendPhoto` - upload photo -* `sendAudio` - upload audio -* `sendDocument` - upload documents -* `sendSticker` - upload stickers -* `sendVideo` - upload video -* `sendVoice` - upload voice -* `setWebhook` - upload certificate - -[telegram-bot-api]: https://core.telegram.org/bots/api -[servant]: https://haskell-servant.github.io/ +# telegram-api++[](https://gitter.im/klappvisor/haskell-telegram-api?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)++++++++High-level bindings to the [Telegram Bot API][telegram-bot-api] based on [servant][servant] library.+Both `getUpdates` request or webhook can be used to receive updates for your bot. +Inline mode is supported.+Uploading stickers, documents, video, etc is not supported yet, but you can send items which are already uploaded on the Telegram servers.++**Almost full support of [Bot-2.0 API][bot-2.0]**++See TODO section for details.++## Usage++`getMe` example++```haskell+{-# LANGUAGE OverloadedStrings #-}++import Network.HTTP.Client (newManager)+import Network.HTTP.Client.TLS (tlsManagerSettings)+import Web.Telegram.API.Bot++main :: IO ()+main = do+ manager <- newManager tlsManagerSettings+ res <- getMe token manager+ case res of+ Left e -> do+ putStrLn "Request failed"+ print e+ Right GetMeResponse { user_result = u } -> do+ putStrLn "Request succeded"+ print $ user_first_name u+ where token = Token "bot<token>" -- entire Token should be bot123456:ABC-DEF1234ghIkl-zyx57W2v1u123ew11+```++`sendMessage` example++```haskell+{-# LANGUAGE OverloadedStrings #-}++import Network.HTTP.Client (newManager)+import Network.HTTP.Client.TLS (tlsManagerSettings)+import Web.Telegram.API.Bot++main :: IO ()+main = do+ manager <- newManager tlsManagerSettings+ let request = sendMessageRequest chatId message+ res <- sendMessage token request manager+ case res of+ Left e -> do+ putStrLn "Request failed"+ print e+ Right MessageResponse { message_result = m } -> do+ putStrLn "Request succeded"+ print $ message_id m+ print $ text m+ where token = Token "bot<token>" -- entire Token should be bot123456:ABC-DEF1234ghIkl-zyx57W2v1u123ew11+ chatId = "<chat_id> or <@channelusername>" + message = "text *bold* _italic_ [github](github.com/klappvisor/haskell-telegram-api)"+```++#### Note on requests:++Many request data records have a lot of optional parameters which are usually redundant.+There are two ways to create requests:++With data type constructor:+```haskell+let request = SendMessageRequest "chatId" "text" Nothing (Just True) Nothing Nothing Nothing+```+Using default instance:++```haskell+let request = sendMessageRequest "chatId" "text" -- only with required fields+```++```haskell+let request = (sendMessageRequest "chatId" "text") {+ message_disable_notification = Just True -- with optional fields+}+```++## Contribution++Contributions are welcome!++1. Fork repository+2. Do some changes+3. Create pull request+4. Wait for CI build and review+5. ??????+6. PROFIT++Bear in mind that the CI build won't run integration test suite against your pull request since the necessary environment+variables (`$BOT_TOKEN`, `$CHAT_ID` and `$BOT_NAME`) aren't exported when a fork+starts the build (for security reasons). If you do want to run them before creating RP, you can integration your fork+with CircleCI.++You can use `stack` to build project++```+stack build+```++To run test you have to create your own bot. Go to [BotFather](https://telegram.me/botfather) and create the bot. As the result you will have private bot's access token. Keep it safe!++```+stack test --test-arguments "--integration -t BOT_TOKEN -c CHAT_ID -b BOT_NAME -- HSPEC_ARGS"+```++where++* `BOT_TOKEN` is the token obtained from BotFather+* `CHAT_ID` can be id of your chat with your bot. Send some messages to this chat in Telegram and do `curl "https://api.telegram.org/bot<replace_with_token>/getUpdates"`, you'll have to parse some JSON with your brain ;-) or any other suitable tool and you will find chat id there.+* `BOT_NAME` is the name of your bot+* `HSPEC_ARGS` are the normal `hspec` arguments you can find [here][hspec-args]++The help option is available for the tests and for hspec:++```+stack test --test-arguments "-h"+stack test --test-arguments "--integration -t BOT_TOKEN -c CHAT_ID -v BOT_NAME -- -h"+```++Note: Inline Spec is disabled for now...++If everything is fine after running the tests you will receive a few new messages from your bot.++## TODO++* ~~`sendPhoto` - upload photo~~ done+* `sendAudio` - upload audio+* `sendDocument` - upload documents+* `sendSticker` - upload stickers+* `sendVideo` - upload video+* `sendVoice` - upload voice+* `setWebhook` - upload certificate++[telegram-bot-api]: https://core.telegram.org/bots/api+[servant]: https://haskell-servant.github.io/+[hspec-args]: https://hspec.github.io/running-specs.html+[bot-2.0]: https://core.telegram.org/bots/2-0-intro
src/Servant/Client/MultipartFormData.hs view
@@ -5,6 +5,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-} module Servant.Client.MultipartFormData ( ToMultipartFormData (..)@@ -14,9 +15,10 @@ import Control.Exception import Control.Monad import Control.Monad.IO.Class-import Control.Monad.Trans.Either+import Control.Monad.Trans.Except import Data.ByteString.Lazy hiding (pack, filter, map, null, elem) import Data.Proxy+import GHC.TypeLits import Data.String.Conversions import Data.Typeable (Typeable) import Network.HTTP.Client hiding (Proxy, path)@@ -27,10 +29,18 @@ import qualified Network.HTTP.Types as H import qualified Network.HTTP.Types.Header as HTTP import Servant.API-import Servant.API.Post+import Servant.API.Verbs+import Servant.Common.BaseUrl import Servant.Client import Servant.Common.Req +import Data.ByteString.Lazy (ByteString)+import Data.List+import Data.Text (unpack)+import Network.HTTP.Client (Manager, Response)+import Servant.Client.Experimental.Auth+import Servant.Common.BasicAuth+ -- | A type that can be converted to a multipart/form-data value. class ToMultipartFormData a where -- | Convert a Haskell value to a multipart/form-data-friendly intermediate type.@@ -40,60 +50,59 @@ data MultipartFormDataReqBody a deriving (Typeable) -instance (ToMultipartFormData b, MimeUnrender ct a)- => HasClient (MultipartFormDataReqBody b :> Post (ct ': cts) a) where- type Client (MultipartFormDataReqBody b :> Post (ct ': cts) a)- = b -> EitherT ServantError IO a- clientWithRoute Proxy req baseurl reqData =+instance (ToMultipartFormData b, MimeUnrender ct a, cts' ~ (ct ': cts)+ ) => HasClient (MultipartFormDataReqBody b :> Post cts' a) where+ type Client (MultipartFormDataReqBody b :> Post cts' a)+ = b -> Manager -> BaseUrl -> ClientM a+ clientWithRoute Proxy req reqData manager baseurl = let reqToRequest' req' baseurl' = do requestWithoutBody <- reqToRequest req' baseurl' formDataBody (toMultipartFormData reqData) requestWithoutBody- in snd <$> performRequestCT' reqToRequest' (Proxy :: Proxy ct) H.methodPost req [200, 201, 202] baseurl+ in snd <$> performRequestCT' reqToRequest' (Proxy :: Proxy ct) H.methodPost req manager baseurl --- copied `performRequest` from servant-0.4.4.7, then modified so it takes a variant of `reqToRequest`+-- copied `performRequest` from servant-0.7.1, then modified so it takes a variant of `reqToRequest` -- as an argument. performRequest' :: (Req -> BaseUrl -> IO Request)- -> Method -> Req -> (Int -> Bool) -> BaseUrl- -> EitherT ServantError IO ( Int, ByteString, MediaType- , [HTTP.Header], Response ByteString)-performRequest' reqToRequest' reqMethod req isWantedStatus reqHost = do+ -> Method -> Req -> Manager -> BaseUrl+ -> ClientM ( Int, ByteString, MediaType+ , [HTTP.Header], Response ByteString)+performRequest' reqToRequest' reqMethod req manager reqHost = do partialRequest <- liftIO $ reqToRequest' req reqHost let request = partialRequest { Client.method = reqMethod , checkStatus = \ _status _headers _cookies -> Nothing } - eResponse <- liftIO $ __withGlobalManager $ \ manager ->- catchHttpException $- Client.httpLbs request manager+ eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request manager case eResponse of Left err ->- left $ ConnectionError err+ throwE . ConnectionError $ SomeException err Right response -> do let status = Client.responseStatus response body = Client.responseBody response- hrds = Client.responseHeaders response+ hdrs = Client.responseHeaders response status_code = statusCode status ct <- case lookup "Content-Type" $ Client.responseHeaders response of Nothing -> pure $ "application"//"octet-stream" Just t -> case parseAccept t of- Nothing -> left $ InvalidContentTypeHeader (cs t) body+ Nothing -> throwE $ InvalidContentTypeHeader (cs t) body Just t' -> pure t'- unless (isWantedStatus status_code) $- left $ FailureResponse status ct body- return (status_code, body, ct, hrds, response)+ unless (status_code >= 200 && status_code < 300) $+ throwE $ FailureResponse status ct body+ return (status_code, body, ct, hdrs, response) --- copied `performRequestCT` from servant-0.4.4.7, then modified so it takes a variant of `reqToRequest`+-- copied `performRequestCT` from servant-0.7.1, then modified so it takes a variant of `reqToRequest` -- as an argument. performRequestCT' :: MimeUnrender ct result => (Req -> BaseUrl -> IO Request) ->- Proxy ct -> Method -> Req -> [Int] -> BaseUrl -> EitherT ServantError IO ([HTTP.Header], result)-performRequestCT' reqToRequest' ct reqMethod req wantedStatus reqHost = do+ Proxy ct -> Method -> Req -> Manager -> BaseUrl+ -> ClientM ([HTTP.Header], result)+performRequestCT' reqToRequest' ct reqMethod req manager reqHost = do let acceptCT = contentType ct- (_status, respBody, respCT, hrds, _response) <-- performRequest' reqToRequest' reqMethod (req { reqAccept = [acceptCT] }) (`elem` wantedStatus) reqHost- unless (matches respCT (acceptCT)) $ left $ UnsupportedContentType respCT respBody+ (_status, respBody, respCT, hdrs, _response) <-+ performRequest' reqToRequest' reqMethod (req { reqAccept = [acceptCT] }) manager reqHost+ unless (matches respCT (acceptCT)) $ throwE $ UnsupportedContentType respCT respBody case mimeUnrender ct respBody of- Left err -> left $ DecodeFailure err respCT respBody- Right val -> return (hrds, val)+ Left err -> throwE $ DecodeFailure err respCT respBody+ Right val -> return (hdrs, val)
src/Web/Telegram/API/Bot/API.hs view
@@ -1,239 +1,323 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TemplateHaskell #-} - -module Web.Telegram.API.Bot.API - ( -- * Functions - getMe - , sendMessage - , forwardMessage - , sendPhoto - , sendPhotoById - , sendAudio - , sendDocument - , sendSticker - , sendVideo - , sendVoice - , sendLocation - , sendChatAction - , getUpdates - , getFile - , getUserProfilePhotos - , setWebhook - , answerInlineQuery - -- * API - , TelegramBotAPI - , api - -- * Types - , Token (..) - ) where - -import Control.Applicative -import Control.Monad.Trans.Either -import Data.Aeson -import Data.Aeson.Types -import Data.Maybe -import Data.Proxy -import Data.Text (Text) -import qualified Data.Text as T -import GHC.Generics -import GHC.TypeLits -import Servant.API -import Servant.Client -import Servant.Client.MultipartFormData -import Web.Telegram.API.Bot.Data -import Web.Telegram.API.Bot.Responses -import Web.Telegram.API.Bot.Requests - --- | Telegram Bot's Token -newtype Token = Token Text - deriving (Show, Eq, Ord) - -instance ToText Token where - toText (Token x) = x - -instance FromText Token where - fromText x = Just $ Token x - --- | Type for token -type TelegramToken = Capture ":token" Token - --- | Telegram Bot API -type TelegramBotAPI = - TelegramToken :> "getMe" - :> Get '[JSON] GetMeResponse - :<|> TelegramToken :> "sendMessage" - :> ReqBody '[JSON] SendMessageRequest - :> Post '[JSON] MessageResponse - :<|> TelegramToken :> "forwardMessage" - :> ReqBody '[JSON] ForwardMessageRequest - :> Post '[JSON] MessageResponse - :<|> TelegramToken :> "sendPhoto" - :> MultipartFormDataReqBody (SendPhotoRequest FileUpload) - :> Post '[JSON] MessageResponse - :<|> TelegramToken :> "sendPhoto" - :> ReqBody '[JSON] (SendPhotoRequest Text) - :> Post '[JSON] MessageResponse - :<|> TelegramToken :> "sendAudio" - :> ReqBody '[JSON] SendAudioRequest - :> Post '[JSON] MessageResponse - :<|> TelegramToken :> "sendDocument" - :> ReqBody '[JSON] SendDocumentRequest - :> Post '[JSON] MessageResponse - :<|> TelegramToken :> "sendSticker" - :> ReqBody '[JSON] SendStickerRequest - :> Post '[JSON] MessageResponse - :<|> TelegramToken :> "sendVideo" - :> ReqBody '[JSON] SendVideoRequest - :> Post '[JSON] MessageResponse - :<|> TelegramToken :> "sendVoice" - :> ReqBody '[JSON] SendVoiceRequest - :> Post '[JSON] MessageResponse - :<|> TelegramToken :> "sendLocation" - :> ReqBody '[JSON] SendLocationRequest - :> Post '[JSON] MessageResponse - :<|> TelegramToken :> "sendChatAction" - :> ReqBody '[JSON] SendChatActionRequest - :> Post '[JSON] ChatActionResponse - :<|> TelegramToken :> "getUpdates" - :> QueryParam "offset" Int - :> QueryParam "limit" Int - :> QueryParam "timeout" Int - :> Get '[JSON] UpdatesResponse - :<|> TelegramToken :> "getFile" - :> QueryParam "file_id" Text - :> Get '[JSON] FileResponse - :<|> TelegramToken :> "getUserProfilePhotos" - :> QueryParam "user_id" Int - :> QueryParam "offset" Int - :> QueryParam "limit" Int - :> Get '[JSON] UserProfilePhotosResponse - :<|> TelegramToken :> "setWebhook" - :> QueryParam "url" Text - :> Get '[JSON] - SetWebhookResponse - :<|> TelegramToken :> "answerInlineQuery" - :> ReqBody '[JSON] AnswerInlineQueryRequest - :> Post '[JSON] InlineQueryResponse - --- | Proxy for Thelegram Bot API -api :: Proxy TelegramBotAPI -api = Proxy - -getMe_ :: Token -> EitherT ServantError IO GetMeResponse -sendMessage_ :: Token -> SendMessageRequest -> EitherT ServantError IO MessageResponse -forwardMessage_ :: Token -> ForwardMessageRequest -> EitherT ServantError IO MessageResponse -sendPhotoById_ :: Token -> SendPhotoRequest Text -> EitherT ServantError IO MessageResponse -sendPhoto_ :: Token -> SendPhotoRequest FileUpload -> EitherT ServantError IO MessageResponse -sendAudio_ :: Token -> SendAudioRequest -> EitherT ServantError IO MessageResponse -sendDocument_ :: Token -> SendDocumentRequest -> EitherT ServantError IO MessageResponse -sendSticker_ :: Token -> SendStickerRequest -> EitherT ServantError IO MessageResponse -sendVideo_ :: Token -> SendVideoRequest -> EitherT ServantError IO MessageResponse -sendVoice_ :: Token -> SendVoiceRequest -> EitherT ServantError IO MessageResponse -sendLocation_ :: Token -> SendLocationRequest -> EitherT ServantError IO MessageResponse -sendChatAction_ :: Token -> SendChatActionRequest -> EitherT ServantError IO ChatActionResponse -getUpdates_ :: Token -> Maybe Int -> Maybe Int -> Maybe Int -> EitherT ServantError IO UpdatesResponse -getFile_ :: Token -> Maybe Text -> EitherT ServantError IO FileResponse -getUserProfilePhotos_ :: Token -> Maybe Int -> Maybe Int -> Maybe Int -> EitherT ServantError IO UserProfilePhotosResponse -setWebhook_ :: Token -> Maybe Text -> EitherT ServantError IO SetWebhookResponse -answerInlineQuery_ :: Token -> AnswerInlineQueryRequest -> EitherT ServantError IO InlineQueryResponse -getMe_ - :<|> sendMessage_ - :<|> forwardMessage_ - :<|> sendPhoto_ - :<|> sendPhotoById_ - :<|> sendAudio_ - :<|> sendDocument_ - :<|> sendSticker_ - :<|> sendVideo_ - :<|> sendVoice_ - :<|> sendLocation_ - :<|> sendChatAction_ - :<|> getUpdates_ - :<|> getFile_ - :<|> getUserProfilePhotos_ - :<|> setWebhook_ - :<|> answerInlineQuery_ = - client api - (BaseUrl Https "api.telegram.org" 443) --- | A simple method for testing your bot's auth token. Requires no parameters. --- Returns basic information about the bot in form of a 'User' object. -getMe :: Token -> IO (Either ServantError GetMeResponse) -getMe token = runEitherT $ getMe_ token - --- | Use this method to send text messages. On success, the sent 'Message' is returned. -sendMessage :: Token -> SendMessageRequest -> IO (Either ServantError MessageResponse) -sendMessage = run sendMessage_ - --- | Use this method to forward messages of any kind. On success, the sent 'Message' is returned. -forwardMessage :: Token -> ForwardMessageRequest -> IO (Either ServantError MessageResponse) -forwardMessage = run forwardMessage_ - --- | Use this method to upload and send photos. On success, the sent 'Message' is returned. -sendPhoto :: Token -> SendPhotoRequest FileUpload -> IO (Either ServantError MessageResponse) -sendPhoto = run sendPhoto_ - --- | Use this method to send photos that have already been uploaded. On success, the sent 'Message' is returned. -sendPhotoById :: Token -> SendPhotoRequest Text -> IO (Either ServantError MessageResponse) -sendPhotoById = run sendPhotoById_ - --- | Use this method to send audio files, if you want Telegram clients to display them in the music player. Your audio must be in the .mp3 format. On success, the sent 'Message' is returned. Bots can currently send audio files of up to 50 MB in size, this limit may be changed in the future. --- --- For backward compatibility, when the fields __title__ and __performer__ are both empty and the mime-type of the file to be sent is not _audio/mpeg_, the file will be sent as a playable voice message. For this to work, the audio must be in an .ogg file encoded with OPUS. This behavior will be phased out in the future. For sending voice messages, use the 'sendVoice' method instead. -sendAudio :: Token -> SendAudioRequest -> IO (Either ServantError MessageResponse) -sendAudio = run sendAudio_ - --- | Use this method to send general files. On success, the sent 'Message' is returned. Bots can currently send files of any type of up to 50 MB in size, this limit may be changed in the future. -sendDocument :: Token -> SendDocumentRequest -> IO (Either ServantError MessageResponse) -sendDocument = run sendDocument_ - --- | Use this method to send .webp stickers. On success, the sent 'Message' is returned. -sendSticker :: Token -> SendStickerRequest -> IO (Either ServantError MessageResponse) -sendSticker = run sendSticker_ - --- | Use this method to send video files, Telegram clients support mp4 videos (other formats may be sent as 'Document'). On success, the sent 'Message' is returned. Bots can currently send video files of up to 50 MB in size, this limit may be changed in the future. -sendVideo :: Token -> SendVideoRequest -> IO (Either ServantError MessageResponse) -sendVideo = run sendVideo_ - --- | Use this method to send audio files, if you want Telegram clients to display the file as a playable voice message. For this to work, your audio must be in an .ogg file encoded with OPUS (other formats may be sent as 'Audio' or 'Document'). On success, the sent 'Message' is returned. Bots can currently send voice messages of up to 50 MB in size, this limit may be changed in the future. -sendVoice :: Token -> SendVoiceRequest -> IO (Either ServantError MessageResponse) -sendVoice = run sendVoice_ - --- | Use this method to send point on the map. On success, the sent 'Message' is returned. -sendLocation :: Token -> SendLocationRequest -> IO (Either ServantError MessageResponse) -sendLocation = run sendLocation_ - --- | Use this method when you need to tell the user that something is happening on the bot's side. --- The status is set for 5 seconds or less (when a message arrives from your bot, --- Telegram clients clear its typing status). -sendChatAction :: Token -> SendChatActionRequest -> IO (Either ServantError ChatActionResponse) -sendChatAction = run sendChatAction_ - --- | Use this method to receive incoming updates using long polling. An Array of 'Update' objects is returned. -getUpdates :: Token -> Maybe Int -> Maybe Int -> Maybe Int -> IO (Either ServantError UpdatesResponse) -getUpdates token offset limit timeout = runEitherT $ getUpdates_ token offset limit timeout - --- | Use this method to get basic info about a file and prepare it for downloading. For the moment, bots can download files of up to 20MB in size. On success, a 'File' object is returned. The file can then be downloaded via the link @https://api.telegram.org/file/bot<token>/<file_path>@, where @<file_path>@ is taken from the response. It is guaranteed that the link will be valid for at least 1 hour. When the link expires, a new one can be requested by calling getFile again. -getFile :: Token -> Text -> IO (Either ServantError FileResponse) -getFile token file_id = runEitherT $ getFile_ token $ Just file_id - --- | Use this method to get a list of profile pictures for a user. Returns a 'UserProfilePhotos' object. -getUserProfilePhotos :: Token -> Int -> Maybe Int -> Maybe Int -> IO (Either ServantError UserProfilePhotosResponse) -getUserProfilePhotos token user_id offset limit = runEitherT $ getUserProfilePhotos_ token (Just user_id) offset limit - --- | Use this method to specify a url and receive incoming updates via an outgoing webhook. Whenever there is an update for the bot, we will send an HTTPS POST request to the specified url, containing a JSON-serialized 'Update'. In case of an unsuccessful request, we will give up after a reasonable amount of attempts. --- --- If you'd like to make sure that the Webhook request comes from Telegram, we recommend using a secret path in the URL, e.g. @https://www.example.com/<token>@. Since nobody else knows your bot‘s token, you can be pretty sure it’s us. -setWebhook :: Token - -> Maybe Text -- ^ HTTPS url to send updates to. Use an empty string to remove webhook integration - -> IO (Either ServantError SetWebhookResponse) -setWebhook token url = runEitherT $ setWebhook_ token url - -answerInlineQuery :: Token -> AnswerInlineQueryRequest -> IO (Either ServantError InlineQueryResponse) -answerInlineQuery = run answerInlineQuery_ - -run :: (Token -> a -> EitherT ServantError IO b) -> Token -> a -> IO (Either ServantError b) -run e t r = runEitherT $ e t r +{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}++module Web.Telegram.API.Bot.API+ ( -- * Functions+ getMe+ , sendMessage+ , forwardMessage+ , uploadPhoto+ , sendPhoto+ , sendAudio+ , sendDocument+ , sendSticker+ , sendVideo+ , sendVoice+ , sendLocation+ , sendVenue+ , sendContact+ , sendChatAction+ , getUpdates+ , getFile+ , getUserProfilePhotos+ , setWebhook+ , answerInlineQuery+ , answerCallbackQuery+ , kickChatMember+ , unbanChatMember+ , editMessageText+ , editMessageCaption+ , editMessageReplyMarkup+ -- * API+ , TelegramBotAPI+ , api+ -- * Types+ , Token (..)+ ) where++import Control.Applicative+import Control.Monad.Trans.Either+import Control.Monad.Trans.Except (ExceptT, runExceptT)+import Data.Aeson+import Data.Aeson.Types+import Data.Maybe+import Data.Proxy+import Data.Text (Text)+import qualified Data.Text as T+import GHC.Generics+import GHC.TypeLits+import Network.HTTP.Client (Manager)+import Servant.API+import Servant.Client+import Web.HttpApiData+import Servant.Client.MultipartFormData+import Web.Telegram.API.Bot.Data+import Web.Telegram.API.Bot.Responses+import Web.Telegram.API.Bot.Requests++-- | Telegram Bot's Token+newtype Token = Token Text+ deriving (Show, Eq, Ord, ToHttpApiData, FromHttpApiData)++telegramBaseUrl :: BaseUrl+telegramBaseUrl = BaseUrl Https "api.telegram.org" 443 ""++-- | Type for token+type TelegramToken = Capture ":token" Token++-- | Telegram Bot API+type TelegramBotAPI =+ TelegramToken :> "getMe"+ :> Get '[JSON] GetMeResponse+ :<|> TelegramToken :> "sendMessage"+ :> ReqBody '[JSON] SendMessageRequest+ :> Post '[JSON] MessageResponse+ :<|> TelegramToken :> "forwardMessage"+ :> ReqBody '[JSON] ForwardMessageRequest+ :> Post '[JSON] MessageResponse+ :<|> TelegramToken :> "sendPhoto"+ :> MultipartFormDataReqBody (SendPhotoRequest FileUpload)+ :> Post '[JSON] MessageResponse+ :<|> TelegramToken :> "sendPhoto"+ :> ReqBody '[JSON] (SendPhotoRequest Text)+ :> Post '[JSON] MessageResponse+ :<|> TelegramToken :> "sendAudio"+ :> ReqBody '[JSON] SendAudioRequest+ :> Post '[JSON] MessageResponse+ :<|> TelegramToken :> "sendDocument"+ :> ReqBody '[JSON] SendDocumentRequest+ :> Post '[JSON] MessageResponse+ :<|> TelegramToken :> "sendSticker"+ :> ReqBody '[JSON] SendStickerRequest+ :> Post '[JSON] MessageResponse+ :<|> TelegramToken :> "sendVideo"+ :> ReqBody '[JSON] SendVideoRequest+ :> Post '[JSON] MessageResponse+ :<|> TelegramToken :> "sendVoice"+ :> ReqBody '[JSON] SendVoiceRequest+ :> Post '[JSON] MessageResponse+ :<|> TelegramToken :> "sendLocation"+ :> ReqBody '[JSON] SendLocationRequest+ :> Post '[JSON] MessageResponse+ :<|> TelegramToken :> "sendVenue"+ :> ReqBody '[JSON] SendVenueRequest+ :> Post '[JSON] MessageResponse+ :<|> TelegramToken :> "sendContact"+ :> ReqBody '[JSON] SendContactRequest+ :> Post '[JSON] MessageResponse+ :<|> TelegramToken :> "sendChatAction"+ :> ReqBody '[JSON] SendChatActionRequest+ :> Post '[JSON] ChatActionResponse+ :<|> TelegramToken :> "getUpdates"+ :> QueryParam "offset" Int+ :> QueryParam "limit" Int+ :> QueryParam "timeout" Int+ :> Get '[JSON] UpdatesResponse+ :<|> TelegramToken :> "getFile"+ :> QueryParam "file_id" Text+ :> Get '[JSON] FileResponse+ :<|> TelegramToken :> "getUserProfilePhotos"+ :> QueryParam "user_id" Int+ :> QueryParam "offset" Int+ :> QueryParam "limit" Int+ :> Get '[JSON] UserProfilePhotosResponse+ :<|> TelegramToken :> "setWebhook"+ :> QueryParam "url" Text+ :> Get '[JSON]+ SetWebhookResponse+ :<|> TelegramToken :> "answerInlineQuery"+ :> ReqBody '[JSON] AnswerInlineQueryRequest+ :> Post '[JSON] InlineQueryResponse+ :<|> TelegramToken :> "answerCallbackQuery"+ :> ReqBody '[JSON] AnswerCallbackQueryRequest+ :> Post '[JSON] CallbackQueryResponse+ :<|> TelegramToken :> "kickChatMember"+ :> QueryParam "chat_id" Text+ :> QueryParam "user_id" Int+ :> Post '[JSON] KickChatMemberResponse+ :<|> TelegramToken :> "unbanChatMember"+ :> QueryParam "chat_id" Text+ :> QueryParam "user_id" Int+ :> Post '[JSON] UnbanChatMemberResponse+ :<|> TelegramToken :> "editMessageText"+ :> ReqBody '[JSON] EditMessageTextRequest+ :> Post '[JSON] MessageResponse+ :<|> TelegramToken :> "editMessageCaption"+ :> ReqBody '[JSON] EditMessageCaptionRequest+ :> Post '[JSON] MessageResponse+ :<|> TelegramToken :> "editMessageReplyMarkup"+ :> ReqBody '[JSON] EditMessageReplyMarkupRequest+ :> Post '[JSON] MessageResponse+++-- | Proxy for Thelegram Bot API+api :: Proxy TelegramBotAPI+api = Proxy++getMe_ :: Token -> Manager -> BaseUrl -> ExceptT ServantError IO GetMeResponse+sendMessage_ :: Token -> SendMessageRequest -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse+forwardMessage_ :: Token -> ForwardMessageRequest -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse+uploadPhoto_ :: Token -> SendPhotoRequest FileUpload -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse+sendPhoto_ :: Token -> SendPhotoRequest Text -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse+sendAudio_ :: Token -> SendAudioRequest -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse+sendDocument_ :: Token -> SendDocumentRequest -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse+sendSticker_ :: Token -> SendStickerRequest -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse+sendVideo_ :: Token -> SendVideoRequest -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse+sendVoice_ :: Token -> SendVoiceRequest -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse+sendLocation_ :: Token -> SendLocationRequest -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse+sendVenue_ :: Token -> SendVenueRequest-> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse+sendContact_ :: Token -> SendContactRequest -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse+sendChatAction_ :: Token -> SendChatActionRequest -> Manager -> BaseUrl -> ExceptT ServantError IO ChatActionResponse+getUpdates_ :: Token -> Maybe Int -> Maybe Int -> Maybe Int -> Manager -> BaseUrl -> ExceptT ServantError IO UpdatesResponse+getFile_ :: Token -> Maybe Text -> Manager -> BaseUrl -> ExceptT ServantError IO FileResponse+getUserProfilePhotos_ :: Token -> Maybe Int -> Maybe Int -> Maybe Int -> Manager -> BaseUrl -> ExceptT ServantError IO UserProfilePhotosResponse+setWebhook_ :: Token -> Maybe Text -> Manager -> BaseUrl -> ExceptT ServantError IO SetWebhookResponse+answerInlineQuery_ :: Token -> AnswerInlineQueryRequest -> Manager -> BaseUrl -> ExceptT ServantError IO InlineQueryResponse+answerCallbackQuery_ :: Token -> AnswerCallbackQueryRequest -> Manager -> BaseUrl -> ExceptT ServantError IO CallbackQueryResponse+kickChatMember_ :: Token -> Maybe Text -> Maybe Int -> Manager -> BaseUrl -> ExceptT ServantError IO KickChatMemberResponse+unbanChatMember_ :: Token -> Maybe Text -> Maybe Int -> Manager -> BaseUrl -> ExceptT ServantError IO UnbanChatMemberResponse+editMessageText_ :: Token -> EditMessageTextRequest -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse+editMessageCaption_ :: Token -> EditMessageCaptionRequest -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse+editMessageReplyMarkup_ :: Token -> EditMessageReplyMarkupRequest -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse+getMe_+ :<|> sendMessage_+ :<|> forwardMessage_+ :<|> uploadPhoto_+ :<|> sendPhoto_+ :<|> sendAudio_+ :<|> sendDocument_+ :<|> sendSticker_+ :<|> sendVideo_+ :<|> sendVoice_+ :<|> sendLocation_+ :<|> sendVenue_+ :<|> sendContact_+ :<|> sendChatAction_+ :<|> getUpdates_+ :<|> getFile_+ :<|> getUserProfilePhotos_+ :<|> setWebhook_+ :<|> answerInlineQuery_+ :<|> answerCallbackQuery_+ :<|> kickChatMember_+ :<|> unbanChatMember_+ :<|> editMessageText_+ :<|> editMessageCaption_+ :<|> editMessageReplyMarkup_ =+ client api++-- | A simple method for testing your bot's auth token. Requires no parameters.+-- Returns basic information about the bot in form of a 'User' object.+getMe :: Token -> Manager -> IO (Either ServantError GetMeResponse)+getMe token manager = runExceptT $ getMe_ token manager telegramBaseUrl++-- | Use this method to send text messages. On success, the sent 'Message' is returned.+sendMessage :: Token -> SendMessageRequest -> Manager -> IO (Either ServantError MessageResponse)+sendMessage = run telegramBaseUrl sendMessage_++-- | Use this method to forward messages of any kind. On success, the sent 'Message' is returned.+forwardMessage :: Token -> ForwardMessageRequest -> Manager -> IO (Either ServantError MessageResponse)+forwardMessage = run telegramBaseUrl forwardMessage_++-- | Use this method to upload and send photos. On success, the sent 'Message' is returned.+uploadPhoto :: Token -> SendPhotoRequest FileUpload -> Manager -> IO (Either ServantError MessageResponse)+uploadPhoto = run telegramBaseUrl uploadPhoto_++-- | Use this method to send photos that have already been uploaded. On success, the sent 'Message' is returned.+sendPhoto :: Token -> SendPhotoRequest Text -> Manager -> IO (Either ServantError MessageResponse)+sendPhoto = run telegramBaseUrl sendPhoto_++-- | Use this method to send audio files, if you want Telegram clients to display them in the music player. Your audio must be in the .mp3 format. On success, the sent 'Message' is returned. Bots can currently send audio files of up to 50 MB in size, this limit may be changed in the future.+--+-- For backward compatibility, when the fields __title__ and __performer__ are both empty and the mime-type of the file to be sent is not _audio/mpeg_, the file will be sent as a playable voice message. For this to work, the audio must be in an .ogg file encoded with OPUS. This behavior will be phased out in the future. For sending voice messages, use the 'sendVoice' method instead.+sendAudio :: Token -> SendAudioRequest -> Manager -> IO (Either ServantError MessageResponse)+sendAudio = run telegramBaseUrl sendAudio_++-- | Use this method to send general files. On success, the sent 'Message' is returned. Bots can currently send files of any type of up to 50 MB in size, this limit may be changed in the future.+sendDocument :: Token -> SendDocumentRequest -> Manager -> IO (Either ServantError MessageResponse)+sendDocument = run telegramBaseUrl sendDocument_++-- | Use this method to send .webp stickers. On success, the sent 'Message' is returned.+sendSticker :: Token -> SendStickerRequest -> Manager -> IO (Either ServantError MessageResponse)+sendSticker = run telegramBaseUrl sendSticker_++-- | Use this method to send video files, Telegram clients support mp4 videos (other formats may be sent as 'Document'). On success, the sent 'Message' is returned. Bots can currently send video files of up to 50 MB in size, this limit may be changed in the future.+sendVideo :: Token -> SendVideoRequest -> Manager -> IO (Either ServantError MessageResponse)+sendVideo = run telegramBaseUrl sendVideo_++-- | Use this method to send audio files, if you want Telegram clients to display the file as a playable voice message. For this to work, your audio must be in an .ogg file encoded with OPUS (other formats may be sent as 'Audio' or 'Document'). On success, the sent 'Message' is returned. Bots can currently send voice messages of up to 50 MB in size, this limit may be changed in the future.+sendVoice :: Token -> SendVoiceRequest -> Manager -> IO (Either ServantError MessageResponse)+sendVoice = run telegramBaseUrl sendVoice_++-- | Use this method to send point on the map. On success, the sent 'Message' is returned.+sendLocation :: Token -> SendLocationRequest -> Manager -> IO (Either ServantError MessageResponse)+sendLocation = run telegramBaseUrl sendLocation_++-- | Use this method to send information about a venue. On success, the sent Message is returned.+sendVenue :: Token -> SendVenueRequest -> Manager -> IO (Either ServantError MessageResponse)+sendVenue = run telegramBaseUrl sendVenue_++-- | Use this method to send information about a venue. On success, the sent Message is returned.+sendContact :: Token -> SendContactRequest -> Manager -> IO (Either ServantError MessageResponse)+sendContact = run telegramBaseUrl sendContact_++-- | Use this method when you need to tell the user that something is happening on the bot's side.+-- The status is set for 5 seconds or less (when a message arrives from your bot,+-- Telegram clients clear its typing status).+sendChatAction :: Token -> SendChatActionRequest -> Manager -> IO (Either ServantError ChatActionResponse)+sendChatAction = run telegramBaseUrl sendChatAction_++-- | Use this method to receive incoming updates using long polling. An Array of 'Update' objects is returned.+getUpdates :: Token -> Maybe Int -> Maybe Int -> Maybe Int -> Manager -> IO (Either ServantError UpdatesResponse)+getUpdates token offset limit timeout manager = runExceptT $ getUpdates_ token offset limit timeout manager telegramBaseUrl++-- | Use this method to get basic info about a file and prepare it for downloading. For the moment, bots can download files of up to 20MB in size. On success, a 'File' object is returned. The file can then be downloaded via the link @https://api.telegram.org/file/bot<token>/<file_path>@, where @<file_path>@ is taken from the response. It is guaranteed that the link will be valid for at least 1 hour. When the link expires, a new one can be requested by calling getFile again.+getFile :: Token -> Text -> Manager -> IO (Either ServantError FileResponse)+getFile token file_id manager = runExceptT $ getFile_ token (Just file_id) manager telegramBaseUrl++-- | Use this method to get a list of profile pictures for a user. Returns a 'UserProfilePhotos' object.+getUserProfilePhotos :: Token -> Int -> Maybe Int -> Maybe Int -> Manager -> IO (Either ServantError UserProfilePhotosResponse)+getUserProfilePhotos token user_id offset limit manager = runExceptT $ getUserProfilePhotos_ token (Just user_id) offset limit manager telegramBaseUrl++-- | Use this method to specify a url and receive incoming updates via an outgoing webhook. Whenever there is an update for the bot, we will send an HTTPS POST request to the specified url, containing a JSON-serialized 'Update'. In case of an unsuccessful request, we will give up after a reasonable amount of attempts.+--+-- If you'd like to make sure that the Webhook request comes from Telegram, we recommend using a secret path in the URL, e.g. @https://www.example.com/<token>@. Since nobody else knows your bot‘s token, you can be pretty sure it’s us.+setWebhook :: Token+ -> Maybe Text -- ^ HTTPS url to send updates to. Use an empty string to remove webhook integration+ -> Manager+ -> IO (Either ServantError SetWebhookResponse)+setWebhook token url manager = runExceptT $ setWebhook_ token url manager telegramBaseUrl++-- | Use this method to send answers to an inline query. No more than 50 results per query are allowed.+answerInlineQuery :: Token -> AnswerInlineQueryRequest -> Manager -> IO (Either ServantError InlineQueryResponse)+answerInlineQuery = run telegramBaseUrl answerInlineQuery_++-- | Use this method to send answers to callback queries sent from inline keyboards. The answer will be displayed to the user as a notification at the top of the chat screen or as an alert.+answerCallbackQuery :: Token -> AnswerCallbackQueryRequest -> Manager -> IO (Either ServantError CallbackQueryResponse)+answerCallbackQuery = run telegramBaseUrl answerCallbackQuery_++-- | Use this method to kick a user from a group or a supergroup. In the case of supergroups, the user will not be able to return to the group on their own using invite links, etc., unless unbanned first. The bot must be an administrator in the group for this to work.+kickChatMember :: Token -> Text -> Int -> Manager -> IO (Either ServantError KickChatMemberResponse)+kickChatMember token chat_id user_id manager = runExceptT $ kickChatMember_ token (Just chat_id) (Just user_id) manager telegramBaseUrl++-- | Use this method to unban a previously kicked user in a supergroup. The user will not return to the group automatically, but will be able to join via link, etc. The bot must be an administrator in the group for this to work.+unbanChatMember :: Token -> Text -> Int -> Manager -> IO (Either ServantError UnbanChatMemberResponse)+unbanChatMember token chat_id user_id manager = runExceptT $ unbanChatMember_ token (Just chat_id) (Just user_id) manager telegramBaseUrl++-- | Use this method to edit text messages sent by the bot or via the bot (for inline bots). On success, if edited message is sent by the bot, the edited `Message` is returned, otherwise True is returned.+editMessageText :: Token -> EditMessageTextRequest -> Manager -> IO (Either ServantError MessageResponse)+editMessageText = run telegramBaseUrl editMessageText_++-- | Use this method to edit captions of messages sent by the bot or via the bot (for inline bots). On success, if edited message is sent by the bot, the edited `Message` is returned.+editMessageCaption :: Token -> EditMessageCaptionRequest -> Manager -> IO (Either ServantError MessageResponse)+editMessageCaption = run telegramBaseUrl editMessageCaption_++-- | Use this method to edit only the reply markup of messages sent by the bot or via the bot (for inline bots). On success, if edited message is sent by the bot, the edited `Message` is returned.+editMessageReplyMarkup :: Token -> EditMessageReplyMarkupRequest -> Manager -> IO (Either ServantError MessageResponse)+editMessageReplyMarkup = run telegramBaseUrl editMessageReplyMarkup_++run :: BaseUrl -> (Token -> a -> Manager -> BaseUrl -> ExceptT ServantError IO b) -> Token -> a -> Manager -> IO (Either ServantError b)+run b e t r m = runExceptT $ e t r m b
src/Web/Telegram/API/Bot/Data.hs view
@@ -1,405 +1,777 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TemplateHaskell #-} - --- | This module contains objects which represent data of Telegram Bot API responses -module Web.Telegram.API.Bot.Data - ( -- * Types - User (..) - , Chat (..) - , Message (..) - , PhotoSize (..) - , Audio (..) - , Document (..) - , Sticker (..) - , Video (..) - , Voice (..) - , Contact (..) - , Location (..) - , Update (..) - , File (..) - , UserProfilePhotos (..) - , InlineQuery (..) - , ChosenInlineResult (..) - , InlineQueryResult (..) - , ChatType (..) - , ParseMode (..) - ) where - -import Data.Aeson -import Data.Aeson.Types -import Data.Maybe -import Data.Proxy -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Char as Char -import GHC.Generics -import GHC.TypeLits -import Data.List -import Web.Telegram.API.Bot.JsonExt - --- | This object represents a Telegram user or bot. -data User = User - { - user_id :: Int -- ^ Unique identifier for this user or bot - , user_first_name :: Text -- ^ User‘s or bot’s first name - , user_last_name :: Maybe Text -- ^ User‘s or bot’s last name - , user_username :: Maybe Text -- ^ User‘s or bot’s username - } deriving (Show, Generic) - -instance ToJSON User where - toJSON = toJsonDrop 5 - -instance FromJSON User where - parseJSON = parseJsonDrop 5 - --- | This object represents a phone contact. -data Contact = Contact - { - contact_phone_number :: Text -- ^ Contact's phone number - , contact_first_name :: Text -- ^ Contact's first name - , contact_last_name :: Maybe Text -- ^ Contact's last name - , contact_user_id :: Maybe Int -- ^ Contact's user identifier in Telegram - } deriving (Show, Generic) - -instance ToJSON Contact where - toJSON = toJsonDrop 8 - -instance FromJSON Contact where - parseJSON = parseJsonDrop 8 - --- | This object represents a chat. -data Chat = Chat - { - chat_id :: Int -- ^ Unique identifier for this chat, not exceeding 1e13 by absolute value - , chat_type :: ChatType -- ^ Type of chat, can be either 'Private', 'Group', 'Supergroup' or 'Channel' - , chat_title :: Maybe Text -- ^ Title, for channels and group chats - , chat_username :: Maybe Text -- ^ Username, for private chats and channels if available - , chat_first_name :: Maybe Text -- ^ First name of the other party in a private chat - , chat_last_name :: Maybe Text -- ^ Last name of the other party in a private chat - } deriving (Show, Generic) - -instance ToJSON Chat where - toJSON = toJsonDrop 5 - -instance FromJSON Chat where - parseJSON = parseJsonDrop 5 - --- | Type of chat. -data ChatType = Private - | Group - | Supergroup - | Channel deriving (Show, Generic) - -instance ToJSON ChatType where - toJSON Private = "private" - toJSON Group = "group" - toJSON Supergroup = "supergroup" - toJSON Channel = "channel" - -instance FromJSON ChatType where - parseJSON "private" = pure Private - parseJSON "group" = pure Group - parseJSON "supergroup" = pure Supergroup - parseJSON "channel" = pure Channel - parseJSON _ = fail "Failed to parse ChatType" - --- | Parse mode for text message -data ParseMode = Markdown deriving (Show, Generic) - -instance ToJSON ParseMode where - toJSON Markdown = "Markdown" - -instance FromJSON ParseMode where - parseJSON "Markdown" = pure $ Markdown - parseJSON _ = fail "Failed to parse ParseMode" - --- | This object represents one size of a photo or a 'File' / 'Sticker' thumbnail. -data PhotoSize = PhotoSize - { - photo_file_id :: Text -- ^ Unique identifier for this file - , photo_width :: Int -- ^ Photo width - , photo_height :: Int -- ^ Photo height - , photo_file_size :: Maybe Int -- ^ File size - } deriving (Show, Generic) - -instance ToJSON PhotoSize where - toJSON = toJsonDrop 6 - -instance FromJSON PhotoSize where - parseJSON = parseJsonDrop 6 - --- | This object represents an audio file to be treated as music by the Telegram clients. -data Audio = Audio - { - audio_file_id :: Text -- ^ Unique identifier for this file - , audio_duration :: Int -- ^ Duration of the audio in seconds as defined by sender - , audio_performer :: Maybe Text -- ^ Performer of the audio as defined by sender or by audio tags - , audio_title :: Maybe Text -- ^ Title of the audio as defined by sender or by audio tags - , audio_mime_type :: Maybe Text -- ^ MIME type of the file as defined by sender - , audio_file_size :: Maybe Int -- ^ File size - } deriving (Show, Generic) - -instance ToJSON Audio where - toJSON = toJsonDrop 6 - -instance FromJSON Audio where - parseJSON = parseJsonDrop 6 - --- | This object represents a general file (as opposed to 'PhotoSize', 'Voice' messages and 'Audio' files). -data Document = Document - { - doc_file_id :: Text -- ^ Unique file identifier - , doc_thumb :: Maybe PhotoSize -- ^ Document thumbnail as defined by sender - , doc_file_name :: Maybe Text -- ^ Original filename as defined by sender - , doc_mime_type :: Maybe Text -- ^ MIME type of the file as defined by sender - , doc_file_size :: Maybe Int -- ^ File size - } deriving (Show, Generic) - -instance ToJSON Document where - toJSON = toJsonDrop 4 - -instance FromJSON Document where - parseJSON = parseJsonDrop 4 - --- | This object represents a sticker. -data Sticker = Sticker - { - sticker_file_id :: Text -- ^ Unique identifier for this file - , sticker_width :: Int -- ^ Sticker width - , sticker_height :: Int -- ^ Sticker height - , sticker_thumb :: Maybe PhotoSize -- ^ Sticker thumbnail in .webp or .jpg format - , sticker_file_size :: Maybe Int -- ^ File size - } deriving (Show, Generic) - -instance ToJSON Sticker where - toJSON = toJsonDrop 8 - -instance FromJSON Sticker where - parseJSON = parseJsonDrop 8 - --- | This object represents a video file. -data Video = Video - { - video_file_id :: Text -- ^ Unique identifier for this file - , video_width :: Int -- ^ Video width as defined by sender - , video_height :: Int -- ^ Video height as defined by sender - , video_duration :: Int -- ^ Duration of the video in seconds as defined by sender - , video_thumb :: Maybe PhotoSize -- ^ Video thumbnail - , video_mime_type :: Maybe Text -- ^ MIME type of a file as defined by sender - , video_file_size :: Maybe Int -- ^ File size - } deriving (Show, Generic) - -instance ToJSON Video where - toJSON = toJsonDrop 6 - -instance FromJSON Video where - parseJSON = parseJsonDrop 6 - --- | This object represents a voice note. -data Voice = Voice - { - voice_file_id :: Text -- ^ Unique identifier for this file - , voice_duration :: Int -- ^ Duration of the audio in seconds as defined by sender - , voice_mime_type :: Maybe Text -- ^ MIME type of the file as defined by sender - , voice_file_size :: Maybe Int -- ^ File size - } deriving (Show, Generic) - -instance ToJSON Voice where - toJSON = toJsonDrop 6 - -instance FromJSON Voice where - parseJSON = parseJsonDrop 6 - --- | This object represents an incoming inline query. When the user sends an empty query, your bot could return some default or trending results. -data InlineQuery = InlineQuery - { - query_id :: Text -- ^ Unique identifier for this query - , query_from :: User -- ^ Sender - , query_query :: Text -- ^ Text of the query - , query_offset :: Text -- ^ Offset of the results to be returned, can be controlled by the bot - } deriving (Show, Generic) - -instance ToJSON InlineQuery where - toJSON = toJsonDrop 6 - -instance FromJSON InlineQuery where - parseJSON = parseJsonDrop 6 - --- | This object represents a result of an inline query that was chosen by the user and sent to their chat partner. -data ChosenInlineResult = ChosenInlineResult - { - chosen_result_id :: Text -- ^ Unique identifier for this query - , chosen_from :: User -- ^ Sender - , chosen_query :: Text -- ^ Text of the query - } deriving (Show, Generic) - -instance ToJSON ChosenInlineResult where - toJSON = toJsonDrop 7 - -instance FromJSON ChosenInlineResult where - parseJSON = parseJsonDrop 7 - -data InlineQueryResult = - -- | Represents a link to an article or web page. - InlineQueryResultArticle - { - iq_res_id :: Text -- ^ Unique identifier for this result, 1-64 Bytes - , iq_res_title :: Maybe Text -- ^ Title of the result - , iq_res_message_text :: Maybe Text -- ^ Text of the message to be sent - , iq_res_parse_mode :: Maybe ParseMode -- Send 'Markdown', if you want Telegram apps to show bold, italic and inline URLs in your bot's message. - , iq_res_disable_web_page_preview :: Maybe Bool -- ^ Disables link previews for links in the sent message - , iq_res_url :: Maybe Text -- ^ URL of the result - , iq_res_hide_url :: Maybe Bool -- ^ Pass True, if you don't want the URL to be shown in the message - , iq_res_description :: Maybe Text -- ^ Short description of the result - , iq_res_thumb_url :: Maybe Text -- ^ Url of the thumbnail for the result - , iq_res_thumb_width :: Maybe Int -- ^ Thumbnail width - , iq_res_thumb_height :: Maybe Int -- ^ Thumbnail height - } - -- | Represents a link to a photo. By default, this photo will be sent by the user with optional caption. Alternatively, you can provide message_text to send it instead of photo. - | InlineQueryResultPhoto - { - iq_res_id :: Text -- ^ Unique identifier for this result, 1-64 bytes - , iq_res_photo_url :: Text -- ^ A valid URL of the photo. Photo must be in jpeg format. Photo size must not exceed 5MB - , iq_res_photo_width :: Maybe Int -- ^ Optional. Width of the photo - , iq_res_photo_height :: Maybe Int -- ^ Optional. Height of the photo - , iq_res_thumb_url :: Maybe Text -- ^ URL of the thumbnail for the photo - , iq_res_title :: Maybe Text -- ^ Title for the result - , iq_res_description :: Maybe Text -- ^ Short description of the result - , iq_res_caption :: Maybe Text -- ^ Caption of the photo to be sent, 0-200 characters - , iq_res_message_text :: Maybe Text -- ^ Text of a message to be sent instead of the photo, 1-512 characters - , iq_res_parse_mode :: Maybe ParseMode -- ^ Send 'Markdown', if you want Telegram apps to show bold, italic and inline URLs in your bot's message. - , iq_res_disable_web_page_preview :: Maybe Bool -- ^ Disables link previews for links in the sent message - } - -- | Represents a link to an animated GIF file. By default, this animated GIF file will be sent by the user with optional caption. Alternatively, you can provide message_text to send it instead of the animation. - | InlineQueryResultGif - { - iq_res_id :: Text -- ^ Unique identifier for this result, 1-64 bytes - , iq_res_gif_url :: Text -- ^ A valid URL for the GIF file. File size must not exceed 1MB - , iq_res_gif_width :: Maybe Int -- ^ Width of the GIF - , iq_res_gif_height :: Maybe Int -- ^ Height of the GIF - , iq_res_thumb_url :: Maybe Text -- ^ URL of the static thumbnail for the result (jpeg or gif) - , iq_res_title :: Maybe Text -- ^ Title for the result - , iq_res_caption :: Maybe Text -- ^ Caption of the GIF file to be sent, 0-200 characters - , iq_res_message_text :: Maybe Text -- ^ Text of a message to be sent instead of the animation, 1-512 characters - , iq_res_parse_mode :: Maybe ParseMode -- ^ Send 'Markdown', if you want Telegram apps to show bold, italic and inline URLs in your bot's message. - , iq_res_disable_web_page_preview :: Maybe Bool -- ^ Disables link previews for links in the sent message - } - -- | Represents a link to a video animation (H.264/MPEG-4 AVC video without sound). By default, this animated MPEG-4 file will be sent by the user with optional caption. Alternatively, you can provide message_text to send it instead of the animation. - | InlineQueryResultMpeg4Gif - { - iq_res_id :: Text -- ^ Unique identifier for this result, 1-64 bytes - , iq_res_mpeg4_url :: Text -- ^ A valid URL for the MP4 file. File size must not exceed 1MB - , iq_res_mpeg4_width :: Maybe Int -- ^ Video width - , iq_res_mpeg4_height :: Maybe Int -- ^ Video height - , iq_res_thumb_url :: Maybe Text -- ^ URL of the static thumbnail (jpeg or gif) for the result - , iq_res_title :: Maybe Text -- ^ Title for the result - , iq_res_caption :: Maybe Text -- ^ Caption of the MPEG-4 file to be sent, 0-200 characters - , iq_res_message_text :: Maybe Text -- ^ Text of a message to be sent instead of the animation, 1-512 characters - , iq_res_parse_mode :: Maybe ParseMode -- ^ Send 'Markdown', if you want Telegram apps to show bold, italic and inline URLs in your bot's message. - , iq_res_disable_web_page_preview :: Maybe Bool -- ^ Disables link previews for links in the sent message - } - -- | Represents link to a page containing an embedded video player or a video file. - | InlineQueryResultVideo - { - iq_res_id :: Text -- ^ Unique identifier for this result, 1-64 bytes - , iq_res_video_url :: Text -- ^ A valid URL for the embedded video player or video file - , iq_res_mime_type :: Text -- ^ Mime type of the content of video url, “text/html” or “video/mp4” - , iq_res_message_text :: Maybe Text -- ^ Text of the message to be sent with the video, 1-512 characters - , iq_res_parse_mode :: Maybe ParseMode -- ^ Send 'Markdown', if you want Telegram apps to show bold, italic and inline URLs in your bot's message. - , iq_res_disable_web_page_preview :: Maybe Bool -- ^ Disables link previews for links in the sent message - , iq_res_video_width :: Maybe Int -- ^ Video width - , iq_res_video_height :: Maybe Int -- ^ Video height - , iq_res_video_duration :: Maybe Int -- ^ Video duration in seconds - , iq_res_thumb_url :: Maybe Text -- ^ URL of the thumbnail (jpeg only) for the video - , iq_res_title :: Maybe Text -- ^ Title for the result - , iq_res_description :: Maybe Text -- ^ Short description of the result - } deriving (Show, Generic) - -tagModifier "InlineQueryResultMpeg4Gif" = "mpeg4_gif" -tagModifier x = ((drop 17) . (fmap (Char.toLower))) x - -inlineQueryJSONOptions :: Options -inlineQueryJSONOptions = defaultOptions { - fieldLabelModifier = drop 7 - , omitNothingFields = True - , sumEncoding = TaggedObject { tagFieldName = "type", contentsFieldName = undefined } - , constructorTagModifier = tagModifier - } - -instance ToJSON InlineQueryResult where - toJSON = genericToJSON inlineQueryJSONOptions - -instance FromJSON InlineQueryResult where - parseJSON = genericParseJSON inlineQueryJSONOptions - --- | This object represents an incoming update. --- Only one of the optional parameters can be present in any given update. -data Update = Update - { - update_id :: Int -- ^ The update's unique identifier. Update identifiers start from a certain positive number and increase sequentially. This ID becomes especially handy if you’re using 'setWebhooks', since it allows you to ignore repeated updates or to restore the correct update sequence, should they get out of order. - , message :: Maybe Message -- ^ New incoming message of any kind — text, photo, sticker, etc. - , inline_query :: Maybe InlineQuery -- ^ New incoming inline query - , chosen_inline_result :: Maybe ChosenInlineResult -- ^ The result of a inline query that was chosen by a user and sent to their chat partner - } deriving (FromJSON, ToJSON, Show, Generic) - --- | This object represents a point on the map. -data Location = Location - { - longitude :: Float -- ^ Longitude as defined by sender - , latitude :: Float -- ^ Latitude as defined by sender - } deriving (FromJSON, ToJSON, Show, Generic) - --- | This object represents a file ready to be downloaded. The file can be downloaded via the link --- @https://api.telegram.org/file/bot<token>/<file_path>@. It is guaranteed that the link will be valid --- for at least 1 hour. When the link expires, a new one can be requested by calling 'getFile'. --- --- Maximum file size to download is 20 MB -data File = File - { - file_id :: Text -- ^ Unique identifier for this file - , file_size :: Maybe Int -- ^ File size, if known - , file_path :: Maybe Text -- ^ File path. Use @https://api.telegram.org/file/bot<token>/<file_path>@ to get the file. - } deriving (FromJSON, ToJSON, Show, Generic) - --- | This object represent a user's profile pictures. -data UserProfilePhotos = UserProfilePhotos - { - total_count :: Int -- ^ Total number of profile pictures the target user has - , photos :: [[PhotoSize]] -- ^ Requested profile pictures (in up to 4 sizes each) - } deriving (FromJSON, ToJSON, Show, Generic) - --- | This object represents a message. -data Message = Message - { - message_id :: Int -- ^ Unique message identifier - , from :: Maybe User -- ^ Sender, can be empty for messages sent to channels - , date :: Int -- ^ Date the message was sent in Unix time - , chat :: Chat -- ^ Conversation the message belongs to - , forward_from :: Maybe User -- ^ For forwarded messages, sender of the original message - , forward_date :: Maybe Int -- ^ For forwarded messages, date the original message was sent in Unix time - , reply_to_message :: Maybe Message -- ^ For replies, the original message. Note that the 'Message' object in this field will not contain further 'reply_to_message' fields even if it itself is a reply. - , text :: Maybe Text -- ^ For text messages, the actual UTF-8 text of the message - , audio :: Maybe Audio -- ^ Message is an audio file, information about the file - , document :: Maybe Document -- ^ Message is a general file, information about the file - , photo :: Maybe [PhotoSize] -- ^ Message is a photo, available sizes of the photo - , sticker :: Maybe Sticker -- ^ Message is a sticker, information about the sticker - , video :: Maybe Video -- ^ Message is a video, information about the video - , voice :: Maybe Voice -- ^ Message is a voice message, information about the file - , caption :: Maybe Text -- ^ Caption for the photo or video - , contact :: Maybe Contact -- ^ Message is a shared contact, information about the contact - , location :: Maybe Location -- ^ Message is a shared location, information about the location - , new_chat_participant :: Maybe User -- ^ A new member was added to the group, information about them (this member may be the bot itself) - , left_chat_participant :: Maybe User -- ^ A member was removed from the group, information about them (this member may be the bot itself) - , new_chat_title :: Maybe Text -- ^ A chat title was changed to this value - , new_chat_photo :: Maybe [PhotoSize] -- ^ A chat photo was change to this value - , delete_chat_photo :: Maybe Bool -- ^ Service message: the chat photo was deleted - , group_chat_created :: Maybe Bool -- ^ Service message: the group has been created - , supergroup_chat_created :: Maybe Bool -- ^ Service message: the supergroup has been created - , channel_chat_created :: Maybe Bool -- ^ Service message: the channel has been created - , migrate_to_chat_id :: Maybe Int -- ^ The group has been migrated to a supergroup with the specified identifier, not exceeding 1e13 by absolute value - , migrate_from_chat_id :: Maybe Int -- ^ The supergroup has been migrated from a group with the specified identifier, not exceeding 1e13 by absolute value - } deriving (FromJSON, ToJSON, Show, Generic) +{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TemplateHaskell #-}++-- | This module contains objects which represent data of Telegram Bot API responses+module Web.Telegram.API.Bot.Data+ ( -- * Types+ User (..)+ , Chat (..)+ , Message (..)+ , PhotoSize (..)+ , Audio (..)+ , Document (..)+ , Sticker (..)+ , Video (..)+ , Voice (..)+ , Contact (..)+ , Location (..)+ , Update (..)+ , File (..)+ , UserProfilePhotos (..)+ , InlineQuery (..)+ , ChosenInlineResult (..)+ , InlineQueryResult (..)+ , InlineKeyboardMarkup (..)+ , InlineKeyboardButton (..)+ , CallbackQuery (..)+ , ChatType (..)+ , ParseMode (..)+ , InputMessageContent (..)+ , KeyboardButton (..)+ -- * Functions+ , inlineKeyboardButton+ , keyboardButton+ , inlineQueryResultArticle+ , inlineQueryResultAudio+ , inlineQueryResultContact+ , inlineQueryResultDocument+ , inlineQueryResultGif+ , inlineQueryResultLocation+ , inlineQueryResultMpeg4Gif+ , inlineQueryResultPhoto+ , inlineQueryResultVenue+ , inlineQueryResultVideo+ , inlineQueryResultVoice+ , inlineQueryResultCachedAudio+ , inlineQueryResultCachedDocument+ , inlineQueryResultCachedGif+ , inlineQueryResultCachedMpeg4Gif+ , inlineQueryResultCachedPhoto+ , inlineQueryResultCachedSticker+ , inlineQueryResultCachedVideo+ , inlineQueryResultCachedVoice++ ) where++import Data.Aeson+import Data.Aeson.Types+import Data.Maybe+import Data.Proxy+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Char as Char+import GHC.Generics+import GHC.TypeLits+import Data.List+import Web.Telegram.API.Bot.JsonExt++-- | This object represents a Telegram user or bot.+data User = User+ {+ user_id :: Int -- ^ Unique identifier for this user or bot+ , user_first_name :: Text -- ^ User‘s or bot’s first name+ , user_last_name :: Maybe Text -- ^ User‘s or bot’s last name+ , user_username :: Maybe Text -- ^ User‘s or bot’s username+ } deriving (Show, Generic)++instance ToJSON User where+ toJSON = toJsonDrop 5++instance FromJSON User where+ parseJSON = parseJsonDrop 5++-- | This object represents a phone contact.+data Contact = Contact+ {+ contact_phone_number :: Text -- ^ Contact's phone number+ , contact_first_name :: Text -- ^ Contact's first name+ , contact_last_name :: Maybe Text -- ^ Contact's last name+ , contact_user_id :: Maybe Int -- ^ Contact's user identifier in Telegram+ } deriving (Show, Generic)++instance ToJSON Contact where+ toJSON = toJsonDrop 8++instance FromJSON Contact where+ parseJSON = parseJsonDrop 8++-- | This object represents a chat.+data Chat = Chat+ {+ chat_id :: Int -- ^ Unique identifier for this chat, not exceeding 1e13 by absolute value+ , chat_type :: ChatType -- ^ Type of chat, can be either 'Private', 'Group', 'Supergroup' or 'Channel'+ , chat_title :: Maybe Text -- ^ Title, for channels and group chats+ , chat_username :: Maybe Text -- ^ Username, for private chats and channels if available+ , chat_first_name :: Maybe Text -- ^ First name of the other party in a private chat+ , chat_last_name :: Maybe Text -- ^ Last name of the other party in a private chat+ } deriving (Show, Generic)++instance ToJSON Chat where+ toJSON = toJsonDrop 5++instance FromJSON Chat where+ parseJSON = parseJsonDrop 5++-- | Type of chat.+data ChatType = Private+ | Group+ | Supergroup+ | Channel deriving (Show, Generic)++instance ToJSON ChatType where+ toJSON Private = "private"+ toJSON Group = "group"+ toJSON Supergroup = "supergroup"+ toJSON Channel = "channel"++instance FromJSON ChatType where+ parseJSON "private" = pure Private+ parseJSON "group" = pure Group+ parseJSON "supergroup" = pure Supergroup+ parseJSON "channel" = pure Channel+ parseJSON _ = fail "Failed to parse ChatType"++-- | Parse mode for text message+data ParseMode = Markdown | HTML deriving (Show, Generic)++instance ToJSON ParseMode where+ toJSON Markdown = "Markdown"+ toJSON HTML = "HTML"++instance FromJSON ParseMode where+ parseJSON "Markdown" = pure $ Markdown+ parseJSON "HTML" = pure $ HTML+ parseJSON _ = fail "Failed to parse ParseMode"++-- | This object represents one size of a photo or a 'File' / 'Sticker' thumbnail.+data PhotoSize = PhotoSize+ {+ photo_file_id :: Text -- ^ Unique identifier for this file+ , photo_width :: Int -- ^ Photo width+ , photo_height :: Int -- ^ Photo height+ , photo_file_size :: Maybe Int -- ^ File size+ } deriving (Show, Generic)++instance ToJSON PhotoSize where+ toJSON = toJsonDrop 6++instance FromJSON PhotoSize where+ parseJSON = parseJsonDrop 6++-- | This object represents an audio file to be treated as music by the Telegram clients.+data Audio = Audio+ {+ audio_file_id :: Text -- ^ Unique identifier for this file+ , audio_duration :: Int -- ^ Duration of the audio in seconds as defined by sender+ , audio_performer :: Maybe Text -- ^ Performer of the audio as defined by sender or by audio tags+ , audio_title :: Maybe Text -- ^ Title of the audio as defined by sender or by audio tags+ , audio_mime_type :: Maybe Text -- ^ MIME type of the file as defined by sender+ , audio_file_size :: Maybe Int -- ^ File size+ } deriving (Show, Generic)++instance ToJSON Audio where+ toJSON = toJsonDrop 6++instance FromJSON Audio where+ parseJSON = parseJsonDrop 6++-- | This object represents a general file (as opposed to 'PhotoSize', 'Voice' messages and 'Audio' files).+data Document = Document+ {+ doc_file_id :: Text -- ^ Unique file identifier+ , doc_thumb :: Maybe PhotoSize -- ^ Document thumbnail as defined by sender+ , doc_file_name :: Maybe Text -- ^ Original filename as defined by sender+ , doc_mime_type :: Maybe Text -- ^ MIME type of the file as defined by sender+ , doc_file_size :: Maybe Int -- ^ File size+ } deriving (Show, Generic)++instance ToJSON Document where+ toJSON = toJsonDrop 4++instance FromJSON Document where+ parseJSON = parseJsonDrop 4++-- | This object represents a sticker.+data Sticker = Sticker+ {+ sticker_file_id :: Text -- ^ Unique identifier for this file+ , sticker_width :: Int -- ^ Sticker width+ , sticker_height :: Int -- ^ Sticker height+ , sticker_thumb :: Maybe PhotoSize -- ^ Sticker thumbnail in .webp or .jpg format+ , sticker_emoji :: Maybe Text -- ^ Emoji associated with the sticker+ , sticker_file_size :: Maybe Int -- ^ File size+ } deriving (Show, Generic)++instance ToJSON Sticker where+ toJSON = toJsonDrop 8++instance FromJSON Sticker where+ parseJSON = parseJsonDrop 8++-- | This object represents a video file.+data Video = Video+ {+ video_file_id :: Text -- ^ Unique identifier for this file+ , video_width :: Int -- ^ Video width as defined by sender+ , video_height :: Int -- ^ Video height as defined by sender+ , video_duration :: Int -- ^ Duration of the video in seconds as defined by sender+ , video_thumb :: Maybe PhotoSize -- ^ Video thumbnail+ , video_mime_type :: Maybe Text -- ^ MIME type of a file as defined by sender+ , video_file_size :: Maybe Int -- ^ File size+ } deriving (Show, Generic)++instance ToJSON Video where+ toJSON = toJsonDrop 6++instance FromJSON Video where+ parseJSON = parseJsonDrop 6++-- | This object represents a voice note.+data Voice = Voice+ {+ voice_file_id :: Text -- ^ Unique identifier for this file+ , voice_duration :: Int -- ^ Duration of the audio in seconds as defined by sender+ , voice_mime_type :: Maybe Text -- ^ MIME type of the file as defined by sender+ , voice_file_size :: Maybe Int -- ^ File size+ } deriving (Show, Generic)++instance ToJSON Voice where+ toJSON = toJsonDrop 6++instance FromJSON Voice where+ parseJSON = parseJsonDrop 6++-- | This object represents an incoming inline query. When the user sends an empty query, your bot could return some default or trending results.+data InlineQuery = InlineQuery+ {+ query_id :: Text -- ^ Unique identifier for this query+ , query_from :: User -- ^ Sender+ , query_location :: Maybe Location -- ^ Sender location, only for bots that request user location+ , query_query :: Text -- ^ Text of the query+ , query_offset :: Text -- ^ Offset of the results to be returned, can be controlled by the bot+ } deriving (Show, Generic)++instance ToJSON InlineQuery where+ toJSON = toJsonDrop 6++instance FromJSON InlineQuery where+ parseJSON = parseJsonDrop 6++-- | This object represents a result of an inline query that was chosen by the user and sent to their chat partner.+data ChosenInlineResult = ChosenInlineResult+ {+ chosen_result_id :: Text -- ^ The unique identifier for the result that was chosen+ , chosen_from :: User -- ^ The user that chose the result+ , chosen_location :: Maybe Location -- ^ Sender location, only for bots that require user location+ , chosen_inline_message_id :: Maybe Text -- ^ Identifier of the sent inline message. Available only if there is an inline keyboard attached to the message. Will be also received in callback queries and can be used to edit the message.+ , chosen_query :: Text -- ^ The query that was used to obtain the result+ } deriving (Show, Generic)++instance ToJSON ChosenInlineResult where+ toJSON = toJsonDrop 7++instance FromJSON ChosenInlineResult where+ parseJSON = parseJsonDrop 7++-- | This object represents the content of a message to be sent as a result of an inline query.+data InputMessageContent =+ -- | Represents the content of a text message to be sent as the result of an inline query.+ InputTextMessageContent+ {+ imc_message_text :: Text -- ^ Text of the message to be sent, 1-4096 characters+ , imc_parse_mode :: Maybe ParseMode -- ^ Send 'Markdown' or 'HTML', if you want Telegram apps to show bold, italic, fixed-width text or inline URLs in your bot's message.+ , imc_disable_web_page_preview :: Maybe Bool -- ^ Disables link previews for links in the sent message+ }+ -- | Represents the content of a location message to be sent as the result of an inline query.+ | InputLocationMessageContent+ {+ imc_latitude :: Float -- ^ Latitude of the location in degrees+ , imc_longitude :: Float -- ^ Longitude of the location in degrees+ }+ -- | Represents the content of a venue message to be sent as the result of an inline query.+ | InputVenueMessageContent+ {+ imc_latitude :: Float -- ^ Latitude of the location in degrees+ , imc_longitude :: Float -- ^ Longitude of the location in degrees+ , imc_title :: Text -- ^ Name of the venue+ , imc_address :: Text -- ^ Address of the venue+ , imc_foursquare_id :: Maybe Text -- ^ Foursquare identifier of the venue, if known+ }+ -- | Represents the content of a contact message to be sent as the result of an inline query.+ | InputContactMessageContent+ {+ imc_phone_number :: Text -- ^ Contact's phone number+ , imc_first_name :: Text -- ^ Contact's first name+ , imc_last_name :: Maybe Text -- ^ Contact's last name+ } deriving (Show, Generic)++instance ToJSON InputMessageContent where+ toJSON = toJsonDrop 4++instance FromJSON InputMessageContent where+ parseJSON = parseJsonDrop 4++data InlineQueryResult =+ -- | Represents a link to an article or web page.+ InlineQueryResultArticle+ {+ iq_res_id :: Text -- ^ Unique identifier for this result, 1-64 Bytes+ , iq_res_title :: Maybe Text -- ^ Title of the result+ , iq_res_input_message_content :: Maybe InputMessageContent -- ^ Content of the message to be sent+ , iq_res_reply_markup :: Maybe InlineKeyboardMarkup -- ^ Inline keyboard attached to the message+ , iq_res_url :: Maybe Text -- ^ URL of the result+ , iq_res_hide_url :: Maybe Bool -- ^ Pass True, if you don't want the URL to be shown in the message+ , iq_res_description :: Maybe Text -- ^ Short description of the result+ , iq_res_thumb_url :: Maybe Text -- ^ Url of the thumbnail for the result+ , iq_res_thumb_width :: Maybe Int -- ^ Thumbnail width+ , iq_res_thumb_height :: Maybe Int -- ^ Thumbnail height+ }+ -- | Represents a link to a photo. By default, this photo will be sent by the user with optional caption. Alternatively, you can use input_message_content to send a message with the specified content instead of the photo.+ | InlineQueryResultPhoto+ {+ iq_res_id :: Text -- ^ Unique identifier for this result, 1-64 bytes+ , iq_res_photo_url :: Text -- ^ A valid URL of the photo. Photo must be in jpeg format. Photo size must not exceed 5MB+ , iq_res_thumb_url :: Maybe Text -- ^ URL of the thumbnail for the photo+ , iq_res_photo_width :: Maybe Int -- ^ Optional. Width of the photo+ , iq_res_photo_height :: Maybe Int -- ^ Optional. Height of the photo+ , iq_res_title :: Maybe Text -- ^ Title for the result+ , iq_res_description :: Maybe Text -- ^ Short description of the result+ , iq_res_caption :: Maybe Text -- ^ Caption of the photo to be sent, 0-200 characters+ , iq_res_reply_markup :: Maybe InlineKeyboardMarkup -- ^ Inline keyboard attached to the message+ , iq_res_input_message_content :: Maybe InputMessageContent -- ^ Content of the message to be sent instead of the photo+ }+ -- | Represents a link to an animated GIF file. By default, this animated GIF file will be sent by the user with optional caption. Alternatively, you can provide message_text to send it instead of the animation.+ | InlineQueryResultGif+ {+ iq_res_id :: Text -- ^ Unique identifier for this result, 1-64 bytes+ , iq_res_gif_url :: Text -- ^ A valid URL for the GIF file. File size must not exceed 1MB+ , iq_res_gif_width :: Maybe Int -- ^ Width of the GIF+ , iq_res_gif_height :: Maybe Int -- ^ Height of the GIF+ , iq_res_thumb_url :: Maybe Text -- ^ URL of the static thumbnail for the result (jpeg or gif)+ , iq_res_title :: Maybe Text -- ^ Title for the result+ , iq_res_caption :: Maybe Text -- ^ Caption of the GIF file to be sent, 0-200 characters+ , iq_res_reply_markup :: Maybe InlineKeyboardMarkup -- ^ Inline keyboard attached to the message+ , iq_res_input_message_content :: Maybe InputMessageContent -- ^ Content of the message to be sent instead of the GIF animation+ }+ -- | Represents a link to a video animation (H.264/MPEG-4 AVC video without sound). By default, this animated MPEG-4 file will be sent by the user with optional caption. Alternatively, you can provide message_text to send it instead of the animation.+ | InlineQueryResultMpeg4Gif+ {+ iq_res_id :: Text -- ^ Unique identifier for this result, 1-64 bytes+ , iq_res_mpeg4_url :: Text -- ^ A valid URL for the MP4 file. File size must not exceed 1MB+ , iq_res_mpeg4_width :: Maybe Int -- ^ Video width+ , iq_res_mpeg4_height :: Maybe Int -- ^ Video height+ , iq_res_thumb_url :: Maybe Text -- ^ URL of the static thumbnail (jpeg or gif) for the result+ , iq_res_title :: Maybe Text -- ^ Title for the result+ , iq_res_caption :: Maybe Text -- ^ Caption of the MPEG-4 file to be sent, 0-200 characters+ , iq_res_reply_markup :: Maybe InlineKeyboardMarkup -- ^ Inline keyboard attached to the message+ , iq_res_input_message_content :: Maybe InputMessageContent -- ^ Content of the message to be sent instead of the video animation+ }+ -- | Represents link to a page containing an embedded video player or a video file.+ | InlineQueryResultVideo+ {+ iq_res_id :: Text -- ^ Unique identifier for this result, 1-64 bytes+ , iq_res_video_url :: Text -- ^ A valid URL for the embedded video player or video file+ , iq_res_mime_type :: Text -- ^ Mime type of the content of video url, “text/html” or “video/mp4”+ , iq_res_thumb_url :: Maybe Text -- ^ URL of the thumbnail (jpeg only) for the video+ , iq_res_title :: Maybe Text -- ^ Title for the result+ , iq_res_caption :: Maybe Text -- ^ Caption of the video to be sent, 0-200 characters+ , iq_res_video_width :: Maybe Int -- ^ Video width+ , iq_res_video_height :: Maybe Int -- ^ Video height+ , iq_res_video_duration :: Maybe Int -- ^ Video duration in seconds+ , iq_res_description :: Maybe Text -- ^ Short description of the result+ , iq_res_reply_markup :: Maybe InlineKeyboardMarkup -- ^ Inline keyboard attached to the message+ , iq_res_input_message_content :: Maybe InputMessageContent -- ^ Content of the message to be sent instead of the video+ }+ -- | Represents a link to an mp3 audio file. By default, this audio file will be sent by the user. Alternatively, you can use input_message_content to send a message with the specified content instead of the audio.+ | InlineQueryResultAudio+ {+ iq_res_id :: Text -- ^ Unique identifier for this result, 1-64 bytes+ , iq_res_audio_url :: Text -- ^ A valid URL for the audio file+ , iq_res_title :: Maybe Text -- ^ Title+ , iq_res_performer :: Maybe Text -- ^ Performer+ , iq_res_audio_duration :: Maybe Int -- ^ Audio duration in seconds+ , iq_res_reply_markup :: Maybe InlineKeyboardMarkup -- ^ Inline keyboard attached to the message+ , iq_res_input_message_content :: Maybe InputMessageContent -- ^ Content of the message to be sent instead of the audio+ }+ -- | Represents a link to a voice recording in an .ogg container encoded with OPUS. By default, this voice recording will be sent by the user. Alternatively, you can use input_message_content to send a message with the specified content instead of the the voice message.+ | InlineQueryResultVoice+ {+ iq_res_id :: Text -- ^ Unique identifier for this result, 1-64 bytes+ , iq_res_voice_url :: Text -- ^ A valid URL for the voice recording+ , iq_res_title :: Maybe Text -- ^ Recording title+ , iq_res_voice_duration :: Maybe Int -- ^ Recording duration in seconds+ , iq_res_reply_markup :: Maybe InlineKeyboardMarkup -- ^ Inline keyboard attached to the message+ , iq_res_input_message_content :: Maybe InputMessageContent -- ^ Content of the message to be sent instead of the voice recording+ }+ -- | Represents a link to a file. By default, this file will be sent by the user with an optional caption. Alternatively, you can use input_message_content to send a message with the specified content instead of the file. Currently, only .PDF and .ZIP files can be sent using this method.+ | InlineQueryResultDocument+ {+ iq_res_id :: Text -- ^ Unique identifier for this result, 1-64 bytes+ , iq_res_title :: Maybe Text -- ^ Title for the result+ , iq_res_caption :: Maybe Text -- ^ Caption of the document to be sent, 0-200 characters+ , iq_res_document_url :: Text -- ^ A valid URL for the file+ , iq_res_mime_type :: Text -- ^ Mime type of the content of the file, either “application/pdf” or “application/zip”+ , iq_res_description :: Maybe Text -- ^ Short description of the result+ , iq_res_reply_markup :: Maybe InlineKeyboardMarkup -- ^ Inline keyboard attached to the message+ , iq_res_input_message_content :: Maybe InputMessageContent -- ^ Content of the message to be sent instead of the file+ , iq_res_thumb_url :: Maybe Text -- ^ URL of the thumbnail (jpeg only) for the file+ , iq_res_thumb_width :: Maybe Int -- ^ Thumbnail width+ , iq_res_thumb_height :: Maybe Int -- ^ Thumbnail height+ }+ -- | Represents a location on a map. By default, the location will be sent by the user. Alternatively, you can use input_message_content to send a message with the specified content instead of the location.+ | InlineQueryResultLocation+ {+ iq_res_id :: Text -- ^ Unique identifier for this result, 1-64 Bytes+ , iq_res_latitude :: Float -- ^ Location latitude in degrees+ , iq_res_longitude :: Float -- ^ Location longitude in degrees+ , iq_res_title :: Maybe Text -- ^ Location title+ , iq_res_reply_markup :: Maybe InlineKeyboardMarkup -- ^ Inline keyboard attached to the message+ , iq_res_input_message_content :: Maybe InputMessageContent -- ^ Content of the message to be sent instead of the location+ , iq_res_thumb_url :: Maybe Text -- ^ Url of the thumbnail for the result+ , iq_res_thumb_width :: Maybe Int -- ^ Thumbnail width+ , iq_res_thumb_height :: Maybe Int -- ^ Thumbnail height+ }+ -- | Represents a venue. By default, the venue will be sent by the user. Alternatively, you can use input_message_content to send a message with the specified content instead of the venue.+ | InlineQueryResultVenue+ {+ iq_res_id :: Text -- ^ Unique identifier for this result, 1-64 Bytes+ , iq_res_latitude :: Float -- ^ Latitude of the venue location in degrees+ , iq_res_longitude :: Float -- ^ Longitude of the venue location in degrees+ , iq_res_title :: Maybe Text -- ^ Title of the venue+ , iq_res_address :: Text -- ^ Address of the venue+ , iq_res_foursquare_id :: Maybe Text -- ^ Foursquare identifier of the venue if known+ , iq_res_reply_markup :: Maybe InlineKeyboardMarkup -- ^ Inline keyboard attached to the message+ , iq_res_input_message_content :: Maybe InputMessageContent -- ^ Content of the message to be sent instead of the venue+ , iq_res_thumb_url :: Maybe Text -- ^ Url of the thumbnail for the result+ , iq_res_thumb_width :: Maybe Int -- ^ Thumbnail width+ , iq_res_thumb_height :: Maybe Int -- ^ Thumbnail height+ }+ -- | Represents a link to a photo stored on the Telegram servers. By default, this photo will be sent by the user with an optional caption. Alternatively, you can use input_message_content to send a message with the specified content instead of the photo.+ | InlineQueryResultContact+ {+ iq_res_id :: Text -- ^ Unique identifier for this result, 1-64 Bytes+ , iq_res_phone_number :: Text -- ^ Contact's phone number+ , iq_res_first_name :: Text -- ^ Contact's first name+ , iq_res_last_name :: Maybe Text -- ^ Contact's last name+ , iq_res_reply_markup :: Maybe InlineKeyboardMarkup -- ^ Inline keyboard attached to the message+ , iq_res_input_message_content :: Maybe InputMessageContent -- ^ Content of the message to be sent instead of the contact+ , iq_res_thumb_url :: Maybe Text -- ^ Url of the thumbnail for the result+ , iq_res_thumb_width :: Maybe Int -- ^ Thumbnail width+ , iq_res_thumb_height :: Maybe Int -- ^ Thumbnail height+ }+ -- | Represents a link to a photo stored on the Telegram servers. By default, this photo will be sent by the user with an optional caption. Alternatively, you can use input_message_content to send a message with the specified content instead of the photo.+ | InlineQueryResultCachedPhoto+ {+ iq_res_id :: Text -- ^ Unique identifier for this result, 1-64 bytes+ , iq_res_photo_file_id :: Text -- ^ A valid file identifier of the photo+ , iq_res_title :: Maybe Text -- ^ Title for the result+ , iq_res_description :: Maybe Text -- ^ Short description of the result+ , iq_res_caption :: Maybe Text -- ^ Caption of the photo to be sent, 0-200 characters+ , iq_res_reply_markup :: Maybe InlineKeyboardMarkup -- ^ Inline keyboard attached to the message+ , iq_res_input_message_content :: Maybe InputMessageContent -- ^ Content of the message to be sent instead of the photo+ }+ -- | Represents a link to an animated GIF file stored on the Telegram servers. By default, this animated GIF file will be sent by the user with an optional caption. Alternatively, you can use input_message_content to send a message with specified content instead of the animation.+ | InlineQueryResultCachedGif+ {+ iq_res_id :: Text -- ^ Unique identifier for this result, 1-64 bytes+ , iq_res_gif_file_id :: Text -- ^ A valid file identifier for the GIF file+ , iq_res_title :: Maybe Text -- ^ Title for the result+ , iq_res_caption :: Maybe Text -- ^ Caption of the GIF file to be sent, 0-200 characters+ , iq_res_reply_markup :: Maybe InlineKeyboardMarkup -- ^ An Inline keyboard attached to the message+ , iq_res_input_message_content :: Maybe InputMessageContent -- ^ Content of the message to be sent instead of the GIF animation+ }+ -- | Represents a link to a video animation (H.264/MPEG-4 AVC video without sound) stored on the Telegram servers. By default, this animated MPEG-4 file will be sent by the user with an optional caption. Alternatively, you can use input_message_content to send a message with the specified content instead of the animation.+ | InlineQueryResultCachedMpeg4Gif+ {+ iq_res_id :: Text -- ^ Unique identifier for this result, 1-64 bytes+ , iq_res_mpeg4_file_id :: Text -- ^ A valid file identifier for the MP4 file+ , iq_res_title :: Maybe Text -- ^ Title for the result+ , iq_res_caption :: Maybe Text -- ^ Caption of the MPEG-4 file to be sent, 0-200 characters+ , iq_res_reply_markup :: Maybe InlineKeyboardMarkup -- ^ An Inline keyboard attached to the message+ , iq_res_input_message_content :: Maybe InputMessageContent -- ^ Content of the message to be sent instead of the video animation+ }+ -- | Represents a link to a sticker stored on the Telegram servers. By default, this sticker will be sent by the user. Alternatively, you can use input_message_content to send a message with the specified content instead of the sticker.+ | InlineQueryResultCachedSticker+ {+ iq_res_id :: Text -- ^ Unique identifier for this result, 1-64 bytes+ , iq_res_sticker_file_id :: Text -- ^ A valid file identifier of the sticker+ , iq_res_reply_markup :: Maybe InlineKeyboardMarkup -- ^ An Inline keyboard attached to the message+ , iq_res_input_message_content :: Maybe InputMessageContent -- ^ Content of the message to be sent instead of the sticker+ }+ -- | Represents a link to a file stored on the Telegram servers. By default, this file will be sent by the user with an optional caption. Alternatively, you can use input_message_content to send a message with the specified content instead of the file. Currently, only pdf-files and zip archives can be sent using this method.+ | InlineQueryResultCachedDocument+ {+ iq_res_id :: Text -- ^ Unique identifier for this result, 1-64 bytes+ , iq_res_title :: Maybe Text -- ^ Title for the result+ , iq_res_document_file_id :: Text -- ^ A valid file identifier for the file+ , iq_res_description :: Maybe Text -- ^ Short description of the result+ , iq_res_caption :: Maybe Text -- ^ Caption of the document to be sent, 0-200 characters+ , iq_res_reply_markup :: Maybe InlineKeyboardMarkup -- ^ An Inline keyboard attached to the message+ , iq_res_input_message_content :: Maybe InputMessageContent -- ^ Content of the message to be sent instead of the file+ }+ -- | Represents a link to a video file stored on the Telegram servers. By default, this video file will be sent by the user with an optional caption. Alternatively, you can use input_message_content to send a message with the specified content instead of the video.+ | InlineQueryResultCachedVideo+ {+ iq_res_id :: Text -- ^ Unique identifier for this result, 1-64 bytes+ , iq_res_video_file_id :: Text -- ^ A valid file identifier for the video file+ , iq_res_title :: Maybe Text -- ^ Title for the result+ , iq_res_description :: Maybe Text -- ^ Short description of the result+ , iq_res_caption :: Maybe Text -- ^ Caption of the video to be sent, 0-200 characters+ , iq_res_reply_markup :: Maybe InlineKeyboardMarkup -- ^ An Inline keyboard attached to the message+ , iq_res_input_message_content :: Maybe InputMessageContent -- ^ Content of the message to be sent instead of the video+ }+ -- | Represents a link to a voice message stored on the Telegram servers. By default, this voice message will be sent by the user. Alternatively, you can use input_message_content to send a message with the specified content instead of the voice message.+ | InlineQueryResultCachedVoice+ {+ iq_res_id :: Text -- ^ Unique identifier for this result, 1-64 bytes+ , iq_res_voice_file_id :: Text -- ^ A valid file identifier for the voice message+ , iq_res_title :: Maybe Text -- ^ Voice message title+ , iq_res_reply_markup :: Maybe InlineKeyboardMarkup -- ^ An Inline keyboard attached to the message+ , iq_res_input_message_content :: Maybe InputMessageContent -- ^ ontent of the message to be sent instead of the voice message+ }+ -- | Represents a link to an mp3 audio file stored on the Telegram servers. By default, this audio file will be sent by the user. Alternatively, you can use input_message_content to send a message with the specified content instead of the audio.+ | InlineQueryResultCachedAudio+ {+ iq_res_id :: Text -- ^ Unique identifier for this result, 1-64 bytes+ , iq_res_audio_file_id :: Text -- ^ A valid file identifier for the audio file+ , iq_res_reply_markup :: Maybe InlineKeyboardMarkup -- ^ An Inline keyboard attached to the message+ , iq_res_input_message_content :: Maybe InputMessageContent -- ^ ontent of the message to be sent instead of the audio+ } deriving (Show, Generic)++dropCached :: String -> String+dropCached name = if isPrefixOf "Cached" name then drop 6 name else name++tagModifier "InlineQueryResultMpeg4Gif" = "mpeg4_gif"+tagModifier "InlineQueryResultCachedMpeg4Gif" = "mpeg4_gif"+tagModifier x = ((fmap (Char.toLower)) . dropCached . (drop 17)) x++inlineQueryJSONOptions :: Options+inlineQueryJSONOptions = defaultOptions {+ fieldLabelModifier = drop 7+ , omitNothingFields = True+ , sumEncoding = TaggedObject { tagFieldName = "type", contentsFieldName = undefined }+ , constructorTagModifier = tagModifier+ }++instance ToJSON InlineQueryResult where+ toJSON = genericToJSON inlineQueryJSONOptions++instance FromJSON InlineQueryResult where+ parseJSON = genericParseJSON inlineQueryJSONOptions++inlineQueryResultArticle :: Text -> Text -> InputMessageContent -> InlineQueryResult+inlineQueryResultArticle id title content = InlineQueryResultArticle id (Just title) (Just content) Nothing Nothing Nothing Nothing Nothing Nothing Nothing++inlineQueryResultPhoto :: Text -> Text -> Text -> InlineQueryResult+inlineQueryResultPhoto id photoUrl thumbUlr = InlineQueryResultPhoto id photoUrl (Just thumbUlr) Nothing Nothing Nothing Nothing Nothing Nothing Nothing++inlineQueryResultGif :: Text -> Text -> Text -> InlineQueryResult+inlineQueryResultGif id gifUrl thumbUrl = InlineQueryResultGif id gifUrl Nothing Nothing (Just thumbUrl) Nothing Nothing Nothing Nothing++inlineQueryResultMpeg4Gif :: Text -> Text -> Text -> InlineQueryResult+inlineQueryResultMpeg4Gif id mpeg4Url thumbUrl = InlineQueryResultMpeg4Gif id mpeg4Url Nothing Nothing (Just thumbUrl) Nothing Nothing Nothing Nothing++inlineQueryResultVideo :: Text -> Text -> Text -> Text -> Text -> InlineQueryResult+inlineQueryResultVideo id videoUrl mimeType thumbUrl title = InlineQueryResultVideo id videoUrl mimeType (Just thumbUrl) (Just title) Nothing Nothing Nothing Nothing Nothing Nothing Nothing++inlineQueryResultAudio :: Text -> Text -> Text -> InlineQueryResult+inlineQueryResultAudio id audioUrl title = InlineQueryResultAudio id audioUrl (Just title) Nothing Nothing Nothing Nothing++inlineQueryResultVoice :: Text -> Text -> Text -> InlineQueryResult+inlineQueryResultVoice id voiceUrl title = InlineQueryResultVoice id voiceUrl (Just title) Nothing Nothing Nothing++inlineQueryResultDocument :: Text -> Text -> Text -> Text -> InlineQueryResult+inlineQueryResultDocument id title docUrl mimeType = InlineQueryResultDocument id (Just title) Nothing docUrl mimeType Nothing Nothing Nothing Nothing Nothing Nothing++inlineQueryResultLocation :: Text -> Float -> Float -> Text -> InlineQueryResult+inlineQueryResultLocation id lat lon title = InlineQueryResultLocation id lat lon (Just title) Nothing Nothing Nothing Nothing Nothing++inlineQueryResultVenue :: Text -> Float -> Float -> Text -> Text -> InlineQueryResult+inlineQueryResultVenue id lat lon title address = InlineQueryResultVenue id lat lon (Just title) address Nothing Nothing Nothing Nothing Nothing Nothing++inlineQueryResultContact :: Text -> Text -> Text -> InlineQueryResult+inlineQueryResultContact id phoneNumber firstName = InlineQueryResultContact id phoneNumber firstName Nothing Nothing Nothing Nothing Nothing Nothing++inlineQueryResultCachedPhoto :: Text -> Text -> InlineQueryResult+inlineQueryResultCachedPhoto id fileId = InlineQueryResultCachedPhoto id fileId Nothing Nothing Nothing Nothing Nothing++inlineQueryResultCachedGif :: Text -> Text -> InlineQueryResult+inlineQueryResultCachedGif id fileId = InlineQueryResultCachedGif id fileId Nothing Nothing Nothing Nothing++inlineQueryResultCachedMpeg4Gif :: Text -> Text -> InlineQueryResult+inlineQueryResultCachedMpeg4Gif id fileId = InlineQueryResultCachedMpeg4Gif id fileId Nothing Nothing Nothing Nothing++inlineQueryResultCachedSticker :: Text -> Text -> InlineQueryResult+inlineQueryResultCachedSticker id fileId = InlineQueryResultCachedSticker id fileId Nothing Nothing++inlineQueryResultCachedDocument :: Text -> Text -> Text -> InlineQueryResult+inlineQueryResultCachedDocument id fileId title = InlineQueryResultCachedDocument id (Just title) fileId Nothing Nothing Nothing Nothing++inlineQueryResultCachedVideo :: Text -> Text -> Text -> InlineQueryResult+inlineQueryResultCachedVideo id fileId title = InlineQueryResultCachedVideo id fileId (Just title) Nothing Nothing Nothing Nothing++inlineQueryResultCachedVoice :: Text -> Text -> Text -> InlineQueryResult+inlineQueryResultCachedVoice id fileId title = InlineQueryResultCachedVoice id fileId (Just title) Nothing Nothing++inlineQueryResultCachedAudio :: Text -> Text -> InlineQueryResult+inlineQueryResultCachedAudio id fileId = InlineQueryResultCachedAudio id fileId Nothing Nothing++data InlineKeyboardMarkup = InlineKeyboardMarkup+ {+ inline_keyboard :: [[InlineKeyboardButton]]+ } deriving (FromJSON, ToJSON, Show, Generic)++data InlineKeyboardButton = InlineKeyboardButton+ {+ ikb_text :: Text+ , ikb_url :: Maybe Text+ , ikb_callback_data :: Maybe Text+ , ikb_switch_inline_query :: Maybe Text+ } deriving (Show, Generic)++instance ToJSON InlineKeyboardButton where+ toJSON = toJsonDrop 4++instance FromJSON InlineKeyboardButton where+ parseJSON = parseJsonDrop 4++inlineKeyboardButton :: Text -> InlineKeyboardButton+inlineKeyboardButton text = InlineKeyboardButton text Nothing Nothing Nothing++data CallbackQuery = CallbackQuery+ {+ cq_id :: Text+ , cq_from :: User+ , cq_message :: Maybe Message+ , cq_inline_message_id :: Maybe Text+ , cq_data :: Maybe Text+ } deriving (Show, Generic)++instance ToJSON CallbackQuery where+ toJSON = toJsonDrop 3++instance FromJSON CallbackQuery where+ parseJSON = parseJsonDrop 3++-- | This object represents an incoming update.+-- Only one of the optional parameters can be present in any given update.+data Update = Update+ {+ update_id :: Int -- ^ The update's unique identifier. Update identifiers start from a certain positive number and increase sequentially. This ID becomes especially handy if you’re using 'setWebhooks', since it allows you to ignore repeated updates or to restore the correct update sequence, should they get out of order.+ , message :: Maybe Message -- ^ New incoming message of any kind — text, photo, sticker, etc.+ , inline_query :: Maybe InlineQuery -- ^ New incoming inline query+ , chosen_inline_result :: Maybe ChosenInlineResult -- ^ The result of a inline query that was chosen by a user and sent to their chat partner+ , callback_query :: Maybe CallbackQuery -- ^ This object represents an incoming callback query from a callback button in an inline keyboard. If the button that originated the query was attached to a message sent by the bot, the field message will be presented. If the button was attached to a message sent via the bot (in inline mode), the field inline_message_id will be presented.+ } deriving (FromJSON, ToJSON, Show, Generic)++-- | This object represents a point on the map.+data Location = Location+ {+ longitude :: Float -- ^ Longitude as defined by sender+ , latitude :: Float -- ^ Latitude as defined by sender+ } deriving (FromJSON, ToJSON, Show, Generic)++-- | This object represents a file ready to be downloaded. The file can be downloaded via the link+-- @https://api.telegram.org/file/bot<token>/<file_path>@. It is guaranteed that the link will be valid+-- for at least 1 hour. When the link expires, a new one can be requested by calling 'getFile'.+--+-- Maximum file size to download is 20 MB+data File = File+ {+ file_id :: Text -- ^ Unique identifier for this file+ , file_size :: Maybe Int -- ^ File size, if known+ , file_path :: Maybe Text -- ^ File path. Use @https://api.telegram.org/file/bot<token>/<file_path>@ to get the file.+ } deriving (FromJSON, ToJSON, Show, Generic)++-- | This object represent a user's profile pictures.+data UserProfilePhotos = UserProfilePhotos+ {+ total_count :: Int -- ^ Total number of profile pictures the target user has+ , photos :: [[PhotoSize]] -- ^ Requested profile pictures (in up to 4 sizes each)+ } deriving (FromJSON, ToJSON, Show, Generic)++-- | This object represents a message.+data Message = Message+ {+ message_id :: Int -- ^ Unique message identifier+ , from :: Maybe User -- ^ Sender, can be empty for messages sent to channels+ , date :: Int -- ^ Date the message was sent in Unix time+ , chat :: Chat -- ^ Conversation the message belongs to+ , forward_from :: Maybe User -- ^ For forwarded messages, sender of the original message+ , forward_from_chat :: Maybe Chat -- ^ For messages forwarded from a channel, information about the original channel+ , forward_date :: Maybe Int -- ^ For forwarded messages, date the original message was sent in Unix time+ , reply_to_message :: Maybe Message -- ^ For replies, the original message. Note that the 'Message' object in this field will not contain further 'reply_to_message' fields even if it itself is a reply.+ , text :: Maybe Text -- ^ For text messages, the actual UTF-8 text of the message+ , entities :: Maybe [MessageEntity] -- ^ For text messages, special entities like usernames, URLs, bot commands, etc. that appear in the text+ , audio :: Maybe Audio -- ^ Message is an audio file, information about the file+ , document :: Maybe Document -- ^ Message is a general file, information about the file+ , photo :: Maybe [PhotoSize] -- ^ Message is a photo, available sizes of the photo+ , sticker :: Maybe Sticker -- ^ Message is a sticker, information about the sticker+ , video :: Maybe Video -- ^ Message is a video, information about the video+ , voice :: Maybe Voice -- ^ Message is a voice message, information about the file+ , caption :: Maybe Text -- ^ Caption for the photo or video+ , contact :: Maybe Contact -- ^ Message is a shared contact, information about the contact+ , location :: Maybe Location -- ^ Message is a shared location, information about the location+ , venue :: Maybe Venue -- ^ Message is a venue, information about the venue+ , new_chat_member :: Maybe User -- ^ A new member was added to the group, information about them (this member may be the bot itself)+ , left_chat_member :: Maybe User -- ^ A member was removed from the group, information about them (this member may be the bot itself)+ , new_chat_title :: Maybe Text -- ^ A chat title was changed to this value+ , new_chat_photo :: Maybe [PhotoSize] -- ^ A chat photo was change to this value+ , delete_chat_photo :: Maybe Bool -- ^ Service message: the chat photo was deleted+ , group_chat_created :: Maybe Bool -- ^ Service message: the group has been created+ , supergroup_chat_created :: Maybe Bool -- ^ Service message: the supergroup has been created+ , channel_chat_created :: Maybe Bool -- ^ Service message: the channel has been created+ , migrate_to_chat_id :: Maybe Int -- ^ The group has been migrated to a supergroup with the specified identifier, not exceeding 1e13 by absolute value+ , migrate_from_chat_id :: Maybe Int -- ^ The supergroup has been migrated from a group with the specified identifier, not exceeding 1e13 by absolute value+ , pinned_message :: Maybe Message -- ^ Specified message was pinned. Note that the Message object in this field will not contain further reply_to_message fields even if it is itself a reply.+ } deriving (FromJSON, ToJSON, Show, Generic)++-- | This object represents one special entity in a text message. For example, hashtags, usernames, URLs, etc.+data MessageEntity = MessageEntity+ {+ me_type :: Text -- ^ Type of the entity. One of mention (@username), hashtag, bot_command, url, email, bold (bold text), italic (italic text), code (monowidth string), pre (monowidth block), text_link (for clickable text URLs)+ , me_offset :: Int -- ^ Offset in UTF-16 code units to the start of the entity+ , me_length :: Int -- ^ Length of the entity in UTF-16 code units+ , me_url :: Maybe Text -- ^ For “text_link” only, url that will be opened after user taps on the text+ } deriving (Show, Generic)++instance ToJSON MessageEntity where+ toJSON = toJsonDrop 3++instance FromJSON MessageEntity where+ parseJSON = parseJsonDrop 3++-- | This object represents a venue.+data Venue = Venue+ {+ venue_location :: Location -- ^ Venue location+ , venue_title :: Text -- ^ Name of the venue+ , venue_address :: Text -- ^ Address of the venue+ , venue_foursquare_id :: Maybe Text -- ^ Foursquare identifier of the venue+ } deriving (Show, Generic)++instance ToJSON Venue where+ toJSON = toJsonDrop 6++instance FromJSON Venue where+ parseJSON = parseJsonDrop 6++data KeyboardButton = KeyboardButton+ {+ kb_text :: Text -- ^ Text of the button. If none of the optional fields are used, it will be sent to the bot as a message when the button is pressed+ , kb_request_contact :: Maybe Bool -- ^ If True, the user's phone number will be sent as a contact when the button is pressed. Available in private chats only+ , kb_request_location :: Maybe Bool -- ^ If True, the user's current location will be sent when the button is pressed. Available in private chats only+ } deriving (Show, Generic)++instance ToJSON KeyboardButton where+ toJSON = toJsonDrop 3++instance FromJSON KeyboardButton where+ parseJSON = parseJsonDrop 3++keyboardButton :: Text -> KeyboardButton+keyboardButton text = KeyboardButton text Nothing Nothing
src/Web/Telegram/API/Bot/JsonExt.hs view
@@ -1,28 +1,28 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE FlexibleContexts #-} - --- | This module contains helper functions to work with JSON -module Web.Telegram.API.Bot.JsonExt - ( - toJsonDrop, - parseJsonDrop - ) where - -import Data.Aeson -import Data.Aeson.Types -import GHC.Generics -import GHC.TypeLits - --- | Method used to drop prefix from field name during serialization -toJsonDrop prefix = genericToJSON defaultOptions { - fieldLabelModifier = drop prefix - , omitNothingFields = True - } - --- | Method used to drop prefix from field name during deserialization +{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}++-- | This module contains helper functions to work with JSON+module Web.Telegram.API.Bot.JsonExt+ (+ toJsonDrop,+ parseJsonDrop+ ) where++import Data.Aeson+import Data.Aeson.Types+import GHC.Generics+import GHC.TypeLits++-- | Method used to drop prefix from field name during serialization+toJsonDrop prefix = genericToJSON defaultOptions {+ fieldLabelModifier = drop prefix+ , omitNothingFields = True+ }++-- | Method used to drop prefix from field name during deserialization parseJsonDrop prefix = genericParseJSON defaultOptions { fieldLabelModifier = drop prefix }
src/Web/Telegram/API/Bot/Requests.hs view
@@ -1,313 +1,529 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} - --- | This module contains data objects which represents requests to Telegram Bot API -module Web.Telegram.API.Bot.Requests - ( -- * Types - FileUploadContent (..) - , FileUpload (..) - , SendMessageRequest (..) - , ForwardMessageRequest (..) - , SendPhotoRequest (..) - , SendAudioRequest (..) - , SendDocumentRequest (..) - , SendStickerRequest (..) - , SendVideoRequest (..) - , SendVoiceRequest (..) - , SendLocationRequest (..) - , SendChatActionRequest (..) - , ChatAction (..) - , AnswerInlineQueryRequest (..) - , ReplyKeyboard (..) - ) where - -import Data.Aeson -import Data.Aeson.Types -import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as LBS -import Data.Maybe -import Data.Proxy -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import GHC.Generics -import GHC.TypeLits -import Network.HTTP.Client.MultipartFormData -import Network.HTTP.Types.Header (hContentType) -import Network.Mime -import Servant.Client.MultipartFormData (ToMultipartFormData (..)) -import Web.Telegram.API.Bot.JsonExt -import Web.Telegram.API.Bot.Data - --- | This object represents data (image, video, ...) to upload. -data FileUploadContent = - FileUploadFile FilePath - | FileUploadBS BS.ByteString - | FileUploadLBS LBS.ByteString - --- | This object represents data (image, video, ...) with mime type to upload. -data FileUpload = FileUpload - { - fileUpload_type :: MimeType -- ^ Mime type of the upload. - , fileUpload_content :: FileUploadContent -- ^ The payload/source to upload. - } - -fileUploadToPart :: Text -> FileUpload -> Part -fileUploadToPart inputName fileUpload = - let part = - case fileUpload_content fileUpload of - FileUploadFile path -> partFileSource inputName path - FileUploadBS bs -> partBS inputName bs - FileUploadLBS lbs -> partLBS inputName lbs - in part { partContentType = Just (fileUpload_type fileUpload) } - -utf8Part :: Text -> Text -> Part -utf8Part inputName = partBS inputName . T.encodeUtf8 - --- | This object represents request for 'sendMessage' -data SendMessageRequest = SendMessageRequest - { - message_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) - , message_text :: Text -- ^ Text of the message to be sent - , message_parse_mode :: Maybe ParseMode -- ^ Send 'Markdown', if you want Telegram apps to show bold, italic and inline URLs in your bot's message - , message_disable_web_page_preview :: Maybe Bool -- ^ Disables link previews for links in this message - , message_reply_to_message_id :: Maybe Int -- ^ If the message is a reply, ID of the original message - , message_reply_markup :: Maybe ReplyKeyboard -- ^ Additional interface options. A JSON-serialized object for a custom reply keyboard, instructions to hide keyboard or to force a reply from the user. - } deriving (Show, Generic) - -instance ToJSON SendMessageRequest where - toJSON = toJsonDrop 8 - -instance FromJSON SendMessageRequest where - parseJSON = parseJsonDrop 8 - --- | This object represents request for 'forwardMessage' -data ForwardMessageRequest = ForwardMessageRequest - { - forward_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) - , forward_from_chat_id :: Text -- ^ Unique identifier for the chat where the original message was sent (or channel username in the format @@channelusername@) - , forward_mesage_id :: Int -- ^ Unique message identifier - } deriving (Show, Generic) - -instance ToJSON ForwardMessageRequest where - toJSON = toJsonDrop 8 - -instance FromJSON ForwardMessageRequest where - parseJSON = parseJsonDrop 8 - --- | This object represents request for 'sendPhoto' -data SendPhotoRequest payload = SendPhotoRequest - { - photo_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) - , photo_photo :: payload -- ^ Photo to send. Pass a file_id as String to resend a photo that is already on the Telegram servers - , photo_caption :: Maybe Text -- ^ Photo caption (may also be used when resending photos by file_id), 0-200 characters. - , photo_reply_to_message_id :: Maybe Int -- ^ If the message is a reply, ID of the original message - , photo_reply_markup :: Maybe ReplyKeyboard -- ^ Additional interface options. A JSON-serialized object for a custom reply keyboard, instructions to hide keyboard or to force a reply from the user. - } deriving (Show, Generic) - -instance ToJSON (SendPhotoRequest Text) where - toJSON = toJsonDrop 6 - -instance FromJSON (SendPhotoRequest Text) where - parseJSON = parseJsonDrop 6 - -instance ToMultipartFormData (SendPhotoRequest FileUpload) where - toMultipartFormData sendPhotoReq = - [ utf8Part "chat_id" (photo_chat_id sendPhotoReq) ] ++ - catMaybes - [ utf8Part "caption" <$> photo_caption sendPhotoReq - , utf8Part "reply_to_message_id" . T.pack . show <$> photo_reply_to_message_id sendPhotoReq - , partLBS "reply_markup" . encode <$> photo_reply_markup sendPhotoReq - ] ++ - [ fileUploadToPart "photo" (photo_photo sendPhotoReq) ] - --- | This object represents request for 'sendAudio' -data SendAudioRequest = SendAudioRequest - { - _audio_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) - , _audio_audio :: Text -- ^ Audio file to send. Pass a file_id as String to resend an audio that is already on the Telegram servers. - , _audio_duration :: Maybe Int -- ^ Duration of the audio in seconds - , _audio_performer :: Maybe Text -- ^ Performer - , _audio_title :: Maybe Text -- ^ Track name - , _audio_reply_to_message_id :: Maybe Int -- ^ If the message is a reply, ID of the original message - , _audio_reply_markup :: Maybe ReplyKeyboard -- ^ Additional interface options. A JSON-serialized object for a custom reply keyboard, instructions to hide keyboard or to force a reply from the user. - } deriving (Show, Generic) - -instance ToJSON SendAudioRequest where - toJSON = toJsonDrop 7 - -instance FromJSON SendAudioRequest where - parseJSON = parseJsonDrop 7 - --- | This object represents request for 'sendSticker' -data SendStickerRequest = SendStickerRequest - { - sticker_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) - , sticker_sticker :: Text -- ^ Sticker to send. A file_id as String to resend a sticker that is already on the Telegram servers - , sticker_reply_to_message_id :: Maybe Int -- ^ If the message is a reply, ID of the original message - , sticker_reply_markup :: Maybe ReplyKeyboard -- ^ Additional interface options. A JSON-serialized object for a custom reply keyboard, instructions to hide keyboard or to force a reply from the user. - } deriving (Show, Generic) - -instance ToJSON SendStickerRequest where - toJSON = toJsonDrop 8 - -instance FromJSON SendStickerRequest where - parseJSON = parseJsonDrop 8 - --- | This object represents request for 'sendDocument' -data SendDocumentRequest = SendDocumentRequest - { - document_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) - , document_document :: Text -- ^ File to send. A file_id as String to resend a file that is already on the Telegram servers - , document_reply_to_message_id :: Maybe Int -- ^ If the message is a reply, ID of the original message - , document_reply_markup :: Maybe ReplyKeyboard -- ^ Additional interface options. A JSON-serialized object for a custom reply keyboard, instructions to hide keyboard or to force a reply from the user. - } deriving (Show, Generic) - -instance ToJSON SendDocumentRequest where - toJSON = toJsonDrop 9 - -instance FromJSON SendDocumentRequest where - parseJSON = parseJsonDrop 9 - --- | This object represents request for 'sendVideo' -data SendVideoRequest = SendVideoRequest - { - _video_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) - , _video_video :: Text -- ^ Video to send. A file_id as String to resend a video that is already on the Telegram servers - , _video_duration :: Maybe Int -- ^ Duration of sent video in seconds - , _video_caption :: Maybe Text -- ^ Video caption, 0-200 characters. - , _video_reply_to_message_id :: Maybe Int -- ^ If the message is a reply, ID of the original message - , _video_reply_markup :: Maybe ReplyKeyboard -- ^ Additional interface options. A JSON-serialized object for a custom reply keyboard, instructions to hide keyboard or to force a reply from the user. - } deriving (Show, Generic) - -instance ToJSON SendVideoRequest where - toJSON = toJsonDrop 7 - -instance FromJSON SendVideoRequest where - parseJSON = parseJsonDrop 7 - --- | This object represents request for 'sendVoice' -data SendVoiceRequest = SendVoiceRequest - { - _voice_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) - , _voice_voice :: Text -- ^ Audio file to send. A file_id as String to resend an audio that is already on the Telegram servers - , _voice_duration :: Maybe Int -- ^ Duration of sent audio in seconds - , _voice_reply_to_message_id :: Maybe Int -- ^ If the message is a reply, ID of the original message - , _voice_reply_markup :: Maybe ReplyKeyboard -- ^ Additional interface options. A JSON-serialized object for a custom reply keyboard, instructions to hide keyboard or to force a reply from the user. - } deriving (Show, Generic) - -instance ToJSON SendVoiceRequest where - toJSON = toJsonDrop 7 - -instance FromJSON SendVoiceRequest where - parseJSON = parseJsonDrop 7 - --- | This object represents request for 'sendLocation' -data SendLocationRequest = SendLocationRequest - { - location_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) - , location_latitude :: Float -- ^ Latitude of location - , location_longitude :: Float -- ^ Longitude of location - , location_reply_to_message_id :: Maybe Int -- ^ If the message is a reply, ID of the original message - , location_reply_markup :: Maybe ReplyKeyboard -- ^ Additional interface options. A JSON-serialized object for a custom reply keyboard, instructions to hide keyboard or to force a reply from the user. - } deriving (Show, Generic) - -instance ToJSON SendLocationRequest where - toJSON = toJsonDrop 9 - -instance FromJSON SendLocationRequest where - parseJSON = parseJsonDrop 9 - --- | Type of action to broadcast. -data ChatAction = Typing - | UploadPhoto - | RecordVideo - | UploadVideo - | RecordAudio - | UploadAudio - | UploadDocument - | FindLocation deriving (Show, Generic) - -instance ToJSON ChatAction where - toJSON Typing = "typing" - toJSON UploadPhoto = "upload_photo" - toJSON RecordVideo = "record_video" - toJSON UploadVideo = "upload_video" - toJSON RecordAudio = "record_audio" - toJSON UploadAudio = "upload_audio" - toJSON UploadDocument = "upload_document" - toJSON FindLocation = "find_location" - -instance FromJSON ChatAction where - parseJSON "typing" = pure Typing - parseJSON "upload_photo" = pure UploadPhoto - parseJSON "record_video" = pure RecordVideo - parseJSON "upload_video" = pure UploadVideo - parseJSON "record_audio" = pure RecordAudio - parseJSON "upload_audio" = pure UploadAudio - parseJSON "upload_document" = pure UploadDocument - parseJSON "find_location" = pure FindLocation - parseJSON _ = fail "Failed to parse ChatAction" - --- | This object represents request for 'sendChatAction' -data SendChatActionRequest = SendChatActionRequest - { - action_chat_id :: Text - , action_action :: ChatAction - } deriving (Show, Generic) - -instance ToJSON SendChatActionRequest where - toJSON = toJsonDrop 7 - -instance FromJSON SendChatActionRequest where - parseJSON = parseJsonDrop 7 - - -data AnswerInlineQueryRequest = AnswerInlineQueryRequest - { - query_inline_query_id :: Text -- ^ Unique identifier for the answered query - , query_results :: [InlineQueryResult] -- ^ A JSON-serialized array of results for the inline query - , query_cache_time :: Maybe Int -- ^ The maximum amount of time in seconds that the result of the inline query may be cached on the server. Defaults to 300. - , query_is_personal :: Maybe Bool -- ^ Pass True, if results may be cached on the server side only for the user that sent the query. By default, results may be returned to any user who sends the same query - , query_next_offset :: Maybe Text -- ^ Pass the offset that a client should send in the next query with the same text to receive more results. Pass an empty string if there are no more results or if you don‘t support pagination. Offset length can’t exceed 64 bytes. - } deriving (Show, Generic) - -instance ToJSON AnswerInlineQueryRequest where - toJSON = toJsonDrop 6 - -instance FromJSON AnswerInlineQueryRequest where - parseJSON = parseJsonDrop 6 - -data ReplyKeyboard = - -- | This object represents a custom keyboard with reply options - ReplyKeyboardMarkup - { - reply_keyboard :: [[Text]] -- ^ Array of button rows, each represented by an Array of Strings - , reply_resize_keyboard :: Maybe Bool -- ^ Requests clients to resize the keyboard vertically for optimal fit (e.g., make the keyboard smaller if there are just two rows of buttons). Defaults to false, in which case the custom keyboard is always of the same height as the app's standard keyboard. - , reply_one_time_keyboard :: Maybe Bool -- ^ Requests clients to hide the keyboard as soon as it's been used. Defaults to false. - , reply_selective :: Maybe Bool -- ^ Use this parameter if you want to show the keyboard to specific users only. Targets: 1) users that are @mentioned in the text of the Message object; 2) if the bot's message is a reply (has reply_to_message_id), sender of the original message. Example: A user requests to change the bot‘s language, bot replies to the request with a keyboard to select the new language. Other users in the group don’t see the keyboard. - } - -- | Upon receiving a message with this object, Telegram clients will hide the current custom keyboard and display the default letter-keyboard. By default, custom keyboards are displayed until a new keyboard is sent by a bot. An exception is made for one-time keyboards that are hidden immediately after the user presses a button - | ReplyKeyboardHide - { - reply_hide_keyboard :: Bool -- ^ Requests clients to hide the custom keyboard - , reply_selective :: Maybe Bool -- ^ Use this parameter if you want to hide keyboard for specific users only. Targets: 1) users that are @mentioned in the text of the Message object; 2) if the bot's message is a reply (has reply_to_message_id), sender of the original message. Example: A user votes in a poll, bot returns confirmation message in reply to the vote and hides keyboard for that user, while still showing the keyboard with poll options to users who haven't voted yet. - } - -- | Upon receiving a message with this object, Telegram clients will display a reply interface to the user (act as if the user has selected the bot‘s message and tapped ’Reply'). This can be extremely useful if you want to create user-friendly step-by-step interfaces without having to sacrifice privacy mode. - | ForceReply - { - reply_force_reply :: Bool -- ^ Shows reply interface to the user, as if they manually selected the bot‘s message and tapped ’Reply' - , reply_selective :: Maybe Bool -- ^ Use this parameter if you want to force reply from specific users only. Targets: 1) users that are @mentioned in the text of the Message object; 2) if the bot's message is a reply (has reply_to_message_id), sender of the original message. - } deriving (Show, Generic) - -instance ToJSON ReplyKeyboard where - toJSON = toJsonDrop 6 - -instance FromJSON ReplyKeyboard where - parseJSON = parseJsonDrop 6 +{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}++-- | This module contains data objects which represents requests to Telegram Bot API+module Web.Telegram.API.Bot.Requests+ ( -- * Types+ SendMessageRequest (..)+ , ForwardMessageRequest (..)+ , FileUpload (..)+ , FileUploadContent (..)+ , SendPhotoRequest (..)+ , SendAudioRequest (..)+ , SendDocumentRequest (..)+ , SendStickerRequest (..)+ , SendVideoRequest (..)+ , SendVoiceRequest (..)+ , SendLocationRequest (..)+ , SendVenueRequest (..)+ , SendContactRequest (..)+ , SendChatActionRequest (..)+ , ChatAction (..)+ , AnswerInlineQueryRequest (..)+ , AnswerCallbackQueryRequest (..)+ , ReplyKeyboard (..)+ , EditMessageTextRequest (..)+ , EditMessageCaptionRequest (..)+ , EditMessageReplyMarkupRequest (..)+ -- * Functions+ , sendMessageRequest+ , forwardMessageRequest+ , sendPhotoRequest+ , uploadPhotoRequest+ , sendAudioRequest+ , sendDocumentRequest+ , sendStickerRequest+ , sendVideoRequest+ , sendVoiceRequest+ , sendLocationRequest+ , sendVenueRequest+ , sendContactRequest+ , sendChatActionRequest+ , answerInlineQueryRequest+ , answerCallbackQueryRequest+ , replyKeyboardMarkup+ , replyKeyboardHide+ , forceReply+ , editMessageTextRequest+ , editMessageCaptionRequest+ , editMessageReplyMarkupRequest+ ) where++import Data.Aeson+import Data.Aeson.Types+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import Data.Maybe+import Data.Proxy+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import GHC.Generics+import GHC.TypeLits+import Network.HTTP.Client.MultipartFormData+import Network.HTTP.Types.Header (hContentType)+import Network.Mime+import Servant.Client.MultipartFormData (ToMultipartFormData (..))+import Web.Telegram.API.Bot.JsonExt+import Web.Telegram.API.Bot.Data+++-- | This object represents data (image, video, ...) to upload.+data FileUploadContent =+ FileUploadFile FilePath+ | FileUploadBS BS.ByteString+ | FileUploadLBS LBS.ByteString++-- | This object represents data (image, video, ...) with mime type to upload.+data FileUpload = FileUpload+ {+ fileUpload_type :: MimeType -- ^ Mime type of the upload.+ , fileUpload_content :: FileUploadContent -- ^ The payload/source to upload.+ }++fileUploadToPart :: Text -> FileUpload -> Part+fileUploadToPart inputName fileUpload =+ let part =+ case fileUpload_content fileUpload of+ FileUploadFile path -> partFileSource inputName path+ FileUploadBS bs -> partBS inputName bs+ FileUploadLBS lbs -> partLBS inputName lbs+ in part { partContentType = Just (fileUpload_type fileUpload) }++utf8Part :: Text -> Text -> Part+utf8Part inputName = partBS inputName . T.encodeUtf8++-- | This object represents request for 'sendMessage'+data SendMessageRequest = SendMessageRequest+ {+ message_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@)+ , message_text :: Text -- ^ Text of the message to be sent+ , message_parse_mode :: Maybe ParseMode -- ^ Send 'Markdown', if you want Telegram apps to show bold, italic and inline URLs in your bot's message+ , message_disable_web_page_preview :: Maybe Bool -- ^ Disables link previews for links in this message+ , message_disable_notification :: Maybe Bool -- ^ Sends the message silently. iOS users will not receive a notification, Android users will receive a notification with no sound.+ , message_reply_to_message_id :: Maybe Int -- ^ If the message is a reply, ID of the original message+ , message_reply_markup :: Maybe ReplyKeyboard -- ^ Additional interface options. A JSON-serialized object for a custom reply keyboard, instructions to hide keyboard or to force a reply from the user.+ } deriving (Show, Generic)++instance ToJSON SendMessageRequest where+ toJSON = toJsonDrop 8++instance FromJSON SendMessageRequest where+ parseJSON = parseJsonDrop 8++sendMessageRequest :: Text -> Text -> SendMessageRequest+sendMessageRequest chatId text = SendMessageRequest chatId text Nothing Nothing Nothing Nothing Nothing++-- | This object represents request for 'forwardMessage'+data ForwardMessageRequest = ForwardMessageRequest+ {+ forward_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@)+ , forward_from_chat_id :: Text -- ^ Unique identifier for the chat where the original message was sent (or channel username in the format @@channelusername@)+ , forward_disable_notification :: Maybe Bool -- ^ Sends the message silently. iOS users will not receive a notification, Android users will receive a notification with no sound.+ , forward_message_id :: Int -- ^ Unique message identifier+ } deriving (Show, Generic)++instance ToJSON ForwardMessageRequest where+ toJSON = toJsonDrop 8++instance FromJSON ForwardMessageRequest where+ parseJSON = parseJsonDrop 8++forwardMessageRequest :: Text -> Text -> Int -> ForwardMessageRequest+forwardMessageRequest chatId fromChatId forwardMessageId = ForwardMessageRequest chatId fromChatId Nothing forwardMessageId++-- | This object represents request for 'sendPhoto'+data SendPhotoRequest payload = SendPhotoRequest+ {+ photo_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@)+ , photo_photo :: payload -- ^ Photo to send. You can either pass a file_id as String to resend a photo that is already on the Telegram servers, or upload a new photo.+ , photo_caption :: Maybe Text -- ^ Photo caption (may also be used when resending photos by file_id), 0-200 characters.+ , photo_disable_notification :: Maybe Bool -- ^ Sends the message silently. iOS users will not receive a notification, Android users will receive a notification with no sound.+ , photo_reply_to_message_id :: Maybe Int -- ^ If the message is a reply, ID of the original message+ , photo_reply_markup :: Maybe ReplyKeyboard -- ^ Additional interface options. A JSON-serialized object for a custom reply keyboard, instructions to hide keyboard or to force a reply from the user.+ } deriving (Show, Generic)++instance ToJSON (SendPhotoRequest Text) where+ toJSON = toJsonDrop 6++instance FromJSON (SendPhotoRequest Text) where+ parseJSON = parseJsonDrop 6++sendPhotoRequest :: Text -> Text -> SendPhotoRequest Text+sendPhotoRequest chatId photo = SendPhotoRequest chatId photo Nothing Nothing Nothing Nothing++uploadPhotoRequest :: Text -> FileUpload -> SendPhotoRequest FileUpload+uploadPhotoRequest chatId photo = SendPhotoRequest chatId photo Nothing Nothing Nothing Nothing++instance ToMultipartFormData (SendPhotoRequest FileUpload) where+ toMultipartFormData sendPhotoReq =+ [ utf8Part "chat_id" (photo_chat_id sendPhotoReq) ] +++ catMaybes+ [ utf8Part "caption" <$> photo_caption sendPhotoReq+ , utf8Part "reply_to_message_id" . T.pack . show <$> photo_reply_to_message_id sendPhotoReq+ , partLBS "reply_markup" . encode <$> photo_reply_markup sendPhotoReq+ ] +++ [ fileUploadToPart "photo" (photo_photo sendPhotoReq) ]++-- | This object represents request for 'sendAudio'+data SendAudioRequest = SendAudioRequest+ {+ _audio_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@)+ , _audio_audio :: Text -- ^ Audio file to send. Pass a file_id as String to resend an audio that is already on the Telegram servers.+ , _audio_duration :: Maybe Int -- ^ Duration of the audio in seconds+ , _audio_performer :: Maybe Text -- ^ Performer+ , _audio_title :: Maybe Text -- ^ Track name+ , _audio_disable_notification :: Maybe Bool -- ^ Sends the message silently. iOS users will not receive a notification, Android users will receive a notification with no sound.+ , _audio_reply_to_message_id :: Maybe Int -- ^ If the message is a reply, ID of the original message+ , _audio_reply_markup :: Maybe ReplyKeyboard -- ^ Additional interface options. A JSON-serialized object for a custom reply keyboard, instructions to hide keyboard or to force a reply from the user.+ } deriving (Show, Generic)++instance ToJSON SendAudioRequest where+ toJSON = toJsonDrop 7++instance FromJSON SendAudioRequest where+ parseJSON = parseJsonDrop 7++sendAudioRequest :: Text -> Text -> SendAudioRequest+sendAudioRequest chatId audio = SendAudioRequest chatId audio Nothing Nothing Nothing Nothing Nothing Nothing++-- | This object represents request for 'sendSticker'+data SendStickerRequest = SendStickerRequest+ {+ sticker_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@)+ , sticker_sticker :: Text -- ^ Sticker to send. A file_id as String to resend a sticker that is already on the Telegram servers+ , sticker_disable_notification :: Maybe Bool -- ^ Sends the message silently. iOS users will not receive a notification, Android users will receive a notification with no sound.+ , sticker_reply_to_message_id :: Maybe Int -- ^ If the message is a reply, ID of the original message+ , sticker_reply_markup :: Maybe ReplyKeyboard -- ^ Additional interface options. A JSON-serialized object for a custom reply keyboard, instructions to hide keyboard or to force a reply from the user.+ } deriving (Show, Generic)++instance ToJSON SendStickerRequest where+ toJSON = toJsonDrop 8++instance FromJSON SendStickerRequest where+ parseJSON = parseJsonDrop 8++sendStickerRequest :: Text -> Text -> SendStickerRequest+sendStickerRequest chatId sticker = SendStickerRequest chatId sticker Nothing Nothing Nothing++-- | This object represents request for 'sendDocument'+data SendDocumentRequest = SendDocumentRequest+ {+ document_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@)+ , document_document :: Text -- ^ File to send. A file_id as String to resend a file that is already on the Telegram servers+ , document_caption :: Maybe Text -- ^ Document caption (may also be used when resending documents by file_id), 0-200 characters+ , document_disable_notification :: Maybe Bool -- ^ Sends the message silently. iOS users will not receive a notification, Android users will receive a notification with no sound.+ , document_reply_to_message_id :: Maybe Int -- ^ If the message is a reply, ID of the original message+ , document_reply_markup :: Maybe ReplyKeyboard -- ^ Additional interface options. A JSON-serialized object for a custom reply keyboard, instructions to hide keyboard or to force a reply from the user.+ } deriving (Show, Generic)++instance ToJSON SendDocumentRequest where+ toJSON = toJsonDrop 9++instance FromJSON SendDocumentRequest where+ parseJSON = parseJsonDrop 9++sendDocumentRequest :: Text -> Text -> SendDocumentRequest+sendDocumentRequest chatId document = SendDocumentRequest chatId document Nothing Nothing Nothing Nothing++-- | This object represents request for 'sendVideo'+data SendVideoRequest = SendVideoRequest+ {+ _video_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@)+ , _video_video :: Text -- ^ Video to send. A file_id as String to resend a video that is already on the Telegram servers+ , _video_duration :: Maybe Int -- ^ Duration of sent video in seconds+ , _video_caption :: Maybe Text -- ^ Video caption, 0-200 characters.+ , _video_disable_notification :: Maybe Bool -- ^ Sends the message silently. iOS users will not receive a notification, Android users will receive a notification with no sound.+ , _video_reply_to_message_id :: Maybe Int -- ^ If the message is a reply, ID of the original message+ , _video_reply_markup :: Maybe ReplyKeyboard -- ^ Additional interface options. A JSON-serialized object for a custom reply keyboard, instructions to hide keyboard or to force a reply from the user.+ } deriving (Show, Generic)++instance ToJSON SendVideoRequest where+ toJSON = toJsonDrop 7++instance FromJSON SendVideoRequest where+ parseJSON = parseJsonDrop 7++sendVideoRequest :: Text -> Text -> SendVideoRequest+sendVideoRequest chatId video = SendVideoRequest chatId video Nothing Nothing Nothing Nothing Nothing++-- | This object represents request for 'sendVoice'+data SendVoiceRequest = SendVoiceRequest+ {+ _voice_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@)+ , _voice_voice :: Text -- ^ Audio file to send. A file_id as String to resend an audio that is already on the Telegram servers+ , _voice_duration :: Maybe Int -- ^ Duration of sent audio in seconds+ , _voice_disable_notification :: Maybe Bool -- ^ Sends the message silently. iOS users will not receive a notification, Android users will receive a notification with no sound.+ , _voice_reply_to_message_id :: Maybe Int -- ^ If the message is a reply, ID of the original message+ , _voice_reply_markup :: Maybe ReplyKeyboard -- ^ Additional interface options. A JSON-serialized object for a custom reply keyboard, instructions to hide keyboard or to force a reply from the user.+ } deriving (Show, Generic)++instance ToJSON SendVoiceRequest where+ toJSON = toJsonDrop 7++instance FromJSON SendVoiceRequest where+ parseJSON = parseJsonDrop 7++sendVoiceRequest :: Text -> Text -> SendVoiceRequest+sendVoiceRequest chatId voice = SendVoiceRequest chatId voice Nothing Nothing Nothing Nothing++-- | This object represents request for 'sendLocation'+data SendLocationRequest = SendLocationRequest+ {+ location_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@)+ , location_latitude :: Float -- ^ Latitude of location+ , location_longitude :: Float -- ^ Longitude of location+ , location_disable_notification :: Maybe Bool -- ^ Sends the message silently. iOS users will not receive a notification, Android users will receive a notification with no sound.+ , location_reply_to_message_id :: Maybe Int -- ^ If the message is a reply, ID of the original message+ , location_reply_markup :: Maybe ReplyKeyboard -- ^ Additional interface options. A JSON-serialized object for a custom reply keyboard, instructions to hide keyboard or to force a reply from the user.+ } deriving (Show, Generic)++instance ToJSON SendLocationRequest where+ toJSON = toJsonDrop 9++instance FromJSON SendLocationRequest where+ parseJSON = parseJsonDrop 9++sendLocationRequest :: Text -> Float -> Float -> SendLocationRequest+sendLocationRequest chatId latitude longitude = SendLocationRequest chatId latitude longitude Nothing Nothing Nothing++-- | This object represents request for 'sendVenue'+data SendVenueRequest = SendVenueRequest+ {+ _venue_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@)+ , _venue_latitude :: Float -- ^ Latitude of the venue+ , _venue_longitude :: Float -- ^ Longitude of the venue+ , _venue_title :: Text -- ^ Name of the venue+ , _venue_address :: Text -- ^ Address of the venue+ , _venue_foursquare_id :: Maybe Text -- ^ Foursquare identifier of the venue+ , _venue_disable_notification :: Maybe Bool -- ^ Sends the message silently. iOS users will not receive a notification, Android users will receive a notification with no sound.+ , _venue_reply_to_message_id :: Maybe Int -- ^ If the message is a reply, ID of the original message+ , _venue_reply_markup :: Maybe ReplyKeyboard -- ^ Additional interface options. A JSON-serialized object for a custom reply keyboard, instructions to hide keyboard or to force a reply from the user.+ } deriving (Show, Generic)++instance ToJSON SendVenueRequest where+ toJSON = toJsonDrop 7++instance FromJSON SendVenueRequest where+ parseJSON = parseJsonDrop 7++sendVenueRequest :: Text -> Float -> Float -> Text -> Text -> SendVenueRequest+sendVenueRequest chatId latitude longitude title address = SendVenueRequest chatId latitude longitude title address Nothing Nothing Nothing Nothing++-- | This object represents request for 'sendContact'+data SendContactRequest = SendContactRequest+ {+ _contact_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@)+ , _contact_phone_number :: Text -- ^ Contact's phone number+ , _contact_first_name :: Text -- ^ Contact's first name+ , _contact_last_name :: Maybe Text -- ^ Contact's last name+ , _contact_disable_notification :: Maybe Bool -- ^ Sends the message silently. iOS users will not receive a notification, Android users will receive a notification with no sound.+ , _contact_reply_to_message_id :: Maybe Int -- ^ If the message is a reply, ID of the original message+ , _contact_reply_markup :: Maybe ReplyKeyboard -- ^ Additional interface options. A JSON-serialized object for a custom reply keyboard, instructions to hide keyboard or to force a reply from the user.+ } deriving (Show, Generic)++instance ToJSON SendContactRequest where+ toJSON = toJsonDrop 9++instance FromJSON SendContactRequest where+ parseJSON = parseJsonDrop 9++sendContactRequest :: Text -> Text -> Text -> SendContactRequest+sendContactRequest chatId phoneNumber firstName = SendContactRequest chatId phoneNumber firstName Nothing Nothing Nothing Nothing++-- | Type of action to broadcast.+data ChatAction = Typing+ | UploadPhoto+ | RecordVideo+ | UploadVideo+ | RecordAudio+ | UploadAudio+ | UploadDocument+ | FindLocation deriving (Show, Generic)++instance ToJSON ChatAction where+ toJSON Typing = "typing"+ toJSON UploadPhoto = "upload_photo"+ toJSON RecordVideo = "record_video"+ toJSON UploadVideo = "upload_video"+ toJSON RecordAudio = "record_audio"+ toJSON UploadAudio = "upload_audio"+ toJSON UploadDocument = "upload_document"+ toJSON FindLocation = "find_location"++instance FromJSON ChatAction where+ parseJSON "typing" = pure Typing+ parseJSON "upload_photo" = pure UploadPhoto+ parseJSON "record_video" = pure RecordVideo+ parseJSON "upload_video" = pure UploadVideo+ parseJSON "record_audio" = pure RecordAudio+ parseJSON "upload_audio" = pure UploadAudio+ parseJSON "upload_document" = pure UploadDocument+ parseJSON "find_location" = pure FindLocation+ parseJSON _ = fail "Failed to parse ChatAction"++-- | This object represents request for 'sendChatAction'+data SendChatActionRequest = SendChatActionRequest+ {+ action_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format `@channelusername`)+ , action_action :: ChatAction -- ^ Type of action to broadcast.+ } deriving (Show, Generic)++instance ToJSON SendChatActionRequest where+ toJSON = toJsonDrop 7++instance FromJSON SendChatActionRequest where+ parseJSON = parseJsonDrop 7++sendChatActionRequest :: Text -> ChatAction -> SendChatActionRequest+sendChatActionRequest chatId action = SendChatActionRequest chatId action++data AnswerInlineQueryRequest = AnswerInlineQueryRequest+ {+ query_inline_query_id :: Text -- ^ Unique identifier for the answered query+ , query_results :: [InlineQueryResult] -- ^ A JSON-serialized array of results for the inline query+ , query_cache_time :: Maybe Int -- ^ The maximum amount of time in seconds that the result of the inline query may be cached on the server. Defaults to 300.+ , query_is_personal :: Maybe Bool -- ^ Pass True, if results may be cached on the server side only for the user that sent the query. By default, results may be returned to any user who sends the same query+ , query_next_offset :: Maybe Text -- ^ Pass the offset that a client should send in the next query with the same text to receive more results. Pass an empty string if there are no more results or if you don‘t support pagination. Offset length can’t exceed 64 bytes.+ , query_switch_pm_text :: Maybe Text -- ^ If passed, clients will display a button with specified text that switches the user to a private chat with the bot and sends the bot a start message with the parameter switch_pm_parameter+ , query_switch_pm_parameter :: Maybe Text -- ^ Parameter for the start message sent to the bot when user presses the switch button+ --+ -- Example: An inline bot that sends YouTube videos can ask the user to connect the bot to+ -- their YouTube account to adapt search results accordingly. To do this, it displays a+ -- ‘Connect your YouTube account’ button above the results, or even before showing any.+ -- The user presses the button, switches to a private chat with the bot and, in doing so,+ -- passes a start parameter that instructs the bot to return an oauth link. Once done,+ -- the bot can offer a switch_inline button so that the user can easily return to the chat where they wanted to use the bot's inline capabilities.+ } deriving (Show, Generic)++instance ToJSON AnswerInlineQueryRequest where+ toJSON = toJsonDrop 6++instance FromJSON AnswerInlineQueryRequest where+ parseJSON = parseJsonDrop 6++answerInlineQueryRequest :: Text -> [InlineQueryResult] -> AnswerInlineQueryRequest+answerInlineQueryRequest queryId results = AnswerInlineQueryRequest queryId results Nothing Nothing Nothing Nothing Nothing++data AnswerCallbackQueryRequest = AnswerCallbackQueryRequest+ {+ cq_callback_query_id :: Text -- ^ Unique identifier for the query to be answered+ , cq_text :: Maybe Text -- ^ Text of the notification. If not specified, nothing will be shown to the user+ , cq_show_alert :: Maybe Bool -- ^ If true, an alert will be shown by the client instead of a notification at the top of the chat screen. Defaults to false.+ } deriving (Show, Generic)++instance ToJSON AnswerCallbackQueryRequest where+ toJSON = toJsonDrop 3++instance FromJSON AnswerCallbackQueryRequest where+ parseJSON = parseJsonDrop 3++answerCallbackQueryRequest :: Text -> AnswerCallbackQueryRequest+answerCallbackQueryRequest chatId = AnswerCallbackQueryRequest chatId Nothing Nothing++data ReplyKeyboard =+ -- | This object represents a custom keyboard with reply options+ ReplyKeyboardMarkup+ {+ reply_keyboard :: [[KeyboardButton]] -- ^ Array of button rows, each represented by an Array of 'KeyboardButton' objects+ , reply_resize_keyboard :: Maybe Bool -- ^ Requests clients to resize the keyboard vertically for optimal fit (e.g., make the keyboard smaller if there are just two rows of buttons). Defaults to false, in which case the custom keyboard is always of the same height as the app's standard keyboard.+ , reply_one_time_keyboard :: Maybe Bool -- ^ Requests clients to hide the keyboard as soon as it's been used. Defaults to false.+ , reply_selective :: Maybe Bool -- ^ Use this parameter if you want to show the keyboard to specific users only. Targets: 1) users that are @mentioned in the text of the Message object; 2) if the bot's message is a reply (has reply_to_message_id), sender of the original message. Example: A user requests to change the bot‘s language, bot replies to the request with a keyboard to select the new language. Other users in the group don’t see the keyboard.+ }+ -- | Upon receiving a message with this object, Telegram clients will hide the current custom keyboard and display the default letter-keyboard. By default, custom keyboards are displayed until a new keyboard is sent by a bot. An exception is made for one-time keyboards that are hidden immediately after the user presses a button+ | ReplyKeyboardHide+ {+ reply_hide_keyboard :: Bool -- ^ Requests clients to hide the custom keyboard+ , reply_selective :: Maybe Bool -- ^ Use this parameter if you want to hide keyboard for specific users only. Targets: 1) users that are @mentioned in the text of the Message object; 2) if the bot's message is a reply (has reply_to_message_id), sender of the original message. Example: A user votes in a poll, bot returns confirmation message in reply to the vote and hides keyboard for that user, while still showing the keyboard with poll options to users who haven't voted yet.+ }+ -- | Upon receiving a message with this object, Telegram clients will display a reply interface to the user (act as if the user has selected the bot‘s message and tapped ’Reply'). This can be extremely useful if you want to create user-friendly step-by-step interfaces without having to sacrifice privacy mode.+ | ForceReply+ {+ reply_force_reply :: Bool -- ^ Shows reply interface to the user, as if they manually selected the bot‘s message and tapped ’Reply'+ , reply_selective :: Maybe Bool -- ^ Use this parameter if you want to force reply from specific users only. Targets: 1) users that are @mentioned in the text of the Message object; 2) if the bot's message is a reply (has reply_to_message_id), sender of the original message.+ } deriving (Show, Generic)++instance ToJSON ReplyKeyboard where+ toJSON = toJsonDrop 6++instance FromJSON ReplyKeyboard where+ parseJSON = parseJsonDrop 6++replyKeyboardMarkup :: [[KeyboardButton]] -> ReplyKeyboard+replyKeyboardMarkup keyboard = ReplyKeyboardMarkup keyboard Nothing Nothing Nothing++replyKeyboardHide :: ReplyKeyboard+replyKeyboardHide = ReplyKeyboardHide True Nothing++forceReply :: ReplyKeyboard+forceReply = ForceReply True Nothing++data EditMessageTextRequest = EditMessageTextRequest+ {+ emt_chat_id :: Maybe Text -- ^ Required if `inline_message_id` is not specified. Unique identifier for the target chat or username of the target channel (in the format `@channelusername`)+ , emt_message_id :: Maybe Int -- ^ if `inline_message_id` is not specified. Unique identifier of the sent message+ , emt_inline_message_id :: Maybe Text -- ^ Required if chat_id and message_id are not specified. Identifier of the inline message+ , emt_text :: Text -- ^ New text of the message+ , emt_parse_mode :: Maybe ParseMode -- ^ Send `Markdown` or `HTML`, if you want Telegram apps to show bold, italic, fixed-width text or inline URLs in your bot's message.+ , emt_disable_web_page_preview :: Maybe Bool -- ^ Disables link previews for links in this message+ , emt_reply_markup :: Maybe InlineKeyboardMarkup -- ^ A JSON-serialized object for an inline keyboard.+ } deriving (Show, Generic)++instance ToJSON EditMessageTextRequest where+ toJSON = toJsonDrop 4++instance FromJSON EditMessageTextRequest where+ parseJSON = parseJsonDrop 4++editMessageTextRequest :: Text -> Int -> Text -> EditMessageTextRequest+editMessageTextRequest chatId messageId text = EditMessageTextRequest (Just chatId) (Just messageId) Nothing text Nothing Nothing Nothing++editInlineMessageTextRequest :: Text -> Text -> EditMessageTextRequest+editInlineMessageTextRequest inlineMessageId text = EditMessageTextRequest Nothing Nothing (Just inlineMessageId) text Nothing Nothing Nothing++data EditMessageCaptionRequest = EditMessageCaptionRequest+ {+ emc_chat_id :: Maybe Text -- ^ Required if `inline_message_id` is not specified. Unique identifier for the target chat or username of the target channel (in the format `@channelusername`)+ , emc_message_id :: Maybe Int -- ^ Required if `inline_message_id` is not specified. Unique identifier of the sent message+ , emc_inline_message_id :: Maybe Text -- ^ Required if `chat_id` and `message_id` are not specified. Identifier of the inline message+ , emc_caption :: Maybe Text -- ^ New caption of the message+ , emc_reply_markup :: Maybe InlineKeyboardMarkup -- ^ A JSON-serialized object for an inline keyboard.+ } deriving (Show, Generic)++instance ToJSON EditMessageCaptionRequest where+ toJSON = toJsonDrop 4++instance FromJSON EditMessageCaptionRequest where+ parseJSON = parseJsonDrop 4++editMessageCaptionRequest :: Text -> Int -> Maybe Text -> EditMessageCaptionRequest+editMessageCaptionRequest chatId messageId caption = EditMessageCaptionRequest (Just chatId) (Just messageId) Nothing caption Nothing++editInlineMessageCaptionRequest :: Text -> Maybe Text -> EditMessageCaptionRequest+editInlineMessageCaptionRequest inlineMessageId caption = EditMessageCaptionRequest Nothing Nothing (Just inlineMessageId) caption Nothing++data EditMessageReplyMarkupRequest = EditMessageReplyMarkupRequest+ {+ emrm_chat_id :: Maybe Text -- ^ Required if `inline_message_id` is not specified. Unique identifier for the target chat or username of the target channel (in the format `@channelusername`)+ , emrm_message_id :: Maybe Int -- ^ Required if `inline_message_id` is not specified. Unique identifier of the sent message+ , emrm_inline_message_id :: Maybe Text -- ^ Required if `chat_id` and `message_id` are not specified. Identifier of the inline message+ , emrm_reply_markup :: Maybe InlineKeyboardMarkup -- ^ A JSON-serialized object for an inline keyboard.+ } deriving (Show, Generic)++instance ToJSON EditMessageReplyMarkupRequest where+ toJSON = toJsonDrop 5++instance FromJSON EditMessageReplyMarkupRequest where+ parseJSON = parseJsonDrop 5++editMessageReplyMarkupRequest :: Text -> Int -> Maybe InlineKeyboardMarkup -> EditMessageReplyMarkupRequest+editMessageReplyMarkupRequest chatId messageId keyboard = EditMessageReplyMarkupRequest (Just chatId) (Just messageId) Nothing keyboard++editInlineMessageReplyMarkupRequest :: Text -> Maybe InlineKeyboardMarkup -> EditMessageReplyMarkupRequest+editInlineMessageReplyMarkupRequest inlineMessageId keyboard = EditMessageReplyMarkupRequest Nothing Nothing (Just inlineMessageId) keyboard
src/Web/Telegram/API/Bot/Responses.hs view
@@ -1,127 +1,166 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE FlexibleContexts #-} - --- | This module contains responses from Telegram Bot API -module Web.Telegram.API.Bot.Responses - ( -- * Types - GetMeResponse (..) - , MessageResponse (..) - , ChatActionResponse (..) - , UpdatesResponse (..) - , FileResponse (..) - , UserProfilePhotosResponse (..) - , SetWebhookResponse (..) - , InlineQueryResponse (..) - ) where - -import Data.Aeson -import Data.Aeson.Types -import Data.Maybe -import Data.Proxy -import Data.Text (Text) -import qualified Data.Text as T -import GHC.Generics -import GHC.TypeLits -import Web.Telegram.API.Bot.Data -import Web.Telegram.API.Bot.JsonExt - --- | This object represents 'getMe' response -data GetMeResponse = GetMeResponse - { - user_result :: User - } deriving (Show, Generic) - -instance ToJSON GetMeResponse where - toJSON = toJsonDrop 5 - -instance FromJSON GetMeResponse where - parseJSON = parseJsonDrop 5 - --- | This object represents message response -data MessageResponse = MessageResponse - { - message_result :: Message - } deriving (Show, Generic) - -instance ToJSON MessageResponse where - toJSON = toJsonDrop 8 - -instance FromJSON MessageResponse where - parseJSON = parseJsonDrop 8 - --- | This object represents 'sendChatAction' response -data ChatActionResponse = ChatActionResponse - { - action_result :: Bool - } deriving (Show, Generic) - -instance ToJSON ChatActionResponse where - toJSON = toJsonDrop 7 - -instance FromJSON ChatActionResponse where - parseJSON = parseJsonDrop 7 - --- | This object represents 'getUpdates' response -data UpdatesResponse = UpdatesResponse - { - update_result :: [Update] - } deriving (Show, Generic) - -instance ToJSON UpdatesResponse where - toJSON = toJsonDrop 7 - -instance FromJSON UpdatesResponse where - parseJSON = parseJsonDrop 7 - --- | This object represents file response -data FileResponse = FileResponse - { - file_result :: File - } deriving (Show, Generic) - -instance ToJSON FileResponse where - toJSON = toJsonDrop 5 - -instance FromJSON FileResponse where - parseJSON = parseJsonDrop 5 - --- | This object represents user profile photos response -data UserProfilePhotosResponse = UserProfilePhotosResponse - { - photos_result :: UserProfilePhotos - } deriving (Show, Generic) - -instance ToJSON UserProfilePhotosResponse where - toJSON = toJsonDrop 7 - -instance FromJSON UserProfilePhotosResponse where - parseJSON = parseJsonDrop 7 - --- | This object represents 'setWebhook' response -data SetWebhookResponse = SetWebhookResponse - { - webhook_result :: Bool - } deriving (Show, Generic) - -instance ToJSON SetWebhookResponse where - toJSON = toJsonDrop 8 - -instance FromJSON SetWebhookResponse where - parseJSON = parseJsonDrop 8 - --- | This object represents 'answerInlineQuery' response -data InlineQueryResponse = InlineQueryResponse - { - query_result :: Bool - } deriving (Show, Generic) - -instance ToJSON InlineQueryResponse where - toJSON = toJsonDrop 6 - -instance FromJSON InlineQueryResponse where +{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleContexts #-}++-- | This module contains responses from Telegram Bot API+module Web.Telegram.API.Bot.Responses+ ( -- * Types+ GetMeResponse (..)+ , MessageResponse (..)+ , ChatActionResponse (..)+ , UpdatesResponse (..)+ , FileResponse (..)+ , UserProfilePhotosResponse (..)+ , SetWebhookResponse (..)+ , InlineQueryResponse (..)+ , CallbackQueryResponse (..)+ , KickChatMemberResponse (..)+ , UnbanChatMemberResponse (..)+ ) where++import Data.Aeson+import Data.Aeson.Types+import Data.Maybe+import Data.Proxy+import Data.Text (Text)+import qualified Data.Text as T+import GHC.Generics+import GHC.TypeLits+import Web.Telegram.API.Bot.Data+import Web.Telegram.API.Bot.JsonExt++-- | This object represents 'getMe' response+data GetMeResponse = GetMeResponse+ {+ user_result :: User+ } deriving (Show, Generic)++instance ToJSON GetMeResponse where+ toJSON = toJsonDrop 5++instance FromJSON GetMeResponse where+ parseJSON = parseJsonDrop 5++-- | This object represents message response+data MessageResponse = MessageResponse+ {+ message_result :: Message+ } deriving (Show, Generic)++instance ToJSON MessageResponse where+ toJSON = toJsonDrop 8++instance FromJSON MessageResponse where+ parseJSON = parseJsonDrop 8++-- | This object represents 'sendChatAction' response+data ChatActionResponse = ChatActionResponse+ {+ action_result :: Bool+ } deriving (Show, Generic)++instance ToJSON ChatActionResponse where+ toJSON = toJsonDrop 7++instance FromJSON ChatActionResponse where+ parseJSON = parseJsonDrop 7++-- | This object represents 'getUpdates' response+data UpdatesResponse = UpdatesResponse+ {+ update_result :: [Update]+ } deriving (Show, Generic)++instance ToJSON UpdatesResponse where+ toJSON = toJsonDrop 7++instance FromJSON UpdatesResponse where+ parseJSON = parseJsonDrop 7++-- | This object represents file response+data FileResponse = FileResponse+ {+ file_result :: File+ } deriving (Show, Generic)++instance ToJSON FileResponse where+ toJSON = toJsonDrop 5++instance FromJSON FileResponse where+ parseJSON = parseJsonDrop 5++-- | This object represents user profile photos response+data UserProfilePhotosResponse = UserProfilePhotosResponse+ {+ photos_result :: UserProfilePhotos+ } deriving (Show, Generic)++instance ToJSON UserProfilePhotosResponse where+ toJSON = toJsonDrop 7++instance FromJSON UserProfilePhotosResponse where+ parseJSON = parseJsonDrop 7++-- | This object represents 'setWebhook' response+data SetWebhookResponse = SetWebhookResponse+ {+ webhook_result :: Bool+ } deriving (Show, Generic)++instance ToJSON SetWebhookResponse where+ toJSON = toJsonDrop 8++instance FromJSON SetWebhookResponse where+ parseJSON = parseJsonDrop 8++-- | This object represents 'answerInlineQuery' response+data InlineQueryResponse = InlineQueryResponse+ {+ query_result :: Bool+ } deriving (Show, Generic)++instance ToJSON InlineQueryResponse where+ toJSON = toJsonDrop 6++instance FromJSON InlineQueryResponse where+ parseJSON = parseJsonDrop 6++-- | This object represents 'answerCallbackQuery' response+data CallbackQueryResponse = CallbackQueryResponse+ {+ callback_result :: Bool+ } deriving (Show, Generic)++instance ToJSON CallbackQueryResponse where+ toJSON = toJsonDrop 7++instance FromJSON CallbackQueryResponse where+ parseJSON = parseJsonDrop 7++-- | This object represents 'kickChatMember' response+data KickChatMemberResponse = KickChatMemberResponse+ {+ kick_result :: Bool+ } deriving (Show, Generic)++instance ToJSON KickChatMemberResponse where+ toJSON = toJsonDrop 5++instance FromJSON KickChatMemberResponse where+ parseJSON = parseJsonDrop 5++-- | This object represents 'unbanChatMember' response+data UnbanChatMemberResponse = UnbanChatMemberResponse+ {+ unban_result :: Bool+ } deriving (Show, Generic)++instance ToJSON UnbanChatMemberResponse where+ toJSON = toJsonDrop 6++instance FromJSON UnbanChatMemberResponse where parseJSON = parseJsonDrop 6
telegram-api.cabal view
@@ -1,5 +1,5 @@ name: telegram-api-version: 0.3.1.0+version: 0.4.0.0 synopsis: Telegram Bot API bindings description: High-level bindings to the Telegram Bot API homepage: http://github.com/klappvisor/haskell-telegram-api#readme@@ -12,10 +12,11 @@ build-type: Simple -- extra-source-files: cabal-version: >=1.10-data-files: test-data/klappvisor.jpg+data-files: test-data/christmas-cat.jpg extra-source-files: README.md+ CHANGELOG.md library hs-source-dirs: src@@ -24,19 +25,20 @@ , Web.Telegram.API.Bot.Data , Web.Telegram.API.Bot.Responses , Web.Telegram.API.Bot.Requests- , Servant.Client.MultipartFormData other-modules: Web.Telegram.API.Bot.JsonExt+ , Servant.Client.MultipartFormData build-depends: base >= 4.7 && < 5 , aeson- , servant == 0.4.*- , servant-client == 0.4.*- , text , either+ , http-api-data , http-client+ , servant == 0.7.*+ , servant-client == 0.7.*+ , text+ , transformers , http-media , http-types , mime-types- , transformers , bytestring , string-conversions default-language: Haskell2010@@ -48,13 +50,22 @@ other-modules: MainSpec , InlineSpec build-depends: base- , text+ , aeson+ , hjpath+ , ansi-wl-pprint+ , http-client+ , http-client-tls+ , http-types , hspec- , servant- , servant-client+ , optparse-applicative+ , servant == 0.7.*+ , servant-client == 0.7.* , telegram-api , http-types , filepath+ , text+ , transformers+ , utf8-string ghc-options: -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010
+ test-data/christmas-cat.jpg view
binary file changed (absent → 105999 bytes)
− test-data/klappvisor.jpg
binary file changed (40274 → absent bytes)
test/InlineSpec.hs view
@@ -12,6 +12,8 @@ import Test.Hspec import Data.Text (Text) import qualified Data.Text as T+import Network.HTTP.Client (newManager)+import Network.HTTP.Client.TLS (tlsManagerSettings) import Servant.Client import Servant.API import Network.HTTP.Types.Status@@ -20,39 +22,43 @@ spec :: Token -> Text -> Spec spec token chatId = do let inline_query_id = ""+ manager <- runIO $ newManager tlsManagerSettings+ -- Create the tls connection manager describe "/answerInlineQuery" $ do it "should answer with article" $ do Right InlineQueryResponse { query_result = res } <-- answerInlineQuery token (AnswerInlineQueryRequest inline_query_id [inline_article] Nothing Nothing Nothing)+ answerInlineQuery token (AnswerInlineQueryRequest inline_query_id [inline_article] Nothing Nothing Nothing Nothing Nothing) manager res `shouldBe` True it "should answer with photo" $ do Right InlineQueryResponse { query_result = res } <-- answerInlineQuery token (AnswerInlineQueryRequest inline_query_id [inline_photo] Nothing Nothing Nothing)+ answerInlineQuery token (AnswerInlineQueryRequest inline_query_id [inline_photo] Nothing Nothing Nothing Nothing Nothing) manager res `shouldBe` True it "should answer with gif" $ do Right InlineQueryResponse { query_result = res } <-- answerInlineQuery token (AnswerInlineQueryRequest inline_query_id [inline_gif] Nothing Nothing Nothing)+ answerInlineQuery token (AnswerInlineQueryRequest inline_query_id [inline_gif] Nothing Nothing Nothing Nothing Nothing) manager res `shouldBe` True it "should answer with mpeg gif" $ do Right InlineQueryResponse { query_result = res } <-- answerInlineQuery token (AnswerInlineQueryRequest inline_query_id [inline_mpeg] Nothing Nothing Nothing)+ answerInlineQuery token (AnswerInlineQueryRequest inline_query_id [inline_mpeg] Nothing Nothing Nothing Nothing Nothing) manager res `shouldBe` True it "should answer with video" $ do Right InlineQueryResponse { query_result = res } <-- answerInlineQuery token (AnswerInlineQueryRequest inline_query_id [inline_video] Nothing Nothing Nothing)+ answerInlineQuery token (AnswerInlineQueryRequest inline_query_id [inline_video] Nothing Nothing Nothing Nothing Nothing) manager res `shouldBe` True describe "/answerInlineQuery" $ do it "should get updates and answer" $ do Right UpdatesResponse { update_result = updates} <-- getUpdates token Nothing Nothing Nothing+ getUpdates token Nothing Nothing Nothing manager Update { inline_query = Just (InlineQuery { query_id = id } ) } <- pure (last updates) e <-- answerInlineQuery token (AnswerInlineQueryRequest id [inline_video] Nothing Nothing Nothing)+ answerInlineQuery token (AnswerInlineQueryRequest id [inline_video] Nothing Nothing Nothing Nothing Nothing) manager putStrLn (show e) -inline_article = InlineQueryResultArticle "2131341" (Just "text article content") Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing-inline_photo = InlineQueryResultPhoto "1430810" "http://vignette3.wikia.nocookie.net/victorious/images/f/f8/NyanCat.jpg" Nothing Nothing (Just "http://vignette3.wikia.nocookie.net/victorious/images/f/f8/NyanCat.jpg") Nothing Nothing Nothing Nothing Nothing Nothing-inline_gif = InlineQueryResultGif "131231234" "https://media.giphy.com/media/zEO5eq3ZsEwbS/giphy.gif" Nothing Nothing (Just "https://media.giphy.com/media/zEO5eq3ZsEwbS/100.gif") Nothing Nothing Nothing Nothing Nothing-inline_mpeg = InlineQueryResultMpeg4Gif "131251234" "https://media.giphy.com/media/zEO5eq3ZsEwbS/giphy.gif" Nothing Nothing (Just "https://media.giphy.com/media/zEO5eq3ZsEwbS/100.gif") Nothing Nothing Nothing Nothing Nothing-inline_video = InlineQueryResultVideo "123413542" "https://www.youtube.com/embed/TBKN7_vx2xo" "text/html" (Just "Enjoykin — Nyash Myash") Nothing Nothing Nothing Nothing Nothing (Just "https://i.ytimg.com/vi_webp/TBKN7_vx2xo/mqdefault.webp") (Just "Enjoykin — Nyash Myash") Nothing+message_content = InputTextMessageContent "test message content" Nothing Nothing++inline_article = InlineQueryResultArticle "2131341" (Just "text article content") (Just message_content) Nothing Nothing Nothing Nothing Nothing Nothing Nothing+inline_photo = InlineQueryResultPhoto "1430810" "http://vignette3.wikia.nocookie.net/victorious/images/f/f8/NyanCat.jpg" (Just "http://vignette3.wikia.nocookie.net/victorious/images/f/f8/NyanCat.jpg") Nothing Nothing Nothing Nothing Nothing Nothing Nothing+inline_gif = InlineQueryResultGif "131231234" "https://media.giphy.com/media/zEO5eq3ZsEwbS/giphy.gif" Nothing Nothing (Just "https://media.giphy.com/media/zEO5eq3ZsEwbS/100.gif") Nothing Nothing Nothing Nothing+inline_mpeg = InlineQueryResultMpeg4Gif "131251234" "https://media.giphy.com/media/zEO5eq3ZsEwbS/giphy.gif" Nothing Nothing (Just "https://media.giphy.com/media/zEO5eq3ZsEwbS/100.gif") Nothing Nothing Nothing Nothing+inline_video = InlineQueryResultVideo "123413542" "https://www.youtube.com/embed/TBKN7_vx2xo" "text/html" (Just "https://i.ytimg.com/vi_webp/TBKN7_vx2xo/mqdefault.webp") (Just "Enjoykin — Nyash Myash") Nothing Nothing Nothing Nothing Nothing Nothing Nothing
test/MainSpec.hs view
@@ -1,22 +1,21 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TemplateHaskell #-} module MainSpec (spec) where import Control.Monad+import Data.Monoid import Web.Telegram.API.Bot import Test.Hspec import Data.Either (isRight, isLeft) import Data.Text (Text) import qualified Data.Text as T+import Network.HTTP.Client (newManager)+import Network.HTTP.Client.TLS (tlsManagerSettings) import Servant.Client-import Servant.API import Network.HTTP.Types.Status-import System.Environment import System.FilePath import Paths_telegram_api@@ -28,139 +27,213 @@ spec :: Token -> Text -> Text -> Spec spec token chatId botName = do+ manager <- runIO $ newManager tlsManagerSettings describe "/getMe" $ do it "responds with correct bot's name" $ do Right GetMeResponse { user_result = u } <-- getMe token- (user_first_name u) `shouldBe` botName -- "TelegramAPIBot"+ getMe token manager+ (user_first_name u) `shouldBe` botName -- f.e. "TelegramAPIBot" describe "/sendMessage" $ do it "should send message" $ do- res <-sendMessage token (SendMessageRequest chatId "test message" Nothing Nothing Nothing Nothing)+ res <- sendMessage token (sendMessageRequest chatId "test message") manager success res let Right MessageResponse { message_result = m } = res (text m) `shouldBe` (Just "test message") it "should return error message" $ do- res <-sendMessage token (SendMessageRequest "" "test message" Nothing Nothing Nothing Nothing)+ res <- sendMessage token (sendMessageRequest "" "test message") manager nosuccess res let Left FailureResponse { responseStatus = Status { statusMessage = msg } } = res msg `shouldBe` "Bad Request" it "should send message markdown" $ do- res <-sendMessage token (SendMessageRequest chatId "text *bold* _italic_ [github](github.com/klappvisor/telegram-api)" (Just Markdown) Nothing Nothing Nothing)+ let request = (sendMessageRequest chatId "text *bold* _italic_ [github](github.com/klappvisor/telegram-api)") {+ message_parse_mode = Just Markdown+ }+ res <- sendMessage token request manager success res let Right MessageResponse { message_result = m } = res (text m) `shouldBe` (Just "text bold italic github") it "should set keyboard" $ do- res <-sendMessage token (SendMessageRequest chatId "set keyboard" Nothing Nothing Nothing (Just (ReplyKeyboardMarkup [["A", "B"], ["C"]] Nothing Nothing Nothing)))+ let kbA = keyboardButton "A"+ kbB = keyboardButton "B"+ kbC = keyboardButton "C"+ let message = (sendMessageRequest chatId "set keyboard") {+ message_reply_markup = Just $ replyKeyboardMarkup [[kbA, kbB, kbC]]+ }+ res <- sendMessage token message manager success res let Right MessageResponse { message_result = m } = res (text m) `shouldBe` (Just "set keyboard") it "should remove keyboard" $ do- res <-sendMessage token (SendMessageRequest chatId "remove keyboard" Nothing Nothing Nothing (Just (ReplyKeyboardHide True Nothing)))+ let message = (sendMessageRequest chatId "remove keyboard") {+ message_reply_markup = Just replyKeyboardHide+ }+ res <- sendMessage token message manager success res let Right MessageResponse { message_result = m } = res (text m) `shouldBe` (Just "remove keyboard") it "should force reply" $ do- res <-sendMessage token (SendMessageRequest chatId "force reply" Nothing Nothing Nothing (Just (ForceReply True Nothing)))+ let message = (sendMessageRequest chatId "force reply") {+ message_reply_markup = Just forceReply+ }+ res <- sendMessage token message manager success res let Right MessageResponse { message_result = m } = res (text m) `shouldBe` (Just "force reply") describe "/forwardMessage" $ do it "should forward message" $ do- res <-forwardMessage token (ForwardMessageRequest chatId chatId 123)+ res <- forwardMessage token (forwardMessageRequest chatId chatId 123000) manager nosuccess res let Left FailureResponse { responseStatus = Status { statusMessage = msg } } = res msg `shouldBe` "Bad Request" describe "/sendPhoto" $ do it "should return error message" $ do- Left FailureResponse { responseStatus = Status { statusMessage = msg } } <-- sendPhotoById token (SendPhotoRequest "" "photo_id" (Just "photo caption") Nothing Nothing)+ let photo = (sendPhotoRequest "" "photo_id") {+ photo_caption = Just "photo caption"+ }+ Left FailureResponse { responseStatus = Status { statusMessage = msg } } <- sendPhoto token photo manager msg `shouldBe` "Bad Request"- it "should send photo with file_id" $ do- Right MessageResponse { message_result = Message { caption = Just cpt } } <-- sendPhotoById token (SendPhotoRequest chatId "AgADBAADv6cxGybVMgABtZ_EOpBSdxYD5xwZAAS0kQ9gsy1eDh2FAAIC" (Just "photo caption") Nothing Nothing)- cpt `shouldBe` "photo caption"- it "should send uploaded photo" $ do+ it "should upload photo and resend it by id" $ do dataDir <- getDataDir- let fileUpload = FileUpload "image/jpeg" (FileUploadFile (dataDir </> "test-data/klappvisor.jpg"))+ let fileUpload = FileUpload "image/jpeg" (FileUploadFile (dataDir </> "test-data/christmas-cat.jpg"))+ let upload = (uploadPhotoRequest chatId fileUpload) {+ photo_caption = Just "uploaded photo"+ }+ Right MessageResponse { message_result = Message { caption = Just cpt, photo = Just photos } } <-+ uploadPhoto token upload manager+ cpt `shouldBe` "uploaded photo"+ -- resend by id+ let id = (photo_file_id . last) photos+ let photo = (sendPhotoRequest chatId id) {+ photo_caption = Just "photo caption"+ } Right MessageResponse { message_result = Message { caption = Just cpt } } <-- sendPhoto token (SendPhotoRequest chatId fileUpload (Just "photo caption 2") Nothing Nothing)- cpt `shouldBe` "photo caption 2"+ sendPhoto token photo manager+ cpt `shouldBe` "photo caption" describe "/sendAudio" $ do it "should return error message" $ do+ let audio = (sendAudioRequest "" "audio_id") {+ _audio_performer = Just "performer"+ , _audio_title = Just "title"+ } Left FailureResponse { responseStatus = Status { statusMessage = msg } } <-- sendAudio token (SendAudioRequest "" "audio_id" Nothing (Just "performer") (Just "title") Nothing Nothing)+ sendAudio token audio manager msg `shouldBe` "Bad Request" it "should send audio" $ do+ let audio = sendAudioRequest chatId "BQADBAADAQQAAiBOnQHThzc4cz1-IwI" Right MessageResponse { message_result = Message { audio = Just Audio { audio_title = Just title } } } <-- sendAudio token (SendAudioRequest chatId "BQADBAADAQQAAiBOnQHThzc4cz1-IwI" Nothing Nothing Nothing Nothing Nothing)+ sendAudio token audio manager title `shouldBe` "The Nutcracker Suite - Act II, No.12. Pas de Deux variations" describe "/sendSticker" $ do it "should send sticker" $ do+ let sticker = sendStickerRequest chatId "BQADAgADGgADkWgMAAGXlYGBiM_d2wI" Right MessageResponse { message_result = Message { sticker = Just sticker } } <-- sendSticker token (SendStickerRequest chatId "BQADAgADGgADkWgMAAGXlYGBiM_d2wI" Nothing Nothing)+ sendSticker token sticker manager (sticker_file_id sticker) `shouldBe` "BQADAgADGgADkWgMAAGXlYGBiM_d2wI" describe "/sendLocation" $ do it "should send location" $ do+ let location = sendLocationRequest chatId 52.38 4.9 Right MessageResponse { message_result = Message { location = Just loc } } <-- sendLocation token (SendLocationRequest chatId 52.38 4.9 Nothing Nothing)+ sendLocation token location manager (latitude loc) `shouldSatisfy` (liftM2 (&&) (> 52) (< 52.4)) (longitude loc) `shouldSatisfy` (liftM2 (&&) (> 4.89) (< 5)) + describe "/sendVenue" $ do+ it "should send a venue" $ do+ let venue = sendVenueRequest chatId 52.38 4.9 "Amsterdam Centraal" "Amsterdam"+ Right MessageResponse { message_result = Message { location = Just loc } } <-+ sendVenue token venue manager+ (latitude loc) `shouldSatisfy` (liftM2 (&&) (> 52) (< 52.4))+ (longitude loc) `shouldSatisfy` (liftM2 (&&) (> 4.89) (< 5))++ describe "/sendContact" $ do+ it "should send a contact" $ do+ let contact = sendContactRequest chatId "06-18035176" "Hilbert"+ Right MessageResponse { message_result = Message { contact = Just con } } <-+ sendContact token contact manager+ -- Telegram seems to remove any non numeric characters from the sent phone number (at least it removed my '-')+ (contact_phone_number con) `shouldBe` "0618035176"+ (contact_first_name con) `shouldBe` "Hilbert"+ describe "/sendChatAction" $ do it "should set typing action" $ do Right ChatActionResponse { action_result = res} <-- sendChatAction token (SendChatActionRequest chatId Typing)+ sendChatAction token (SendChatActionRequest chatId Typing) manager res `shouldBe` True it "should set find location action" $ do Right ChatActionResponse { action_result = res} <-- sendChatAction token (SendChatActionRequest chatId FindLocation)+ sendChatAction token (SendChatActionRequest chatId FindLocation) manager res `shouldBe` True it "should set upload photo action" $ do Right ChatActionResponse { action_result = res} <-- sendChatAction token (SendChatActionRequest chatId UploadPhoto)+ sendChatAction token (SendChatActionRequest chatId UploadPhoto) manager res `shouldBe` True describe "/getUpdates" $ do it "should get all messages" $ do Right UpdatesResponse { update_result = updates} <-- getUpdates token Nothing Nothing Nothing+ getUpdates token Nothing Nothing Nothing manager (length updates) `shouldSatisfy` (>= 0) describe "/getFile" $ do it "should get file" $ do Right FileResponse { file_result = file } <-- getFile token "AAQEABMXDZEwAARC0Kj3twkzNcMkAAIC"+ getFile token "AAQEABMXDZEwAARC0Kj3twkzNcMkAAIC" manager (fmap (T.take 10) (file_path file)) `shouldBe` (Just "thumb/file") it "should return error" $ do Left FailureResponse { responseStatus = Status { statusMessage = msg } } <-- getFile token "AAQEABMXDZEwAARC0Kj3twkzNcMkAmm"+ getFile token "AAQEABMXDZEwAARC0Kj3twkzNcMkAmm" manager msg `shouldBe` "Bad Request" describe "/getUserProfilePhotos" $ do- it "should get user profile photos" $ do- Right UserProfilePhotosResponse { photos_result = photos } <-- getUserProfilePhotos token (read (T.unpack chatId)) Nothing Nothing- (total_count photos) `shouldSatisfy` (> 0)+ it "should get user profile photos" $ do+ Right UserProfilePhotosResponse { photos_result = photos } <-+ getUserProfilePhotos token (read (T.unpack chatId)) Nothing Nothing manager+ (total_count photos) `shouldSatisfy` (>= 0) describe "/setWebhook" $ do it "should set webhook" $ do Right SetWebhookResponse { webhook_result = res } <-- setWebhook token (Just "https://example.com/secret_token")+ setWebhook token (Just "https://example.com/secret_token") manager res `shouldBe` True it "should remove webhook" $ do Right SetWebhookResponse { webhook_result = res } <-- setWebhook token Nothing+ setWebhook token Nothing manager res `shouldBe` True++ describe "/editTextMessage" $ do+ it "should edit message" $ do+ let originalMessage = sendMessageRequest chatId "veritas"+ Right MessageResponse { message_result = Message { message_id = msg_id, text = Just txt } } <-+ sendMessage token originalMessage manager+ let editRequest = editMessageTextRequest chatId msg_id $ "edited " <> txt+ Right MessageResponse { message_result = Message { text = txt' } } <-+ editMessageText token editRequest manager+ txt' `shouldBe` Just "edited veritas"++ it "should edit caption" $ do+ dataDir <- getDataDir+ let fileUpload = FileUpload "image/jpeg" (FileUploadFile (dataDir </> "test-data/christmas-cat.jpg"))+ let originalMessage = (uploadPhotoRequest chatId fileUpload) {+ photo_caption = Just "cat picture"+ }+ Right MessageResponse { message_result = Message { message_id = msg_id, caption = Just cpt } } <-+ uploadPhoto token originalMessage manager+ let editRequest = editMessageCaptionRequest chatId msg_id $ Just $ "edited " <> cpt+ Right MessageResponse { message_result = Message { caption = Just cpt' } } <-+ editMessageCaption token editRequest manager+ cpt' `shouldBe` "edited cat picture"++ -- it "should edit caption" $ do ... after inline query tests are on place
test/Spec.hs view
@@ -1,45 +1,86 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RecordWildCards #-} module Main (main) where -import Control.Monad-import Data.Monoid-import Web.Telegram.API.Bot-import Test.Hspec-import Data.Text (Text)-import qualified Data.Text as T-import Servant.Client-import Servant.API-import Network.HTTP.Types.Status-import System.Environment+import Control.Monad (when)+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import qualified Data.Text as T import qualified MainSpec-import qualified InlineSpec+import qualified JsonSpec+import Options.Applicative+import System.Environment (getArgs, withArgs)+import System.Exit (exitSuccess)+import Test.Hspec+import qualified Text.PrettyPrint.ANSI.Leijen as PP+import Web.Telegram.API.Bot +-- | Command line options for test suite+data Options = Options+ {+ opt_integration :: Bool -- ^ Run integration tests+ , opt_token :: Maybe String -- ^ Bot token from BotFather+ , opt_chatId :: Maybe String -- ^ Id of a chat or of your bot+ , opt_botName :: Maybe String -- ^ Bot name+ , opt_hSpecOpts :: Maybe [String] -- ^ Command line options to pass to hSpec+ }++options :: Parser Options+options = Options+ <$> switch+ ( long "integration"+ <> help "Run integration tests" )+ <*> optional ( strOption+ ( long "token"+ <> short 't'+ <> metavar "BOT_TOKEN"+ <> help "Bot Token" ))+ <*> optional ( strOption+ ( long "chatid"+ <> short 'c'+ <> metavar "CHAT_ID"+ <> help "Chat Id" ))+ <*> optional ( strOption+ ( long "botname"+ <> short 'b'+ <> metavar "BOT_NAME"+ <> help "Bot Name" ))+ <*> optional ( some ( argument str+ ( metavar "HSPEC_ARGS"+ <> help "Hspec arguments")))+ main :: IO () main = do args <- getArgs- withArgs [] $ hspec (runSpec args)+ Options{..} <- execParser opts+ let integration = opt_integration+ token = fmap (\x -> Token ("bot" <> T.pack x)) opt_token+ chatId = T.pack <$> opt_chatId+ botName = T.pack <$> opt_botName+ hspecArgs = fromMaybe [] opt_hSpecOpts+ withArgs hspecArgs $ hspec (runSpec' integration token chatId botName)+ where opts = info (helper <*> options)+ ( fullDesc+ <> progDescDoc description)+runSpec' :: Bool -> Maybe Token -> Maybe Text -> Maybe Text -> SpecWith ()+runSpec' integration token chatId botName = do+ describe "Unit tests" $ do+ describe "Json tests" $ JsonSpec.spec+ if integration then runIntegrationSpec token chatId botName+ else describe "Integration tests" $ it "skipping..." $+ pendingWith "Use --integration switch to run integration tests" --- Don't run integration tests if no token and chat id provided-runSpec :: [String] -> SpecWith ()-runSpec [] = do- describe "NoTests" $ do- it "Does not run integration tests if no token, chat id and boot name provided" $ do- pending -runSpec [tkn,cId,bNm] = do- let token = Token ("bot" <> T.pack tkn)- let chatId = T.pack cId- let botName = T.pack bNm- runSpec' token chatId botName--runSpec' :: Token -> Text -> Text -> SpecWith ()-runSpec' token chatId botName = do- describe "Main" $ MainSpec.spec token chatId botName- --describe "Inline" $ InlineSpec.spec token chatId botName+runIntegrationSpec :: Maybe Token -> Maybe Text -> Maybe Text -> SpecWith ()+runIntegrationSpec (Just token) (Just chatId) (Just botName) = do+ describe "Main integration tests" $ MainSpec.spec token chatId botName+ --describe "Inline integration tests" $ InlineSpec.spec token chatId botName+runIntegrationSpec _ _ _ = describe "Integration tests" $ do+ fail "Missing required arguments for integration tests. Run stack test --test-arguments \"--help\" for more info" +description :: Maybe PP.Doc+description = Just $+ (PP.text "Run the haskell-telegram-api tests")+ PP.<$> ((PP.text "Running with stack: ") PP.<> (PP.text "stack test --test-arguments=\"--integration -t asd128903uiasbfì1023u -c 1235122 -b MyTeleBot -- -m send\""))+ PP.<$> ((PP.red . PP.text $ "WARNING: ") PP.<> (PP.text "the HSPEC_ARGS are optional but if present MUST be at the end and seperated from the other options with a -- "))