diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,91 +1,103 @@ -## 0.5.0.0 [Breaking] - -Features: - -* **[Breaking]** Changed `Response` data record to be generic -* Added certificate upload to set web-hook method for self-signed certificates - -Bugfixes: - -* Removed `O2` tag from cabal file - -## 0.4.3.1 - -Bugfixes: - -* Exposed `MessageEntity` - -## 0.4.3.0 - -Features: - -* Added Inline Keyboard to messages - -## 0.4.2.0 - -Features: - -* Bot-2.1 support - * Added new methods: `getChat`, `leaveChat`, `getChatAdministrators`, `getChatMember`, `getChatMembersCount`. - * Added support for edited messages and new mentions from Telegram v.3.9. New fields: `edited_message` in `Update`, `edit_date` in `Message, user in `MessageEntity`. New value `text_mention` for the type field in `MessageEntity`. - -## 0.4.1.0 - -Features: - -* Implemented file uploading for audio, voice, sticker, video and documents - -Bugfixes: - -* Exposed constrictors for inline edit requests - -## 0.4.0.1 - -Bugfixes: - -* Parsing issue with answer callback query response - -## 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 +## 0.5.2.0 + +Features: + +* Added webhook methods such as getWebhookInfo, deleteWebhook, etc. +* Changes to update api +* Added sendGame + +## 0.5.1.1 + +Updated to use servant-0.9 and aeson-1.0 + +## 0.5.0.0 [Breaking] + +Features: + +* **[Breaking]** Changed `Response` data record to be generic +* Added certificate upload to set web-hook method for self-signed certificates + +Bugfixes: + +* Removed `O2` tag from cabal file + +## 0.4.3.1 + +Bugfixes: + +* Exposed `MessageEntity` + +## 0.4.3.0 + +Features: + +* Added Inline Keyboard to messages + +## 0.4.2.0 + +Features: + +* Bot-2.1 support + * Added new methods: `getChat`, `leaveChat`, `getChatAdministrators`, `getChatMember`, `getChatMembersCount`. + * Added support for edited messages and new mentions from Telegram v.3.9. New fields: `edited_message` in `Update`, `edit_date` in `Message, user in `MessageEntity`. New value `text_mention` for the type field in `MessageEntity`. + +## 0.4.1.0 + +Features: + +* Implemented file uploading for audio, voice, sticker, video and documents + +Bugfixes: + +* Exposed constrictors for inline edit requests + +## 0.4.0.1 + +Bugfixes: + +* Parsing issue with answer callback query response + +## 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 diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,30 +1,30 @@ -Copyright Alexey Rodiontsev (c) 2015 - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * Neither the name of Alexey Rodiontsev nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +Copyright Alexey Rodiontsev (c) 2015 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Alexey Rodiontsev nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,140 +1,140 @@ -# telegram-api - -[![Join the chat at https://gitter.im/klappvisor/haskell-telegram-api](https://badges.gitter.im/klappvisor/haskell-telegram-api.svg)](https://gitter.im/klappvisor/haskell-telegram-api?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) - -![Build Status](https://img.shields.io/circleci/project/klappvisor/haskell-telegram-api.svg) -![Hackage](https://img.shields.io/hackage/v/telegram-api.svg) -![Hackage Dependencies](https://img.shields.io/hackage-deps/v/telegram-api.svg) -![Haskell Programming Language](https://img.shields.io/badge/language-Haskell-blue.svg) -![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg) - -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. - -**Support of [Bot-2.0 API][bot-2.0]** - -## 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" -- 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" -- entire Token should be bot123456:ABC-DEF1234ghIkl-zyx57W2v1u123ew11 - chatId = " 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 setup integration of 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/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 -b 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. - -[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 +# telegram-api + +[![Join the chat at https://gitter.im/klappvisor/haskell-telegram-api](https://badges.gitter.im/klappvisor/haskell-telegram-api.svg)](https://gitter.im/klappvisor/haskell-telegram-api?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) + +![Build Status](https://img.shields.io/circleci/project/klappvisor/haskell-telegram-api.svg) +![Hackage](https://img.shields.io/hackage/v/telegram-api.svg) +![Hackage Dependencies](https://img.shields.io/hackage-deps/v/telegram-api.svg) +![Haskell Programming Language](https://img.shields.io/badge/language-Haskell-blue.svg) +![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg) + +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. + +**Support of [Bot-2.0 API][bot-2.0]** + +## 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" -- 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" -- entire Token should be bot123456:ABC-DEF1234ghIkl-zyx57W2v1u123ew11 + chatId = " 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 setup integration of 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/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 -b 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. + +[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 diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,2 @@ -import Distribution.Simple -main = defaultMain +import Distribution.Simple +main = defaultMain diff --git a/src/Servant/Client/MultipartFormData.hs b/src/Servant/Client/MultipartFormData.hs --- a/src/Servant/Client/MultipartFormData.hs +++ b/src/Servant/Client/MultipartFormData.hs @@ -1,100 +1,101 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} - -module Servant.Client.MultipartFormData - ( ToMultipartFormData (..) - , MultipartFormDataReqBody - ) where - -import Control.Exception -import Control.Monad -import Control.Monad.Reader.Class -import Control.Monad.IO.Class -import Control.Monad.Error.Class -import Data.ByteString.Lazy hiding (pack, filter, map, null, elem) -import Data.Proxy -import Data.String.Conversions -import Data.Typeable (Typeable) -import Network.HTTP.Client hiding (Proxy, path) -import qualified Network.HTTP.Client as Client -import Network.HTTP.Client.MultipartFormData -import Network.HTTP.Media -import Network.HTTP.Types -import qualified Network.HTTP.Types as H -import qualified Network.HTTP.Types.Header as HTTP -import Servant.API -import Servant.Common.BaseUrl -import Servant.Client -import Servant.Common.Req --- | 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. - toMultipartFormData :: a -> [Part] - --- | Extract the request body as a value of type @a@. -data MultipartFormDataReqBody a - deriving (Typeable) - -instance (ToMultipartFormData b, MimeUnrender ct a, cts' ~ (ct ': cts) - ) => HasClient (MultipartFormDataReqBody b :> Post cts' a) where - type Client (MultipartFormDataReqBody b :> Post cts' a) - = b -> ClientM a - clientWithRoute Proxy req reqData = - let reqToRequest' req' baseurl' = do - requestWithoutBody <- reqToRequest req' baseurl' - formDataBody (toMultipartFormData reqData) requestWithoutBody - in snd <$> performRequestCT' reqToRequest' (Proxy :: Proxy ct) H.methodPost req - --- 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 -> 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 - , checkResponse = \ _request _response -> return () - } - - eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request manager - case eResponse of - Left err -> - throwError . ConnectionError $ SomeException err - - Right response -> do - let status = Client.responseStatus response - body = Client.responseBody 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 -> throwError $ InvalidContentTypeHeader (cs t) body - Just t' -> pure t' - unless (status_code >= 200 && status_code < 300) $ - throwError $ FailureResponse status ct body - return (status_code, body, ct, hdrs, response) - --- 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 - -> ClientM ([HTTP.Header], result) -performRequestCT' reqToRequest' ct reqMethod req = do - let acceptCT = contentType ct - ClientEnv manager reqHost <- ask - (_status, respBody, respCT, hdrs, _response) <- - performRequest' reqToRequest' reqMethod (req { reqAccept = [acceptCT] }) manager reqHost - unless (matches respCT acceptCT) $ throwError $ UnsupportedContentType respCT respBody - case mimeUnrender ct respBody of - Left err -> throwError $ DecodeFailure err respCT respBody - Right val -> return (hdrs, val) +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + +module Servant.Client.MultipartFormData + ( ToMultipartFormData (..) + , MultipartFormDataReqBody + ) where + +import Control.Exception +import Control.Monad +import Control.Monad.Reader.Class +import Control.Monad.IO.Class +import Control.Monad.Error.Class +import Data.ByteString.Lazy hiding (pack, filter, map, null, elem) +import Data.Proxy +import Data.String.Conversions +import Data.Typeable (Typeable) +import Network.HTTP.Client hiding (Proxy, path) +import qualified Network.HTTP.Client as Client +import Network.HTTP.Client.MultipartFormData +import Network.HTTP.Media +import Network.HTTP.Types +import qualified Network.HTTP.Types as H +import qualified Network.HTTP.Types.Header as HTTP +import Servant.API +import Servant.Common.BaseUrl +import Servant.Client +import Servant.Common.Req (Req, catchConnectionError, + reqAccept, reqToRequest) +-- | 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. + toMultipartFormData :: a -> [Part] + +-- | Extract the request body as a value of type @a@. +data MultipartFormDataReqBody a + deriving (Typeable) + +instance (ToMultipartFormData b, MimeUnrender ct a, cts' ~ (ct ': cts) + ) => HasClient (MultipartFormDataReqBody b :> Post cts' a) where + type Client (MultipartFormDataReqBody b :> Post cts' a) + = b -> ClientM a + clientWithRoute Proxy req reqData = + let reqToRequest' req' baseurl' = do + requestWithoutBody <- reqToRequest req' baseurl' + formDataBody (toMultipartFormData reqData) requestWithoutBody + in snd <$> performRequestCT' reqToRequest' (Proxy :: Proxy ct) H.methodPost req + +-- 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 -> 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 + , checkResponse = \ _request _response -> return () + } + + eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request manager + case eResponse of + Left err -> + throwError . ConnectionError $ SomeException err + + Right response -> do + let status = Client.responseStatus response + body = Client.responseBody 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 -> throwError $ InvalidContentTypeHeader (cs t) body + Just t' -> pure t' + unless (status_code >= 200 && status_code < 300) $ + throwError $ FailureResponse status ct body + return (status_code, body, ct, hdrs, response) + +-- 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 + -> ClientM ([HTTP.Header], result) +performRequestCT' reqToRequest' ct reqMethod req = do + let acceptCT = contentType ct + ClientEnv manager reqHost <- ask + (_status, respBody, respCT, hdrs, _response) <- + performRequest' reqToRequest' reqMethod (req { reqAccept = [acceptCT] }) manager reqHost + unless (matches respCT acceptCT) $ throwError $ UnsupportedContentType respCT respBody + case mimeUnrender ct respBody of + Left err -> throwError $ DecodeFailure err respCT respBody + Right val -> return (hdrs, val) diff --git a/src/Web/Telegram/API/Bot.hs b/src/Web/Telegram/API/Bot.hs --- a/src/Web/Telegram/API/Bot.hs +++ b/src/Web/Telegram/API/Bot.hs @@ -1,10 +1,10 @@ --- | This module provides Telegram Bot API -module Web.Telegram.API.Bot - ( - module TAPI - ) where - -import Web.Telegram.API.Bot.API as TAPI -import Web.Telegram.API.Bot.Data as TAPI -import Web.Telegram.API.Bot.Responses as TAPI -import Web.Telegram.API.Bot.Requests as TAPI +-- | This module provides Telegram Bot API +module Web.Telegram.API.Bot + ( + module TAPI + ) where + +import Web.Telegram.API.Bot.API as TAPI +import Web.Telegram.API.Bot.Data as TAPI +import Web.Telegram.API.Bot.Responses as TAPI +import Web.Telegram.API.Bot.Requests as TAPI diff --git a/src/Web/Telegram/API/Bot/API.hs b/src/Web/Telegram/API/Bot/API.hs --- a/src/Web/Telegram/API/Bot/API.hs +++ b/src/Web/Telegram/API/Bot/API.hs @@ -1,454 +1,487 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} - -module Web.Telegram.API.Bot.API - ( -- * Functions - getMe - , sendMessage - , forwardMessage - , uploadPhoto - , sendPhoto - , uploadAudio - , sendAudio - , uploadDocument - , sendDocument - , uploadSticker - , sendSticker - , uploadVideo - , sendVideo - , uploadVoice - , sendVoice - , sendLocation - , sendVenue - , sendContact - , sendChatAction - , getUpdates - , getFile - , getUserProfilePhotos - , setWebhook - , setWebhookWithCertificate - , answerInlineQuery - , answerCallbackQuery - , kickChatMember - , leaveChat - , unbanChatMember - , getChat - , getChatAdministrators - , getChatMembersCount - , getChatMember - , editMessageText - , editMessageCaption - , editMessageReplyMarkup - , editInlineMessageText - , editInlineMessageCaption - , editInlineMessageReplyMarkup - -- * API - , TelegramBotAPI - , api - -- * Types - , Token (..) - ) where - -import Data.Proxy -import Data.Text (Text) -import Network.HTTP.Client (Manager) -import Servant.API -import Servant.Client -import Servant.Client.MultipartFormData -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" - :> MultipartFormDataReqBody (SendAudioRequest FileUpload) - :> Post '[JSON] MessageResponse - :<|> TelegramToken :> "sendAudio" - :> ReqBody '[JSON] (SendAudioRequest Text) - :> Post '[JSON] MessageResponse - :<|> TelegramToken :> "sendDocument" - :> MultipartFormDataReqBody (SendDocumentRequest FileUpload) - :> Post '[JSON] MessageResponse - :<|> TelegramToken :> "sendDocument" - :> ReqBody '[JSON] (SendDocumentRequest Text) - :> Post '[JSON] MessageResponse - :<|> TelegramToken :> "sendSticker" - :> MultipartFormDataReqBody (SendStickerRequest FileUpload) - :> Post '[JSON] MessageResponse - :<|> TelegramToken :> "sendSticker" - :> ReqBody '[JSON] (SendStickerRequest Text) - :> Post '[JSON] MessageResponse - :<|> TelegramToken :> "sendVideo" - :> MultipartFormDataReqBody (SendVideoRequest FileUpload) - :> Post '[JSON] MessageResponse - :<|> TelegramToken :> "sendVideo" - :> ReqBody '[JSON] (SendVideoRequest Text) - :> Post '[JSON] MessageResponse - :<|> TelegramToken :> "sendVoice" - :> MultipartFormDataReqBody (SendVoiceRequest FileUpload) - :> Post '[JSON] MessageResponse - :<|> TelegramToken :> "sendVoice" - :> ReqBody '[JSON] (SendVoiceRequest Text) - :> 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 :> "setWebhook" - :> MultipartFormDataReqBody SetWebhookRequest - :> Post '[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 :> "leaveChat" - :> QueryParam "chat_id" Text - :> Post '[JSON] LeaveChatResponse - :<|> TelegramToken :> "unbanChatMember" - :> QueryParam "chat_id" Text - :> QueryParam "user_id" Int - :> Post '[JSON] UnbanChatMemberResponse - :<|> TelegramToken :> "getChat" - :> QueryParam "chat_id" Text - :> Post '[JSON] GetChatResponse - :<|> TelegramToken :> "getChatAdministrators" - :> QueryParam "chat_id" Text - :> Post '[JSON] GetChatAdministratorsResponse - :<|> TelegramToken :> "getChatMembersCount" - :> QueryParam "chat_id" Text - :> Post '[JSON] GetChatMembersCountResponse - :<|> TelegramToken :> "getChatMember" - :> QueryParam "chat_id" Text - :> QueryParam "user_id" Int - :> Post '[JSON] GetChatMemberResponse - :<|> TelegramToken :> "editMessageText" - :> ReqBody '[JSON] EditMessageTextRequest - :> Post '[JSON] MessageResponse - :<|> TelegramToken :> "editMessageCaption" - :> ReqBody '[JSON] EditMessageCaptionRequest - :> Post '[JSON] MessageResponse - :<|> TelegramToken :> "editMessageReplyMarkup" - :> ReqBody '[JSON] EditMessageReplyMarkupRequest - :> Post '[JSON] MessageResponse - :<|> TelegramToken :> "editMessageText" - :> ReqBody '[JSON] EditMessageTextRequest - :> Post '[JSON] (Response Bool) - :<|> TelegramToken :> "editMessageCaption" - :> ReqBody '[JSON] EditMessageCaptionRequest - :> Post '[JSON] (Response Bool) - :<|> TelegramToken :> "editMessageReplyMarkup" - :> ReqBody '[JSON] EditMessageReplyMarkupRequest - :> Post '[JSON] (Response Bool) - --- | Proxy for Thelegram Bot API -api :: Proxy TelegramBotAPI -api = Proxy - -getMe_ :: Token -> ClientM GetMeResponse -sendMessage_ :: Token -> SendMessageRequest -> ClientM MessageResponse -forwardMessage_ :: Token -> ForwardMessageRequest -> ClientM MessageResponse -uploadPhoto_ :: Token -> SendPhotoRequest FileUpload -> ClientM MessageResponse -sendPhoto_ :: Token -> SendPhotoRequest Text -> ClientM MessageResponse -uploadAudio_ :: Token -> SendAudioRequest FileUpload -> ClientM MessageResponse -sendAudio_ :: Token -> SendAudioRequest Text -> ClientM MessageResponse -uploadDocument_ :: Token -> SendDocumentRequest FileUpload -> ClientM MessageResponse -sendDocument_ :: Token -> SendDocumentRequest Text -> ClientM MessageResponse -uploadSticker_ :: Token -> SendStickerRequest FileUpload -> ClientM MessageResponse -sendSticker_ :: Token -> SendStickerRequest Text -> ClientM MessageResponse -uploadVideo_ :: Token -> SendVideoRequest FileUpload -> ClientM MessageResponse -sendVideo_ :: Token -> SendVideoRequest Text -> ClientM MessageResponse -uploadVoice_ :: Token -> SendVoiceRequest FileUpload -> ClientM MessageResponse -sendVoice_ :: Token -> SendVoiceRequest Text -> ClientM MessageResponse -sendLocation_ :: Token -> SendLocationRequest -> ClientM MessageResponse -sendVenue_ :: Token -> SendVenueRequest-> ClientM MessageResponse -sendContact_ :: Token -> SendContactRequest -> ClientM MessageResponse -sendChatAction_ :: Token -> SendChatActionRequest -> ClientM ChatActionResponse -getUpdates_ :: Token -> Maybe Int -> Maybe Int -> Maybe Int -> ClientM UpdatesResponse -getFile_ :: Token -> Maybe Text -> ClientM FileResponse -getUserProfilePhotos_ :: Token -> Maybe Int -> Maybe Int -> Maybe Int -> ClientM UserProfilePhotosResponse -setWebhook_ :: Token -> Maybe Text -> ClientM SetWebhookResponse -setWebhookWithCert_ :: Token -> SetWebhookRequest -> ClientM SetWebhookResponse -answerInlineQuery_ :: Token -> AnswerInlineQueryRequest -> ClientM InlineQueryResponse -answerCallbackQuery_ :: Token -> AnswerCallbackQueryRequest -> ClientM CallbackQueryResponse -kickChatMember_ :: Token -> Maybe Text -> Maybe Int -> ClientM KickChatMemberResponse -leaveChat_ :: Token -> Maybe Text -> ClientM LeaveChatResponse -unbanChatMember_ :: Token -> Maybe Text -> Maybe Int -> ClientM UnbanChatMemberResponse -getChat_ :: Token -> Maybe Text -> ClientM GetChatResponse -getChatAdministrators_ :: Token -> Maybe Text -> ClientM GetChatAdministratorsResponse -getChatMembersCount_ :: Token -> Maybe Text -> ClientM GetChatMembersCountResponse -getChatMember_ :: Token -> Maybe Text -> Maybe Int -> ClientM GetChatMemberResponse -editMessageText_ :: Token -> EditMessageTextRequest -> ClientM MessageResponse -editMessageCaption_ :: Token -> EditMessageCaptionRequest -> ClientM MessageResponse -editMessageReplyMarkup_ :: Token -> EditMessageReplyMarkupRequest -> ClientM MessageResponse -editMessageText__ :: Token -> EditMessageTextRequest -> ClientM (Response Bool) -editMessageCaption__ :: Token -> EditMessageCaptionRequest -> ClientM (Response Bool) -editMessageReplyMarkup__ :: Token -> EditMessageReplyMarkupRequest -> ClientM (Response Bool) -getMe_ - :<|> sendMessage_ - :<|> forwardMessage_ - :<|> uploadPhoto_ - :<|> sendPhoto_ - :<|> uploadAudio_ - :<|> sendAudio_ - :<|> uploadDocument_ - :<|> sendDocument_ - :<|> uploadSticker_ - :<|> sendSticker_ - :<|> uploadVideo_ - :<|> sendVideo_ - :<|> uploadVoice_ - :<|> sendVoice_ - :<|> sendLocation_ - :<|> sendVenue_ - :<|> sendContact_ - :<|> sendChatAction_ - :<|> getUpdates_ - :<|> getFile_ - :<|> getUserProfilePhotos_ - :<|> setWebhook_ - :<|> setWebhookWithCert_ - :<|> answerInlineQuery_ - :<|> answerCallbackQuery_ - :<|> kickChatMember_ - :<|> leaveChat_ - :<|> unbanChatMember_ - :<|> getChat_ - :<|> getChatAdministrators_ - :<|> getChatMembersCount_ - :<|> getChatMember_ - :<|> editMessageText_ - :<|> editMessageCaption_ - :<|> editMessageReplyMarkup_ - :<|> 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 = runClientM (getMe_ token) (ClientEnv 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 upload and 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. -uploadAudio :: Token -> SendAudioRequest FileUpload -> Manager -> IO (Either ServantError MessageResponse) -uploadAudio = run telegramBaseUrl uploadAudio_ - --- | Use this method to send audio files that are already on the Telegram servers, 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 Text -> Manager -> IO (Either ServantError MessageResponse) -sendAudio = run telegramBaseUrl sendAudio_ - --- | Use this method to upload and 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. -uploadDocument :: Token -> SendDocumentRequest FileUpload -> Manager -> IO (Either ServantError MessageResponse) -uploadDocument = run telegramBaseUrl uploadDocument_ - --- | Use this method to send general files that have already been uploaded. 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 Text -> Manager -> IO (Either ServantError MessageResponse) -sendDocument = run telegramBaseUrl sendDocument_ - --- | Use this method to upload and send .webp stickers. On success, the sent 'Message' is returned. -uploadSticker :: Token -> SendStickerRequest FileUpload -> Manager -> IO (Either ServantError MessageResponse) -uploadSticker = run telegramBaseUrl uploadSticker_ - --- | Use this method to send .webp stickers that are already on the Telegram servers. On success, the sent 'Message' is returned. -sendSticker :: Token -> SendStickerRequest Text -> Manager -> IO (Either ServantError MessageResponse) -sendSticker = run telegramBaseUrl sendSticker_ - --- | Use this method to upload and 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. -uploadVideo :: Token -> SendVideoRequest FileUpload -> Manager -> IO (Either ServantError MessageResponse) -uploadVideo = run telegramBaseUrl uploadVideo_ - --- | Use this method to send video files that are already on the Telegram servers. 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 Text -> Manager -> IO (Either ServantError MessageResponse) -sendVideo = run telegramBaseUrl sendVideo_ - --- | Use this method to upload and 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. -uploadVoice :: Token -> SendVoiceRequest FileUpload -> Manager -> IO (Either ServantError MessageResponse) -uploadVoice = run telegramBaseUrl uploadVoice_ - --- | Use this method to send audio files that are already on the telegram server, 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 Text -> 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 = runClientM (getUpdates_ token offset limit timeout) $ ClientEnv 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/@, where @@ 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 = runClientM (getFile_ token (Just file_id)) $ ClientEnv 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 = runClientM (getUserProfilePhotos_ token (Just user_id) offset limit) $ ClientEnv 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/@. 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 = runClientM (setWebhook_ token url) $ ClientEnv 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/@. Since nobody else knows your bot‘s token, you can be pretty sure it’s us. -setWebhookWithCertificate :: Token -> SetWebhookRequest -> Manager -> IO (Either ServantError SetWebhookResponse) -setWebhookWithCertificate = run telegramBaseUrl setWebhookWithCert_ - --- | 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 = runClientM (kickChatMember_ token (Just chat_id) (Just user_id)) $ ClientEnv manager telegramBaseUrl - --- | Use this method for your bot to leave a group, supergroup or channel. Returns True on success. -leaveChat :: Token -> Text -> Manager -> IO (Either ServantError LeaveChatResponse) -leaveChat token chat_id manager = runClientM (leaveChat_ token (Just chat_id)) $ ClientEnv 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 = runClientM (unbanChatMember_ token (Just chat_id) (Just user_id)) $ ClientEnv manager telegramBaseUrl - --- | Use this method to get up to date information about the chat (current name of the user for one-on-one conversations, current username of a user, group or channel, etc.) -getChat :: Token -> Text -> Manager -> IO (Either ServantError GetChatResponse) -getChat token chat_id manager = runClientM (getChat_ token (Just chat_id)) $ ClientEnv manager telegramBaseUrl - --- | Use this method to get a list of administrators in a chat. On success, returns an Array of 'ChatMember' objects that contains information about all chat administrators except other bots. If the chat is a group or a supergroup and no administrators were appointed, only the creator will be returned. -getChatAdministrators :: Token -> Text -> Manager -> IO (Either ServantError GetChatAdministratorsResponse) -getChatAdministrators token chat_id manager = runClientM (getChatAdministrators_ token (Just chat_id)) $ ClientEnv manager telegramBaseUrl - --- | Use this method to get the number of members in a chat. Returns 'Int' on success. -getChatMembersCount :: Token -> Text -> Manager -> IO (Either ServantError GetChatMembersCountResponse) -getChatMembersCount token chat_id manager = runClientM (getChatMembersCount_ token (Just chat_id)) $ ClientEnv manager telegramBaseUrl - --- | Use this method to get information about a member of a chat. Returns a 'ChatMember' object on success. -getChatMember :: Token -> Text -> Int -> Manager -> IO (Either ServantError GetChatMemberResponse) -getChatMember token chat_id user_id manager = runClientM (getChatMember_ token (Just chat_id) (Just user_id)) $ ClientEnv manager telegramBaseUrl - --- | Use this method to edit text messages sent by the bot. On success, 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. On success, 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. On success, the edited 'Message' is returned. -editMessageReplyMarkup :: Token -> EditMessageReplyMarkupRequest -> Manager -> IO (Either ServantError MessageResponse) -editMessageReplyMarkup = run telegramBaseUrl editMessageReplyMarkup_ - --- | Use this method to edit text messages sent via the bot (for inline bots). -editInlineMessageText :: Token -> EditMessageTextRequest -> Manager -> IO (Either ServantError (Response Bool)) -editInlineMessageText = run telegramBaseUrl editMessageText__ - --- | Use this method to edit captions of messages sent via the bot (for inline bots). -editInlineMessageCaption :: Token -> EditMessageCaptionRequest -> Manager -> IO (Either ServantError (Response Bool)) -editInlineMessageCaption = run telegramBaseUrl editMessageCaption__ - --- | Use this method to edit only the reply markup of messages sent via the bot (for inline bots). -editInlineMessageReplyMarkup :: Token -> EditMessageReplyMarkupRequest -> Manager -> IO (Either ServantError (Response Bool)) -editInlineMessageReplyMarkup = run telegramBaseUrl editMessageReplyMarkup__ - -run :: BaseUrl -> (Token -> a -> ClientM b) -> Token -> a -> Manager -> IO (Either ServantError b) -run b e t r m = runClientM (e t r) (ClientEnv m b) +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} + +module Web.Telegram.API.Bot.API + ( -- * Functions + getMe + , sendMessage + , forwardMessage + , uploadPhoto + , sendPhoto + , uploadAudio + , sendAudio + , uploadDocument + , sendDocument + , uploadSticker + , sendSticker + , uploadVideo + , sendVideo + , uploadVoice + , sendVoice + , sendLocation + , sendVenue + , sendContact + , sendChatAction + , sendGame + , getUpdates + , getFile + , getUserProfilePhotos + , setWebhook + , setWebhookWithCertificate + , deleteWebhook + , getWebhookInfo + , answerInlineQuery + , answerCallbackQuery + , kickChatMember + , leaveChat + , unbanChatMember + , getChat + , getChatAdministrators + , getChatMembersCount + , getChatMember + , editMessageText + , editMessageCaption + , editMessageReplyMarkup + , editInlineMessageText + , editInlineMessageCaption + , editInlineMessageReplyMarkup + -- * API + , TelegramBotAPI + , api + -- * Types + , Token (..) + ) where + +import Data.Proxy +import Data.Text (Text) +import Network.HTTP.Client (Manager) +import Servant.API +import Servant.Client +import Servant.Client.MultipartFormData +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" + :> MultipartFormDataReqBody (SendAudioRequest FileUpload) + :> Post '[JSON] MessageResponse + :<|> TelegramToken :> "sendAudio" + :> ReqBody '[JSON] (SendAudioRequest Text) + :> Post '[JSON] MessageResponse + :<|> TelegramToken :> "sendDocument" + :> MultipartFormDataReqBody (SendDocumentRequest FileUpload) + :> Post '[JSON] MessageResponse + :<|> TelegramToken :> "sendDocument" + :> ReqBody '[JSON] (SendDocumentRequest Text) + :> Post '[JSON] MessageResponse + :<|> TelegramToken :> "sendSticker" + :> MultipartFormDataReqBody (SendStickerRequest FileUpload) + :> Post '[JSON] MessageResponse + :<|> TelegramToken :> "sendSticker" + :> ReqBody '[JSON] (SendStickerRequest Text) + :> Post '[JSON] MessageResponse + :<|> TelegramToken :> "sendVideo" + :> MultipartFormDataReqBody (SendVideoRequest FileUpload) + :> Post '[JSON] MessageResponse + :<|> TelegramToken :> "sendVideo" + :> ReqBody '[JSON] (SendVideoRequest Text) + :> Post '[JSON] MessageResponse + :<|> TelegramToken :> "sendVoice" + :> MultipartFormDataReqBody (SendVoiceRequest FileUpload) + :> Post '[JSON] MessageResponse + :<|> TelegramToken :> "sendVoice" + :> ReqBody '[JSON] (SendVoiceRequest Text) + :> 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 :> "sendGame" + :> ReqBody '[JSON] SendGameRequest + :> Post '[JSON] MessageResponse + :<|> 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 :> "setWebhook" + :> MultipartFormDataReqBody SetWebhookRequest + :> Post '[JSON] SetWebhookResponse + :<|> TelegramToken :> "deleteWebhook" + :> Post '[JSON] (Response Bool) + :<|> TelegramToken :> "getWebhookInfo" + :> Get '[JSON] GetWebhookInfoResponse + :<|> 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 :> "leaveChat" + :> QueryParam "chat_id" Text + :> Post '[JSON] LeaveChatResponse + :<|> TelegramToken :> "unbanChatMember" + :> QueryParam "chat_id" Text + :> QueryParam "user_id" Int + :> Post '[JSON] UnbanChatMemberResponse + :<|> TelegramToken :> "getChat" + :> QueryParam "chat_id" Text + :> Post '[JSON] GetChatResponse + :<|> TelegramToken :> "getChatAdministrators" + :> QueryParam "chat_id" Text + :> Post '[JSON] GetChatAdministratorsResponse + :<|> TelegramToken :> "getChatMembersCount" + :> QueryParam "chat_id" Text + :> Post '[JSON] GetChatMembersCountResponse + :<|> TelegramToken :> "getChatMember" + :> QueryParam "chat_id" Text + :> QueryParam "user_id" Int + :> Post '[JSON] GetChatMemberResponse + :<|> TelegramToken :> "editMessageText" + :> ReqBody '[JSON] EditMessageTextRequest + :> Post '[JSON] MessageResponse + :<|> TelegramToken :> "editMessageCaption" + :> ReqBody '[JSON] EditMessageCaptionRequest + :> Post '[JSON] MessageResponse + :<|> TelegramToken :> "editMessageReplyMarkup" + :> ReqBody '[JSON] EditMessageReplyMarkupRequest + :> Post '[JSON] MessageResponse + :<|> TelegramToken :> "editMessageText" + :> ReqBody '[JSON] EditMessageTextRequest + :> Post '[JSON] (Response Bool) + :<|> TelegramToken :> "editMessageCaption" + :> ReqBody '[JSON] EditMessageCaptionRequest + :> Post '[JSON] (Response Bool) + :<|> TelegramToken :> "editMessageReplyMarkup" + :> ReqBody '[JSON] EditMessageReplyMarkupRequest + :> Post '[JSON] (Response Bool) + +-- | Proxy for Thelegram Bot API +api :: Proxy TelegramBotAPI +api = Proxy + +getMe_ :: Token -> ClientM GetMeResponse +sendMessage_ :: Token -> SendMessageRequest -> ClientM MessageResponse +forwardMessage_ :: Token -> ForwardMessageRequest -> ClientM MessageResponse +uploadPhoto_ :: Token -> SendPhotoRequest FileUpload -> ClientM MessageResponse +sendPhoto_ :: Token -> SendPhotoRequest Text -> ClientM MessageResponse +uploadAudio_ :: Token -> SendAudioRequest FileUpload -> ClientM MessageResponse +sendAudio_ :: Token -> SendAudioRequest Text -> ClientM MessageResponse +uploadDocument_ :: Token -> SendDocumentRequest FileUpload -> ClientM MessageResponse +sendDocument_ :: Token -> SendDocumentRequest Text -> ClientM MessageResponse +uploadSticker_ :: Token -> SendStickerRequest FileUpload -> ClientM MessageResponse +sendSticker_ :: Token -> SendStickerRequest Text -> ClientM MessageResponse +uploadVideo_ :: Token -> SendVideoRequest FileUpload -> ClientM MessageResponse +sendVideo_ :: Token -> SendVideoRequest Text -> ClientM MessageResponse +uploadVoice_ :: Token -> SendVoiceRequest FileUpload -> ClientM MessageResponse +sendVoice_ :: Token -> SendVoiceRequest Text -> ClientM MessageResponse +sendLocation_ :: Token -> SendLocationRequest -> ClientM MessageResponse +sendVenue_ :: Token -> SendVenueRequest-> ClientM MessageResponse +sendContact_ :: Token -> SendContactRequest -> ClientM MessageResponse +sendChatAction_ :: Token -> SendChatActionRequest -> ClientM ChatActionResponse +sendGame_ :: Token -> SendGameRequest -> ClientM MessageResponse +getUpdates_ :: Token -> Maybe Int -> Maybe Int -> Maybe Int -> ClientM UpdatesResponse +getFile_ :: Token -> Maybe Text -> ClientM FileResponse +getUserProfilePhotos_ :: Token -> Maybe Int -> Maybe Int -> Maybe Int -> ClientM UserProfilePhotosResponse +setWebhook_ :: Token -> Maybe Text -> ClientM SetWebhookResponse +setWebhookWithCert_ :: Token -> SetWebhookRequest -> ClientM SetWebhookResponse +deleteWebhook_ :: Token -> ClientM (Response Bool) +getWebhookInfo_ :: Token -> ClientM GetWebhookInfoResponse +answerInlineQuery_ :: Token -> AnswerInlineQueryRequest -> ClientM InlineQueryResponse +answerCallbackQuery_ :: Token -> AnswerCallbackQueryRequest -> ClientM CallbackQueryResponse +kickChatMember_ :: Token -> Maybe Text -> Maybe Int -> ClientM KickChatMemberResponse +leaveChat_ :: Token -> Maybe Text -> ClientM LeaveChatResponse +unbanChatMember_ :: Token -> Maybe Text -> Maybe Int -> ClientM UnbanChatMemberResponse +getChat_ :: Token -> Maybe Text -> ClientM GetChatResponse +getChatAdministrators_ :: Token -> Maybe Text -> ClientM GetChatAdministratorsResponse +getChatMembersCount_ :: Token -> Maybe Text -> ClientM GetChatMembersCountResponse +getChatMember_ :: Token -> Maybe Text -> Maybe Int -> ClientM GetChatMemberResponse +editMessageText_ :: Token -> EditMessageTextRequest -> ClientM MessageResponse +editMessageCaption_ :: Token -> EditMessageCaptionRequest -> ClientM MessageResponse +editMessageReplyMarkup_ :: Token -> EditMessageReplyMarkupRequest -> ClientM MessageResponse +editMessageText__ :: Token -> EditMessageTextRequest -> ClientM (Response Bool) +editMessageCaption__ :: Token -> EditMessageCaptionRequest -> ClientM (Response Bool) +editMessageReplyMarkup__ :: Token -> EditMessageReplyMarkupRequest -> ClientM (Response Bool) +getMe_ + :<|> sendMessage_ + :<|> forwardMessage_ + :<|> uploadPhoto_ + :<|> sendPhoto_ + :<|> uploadAudio_ + :<|> sendAudio_ + :<|> uploadDocument_ + :<|> sendDocument_ + :<|> uploadSticker_ + :<|> sendSticker_ + :<|> uploadVideo_ + :<|> sendVideo_ + :<|> uploadVoice_ + :<|> sendVoice_ + :<|> sendLocation_ + :<|> sendVenue_ + :<|> sendContact_ + :<|> sendChatAction_ + :<|> sendGame_ + :<|> getUpdates_ + :<|> getFile_ + :<|> getUserProfilePhotos_ + :<|> setWebhook_ + :<|> setWebhookWithCert_ + :<|> deleteWebhook_ + :<|> getWebhookInfo_ + :<|> answerInlineQuery_ + :<|> answerCallbackQuery_ + :<|> kickChatMember_ + :<|> leaveChat_ + :<|> unbanChatMember_ + :<|> getChat_ + :<|> getChatAdministrators_ + :<|> getChatMembersCount_ + :<|> getChatMember_ + :<|> editMessageText_ + :<|> editMessageCaption_ + :<|> editMessageReplyMarkup_ + :<|> 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 = runClientM (getMe_ token) (ClientEnv 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 upload and 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. +uploadAudio :: Token -> SendAudioRequest FileUpload -> Manager -> IO (Either ServantError MessageResponse) +uploadAudio = run telegramBaseUrl uploadAudio_ + +-- | Use this method to send audio files that are already on the Telegram servers, 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 Text -> Manager -> IO (Either ServantError MessageResponse) +sendAudio = run telegramBaseUrl sendAudio_ + +-- | Use this method to upload and 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. +uploadDocument :: Token -> SendDocumentRequest FileUpload -> Manager -> IO (Either ServantError MessageResponse) +uploadDocument = run telegramBaseUrl uploadDocument_ + +-- | Use this method to send general files that have already been uploaded. 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 Text -> Manager -> IO (Either ServantError MessageResponse) +sendDocument = run telegramBaseUrl sendDocument_ + +-- | Use this method to upload and send .webp stickers. On success, the sent 'Message' is returned. +uploadSticker :: Token -> SendStickerRequest FileUpload -> Manager -> IO (Either ServantError MessageResponse) +uploadSticker = run telegramBaseUrl uploadSticker_ + +-- | Use this method to send .webp stickers that are already on the Telegram servers. On success, the sent 'Message' is returned. +sendSticker :: Token -> SendStickerRequest Text -> Manager -> IO (Either ServantError MessageResponse) +sendSticker = run telegramBaseUrl sendSticker_ + +-- | Use this method to upload and 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. +uploadVideo :: Token -> SendVideoRequest FileUpload -> Manager -> IO (Either ServantError MessageResponse) +uploadVideo = run telegramBaseUrl uploadVideo_ + +-- | Use this method to send video files that are already on the Telegram servers. 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 Text -> Manager -> IO (Either ServantError MessageResponse) +sendVideo = run telegramBaseUrl sendVideo_ + +-- | Use this method to upload and 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. +uploadVoice :: Token -> SendVoiceRequest FileUpload -> Manager -> IO (Either ServantError MessageResponse) +uploadVoice = run telegramBaseUrl uploadVoice_ + +-- | Use this method to send audio files that are already on the telegram server, 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 Text -> 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 send a game. On success, the sent 'Message' is returned. +sendGame :: Token -> SendGameRequest -> Manager -> IO (Either ServantError MessageResponse) +sendGame = run telegramBaseUrl sendGame_ + +-- | Use this method to receive incoming updates using long polling. An Array of 'Update' objects is returned. +getUpdates + :: Token + -> Maybe Int -- ^ offset + -> Maybe Int -- ^ limit + -> Maybe Int -- ^ timeout + -> Manager + -> IO (Either ServantError UpdatesResponse) +getUpdates token offset limit timeout manager = runClientM (getUpdates_ token offset limit timeout) $ ClientEnv 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/@, where @@ 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 = runClientM (getFile_ token (Just file_id)) $ ClientEnv 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 = runClientM (getUserProfilePhotos_ token (Just user_id) offset limit) $ ClientEnv 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/@. 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 = runClientM (setWebhook_ token url) $ ClientEnv 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/@. Since nobody else knows your bot‘s token, you can be pretty sure it’s us. +setWebhookWithCertificate :: Token -> SetWebhookRequest -> Manager -> IO (Either ServantError SetWebhookResponse) +setWebhookWithCertificate = run telegramBaseUrl setWebhookWithCert_ + +deleteWebhook :: Token -> Manager -> IO (Either ServantError (Response Bool)) +deleteWebhook token manager = runClientM (deleteWebhook_ token) $ ClientEnv manager telegramBaseUrl + +-- | Contains information about the current status of a webhook. +getWebhookInfo :: Token -> Manager -> IO (Either ServantError GetWebhookInfoResponse) +getWebhookInfo token manager = runClientM (getWebhookInfo_ token) $ ClientEnv 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 = runClientM (kickChatMember_ token (Just chat_id) (Just user_id)) $ ClientEnv manager telegramBaseUrl + +-- | Use this method for your bot to leave a group, supergroup or channel. Returns True on success. +leaveChat :: Token -> Text -> Manager -> IO (Either ServantError LeaveChatResponse) +leaveChat token chat_id manager = runClientM (leaveChat_ token (Just chat_id)) $ ClientEnv 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 = runClientM (unbanChatMember_ token (Just chat_id) (Just user_id)) $ ClientEnv manager telegramBaseUrl + +-- | Use this method to get up to date information about the chat (current name of the user for one-on-one conversations, current username of a user, group or channel, etc.) +getChat :: Token -> Text -> Manager -> IO (Either ServantError GetChatResponse) +getChat token chat_id manager = runClientM (getChat_ token (Just chat_id)) $ ClientEnv manager telegramBaseUrl + +-- | Use this method to get a list of administrators in a chat. On success, returns an Array of 'ChatMember' objects that contains information about all chat administrators except other bots. If the chat is a group or a supergroup and no administrators were appointed, only the creator will be returned. +getChatAdministrators :: Token -> Text -> Manager -> IO (Either ServantError GetChatAdministratorsResponse) +getChatAdministrators token chat_id manager = runClientM (getChatAdministrators_ token (Just chat_id)) $ ClientEnv manager telegramBaseUrl + +-- | Use this method to get the number of members in a chat. Returns 'Int' on success. +getChatMembersCount :: Token -> Text -> Manager -> IO (Either ServantError GetChatMembersCountResponse) +getChatMembersCount token chat_id manager = runClientM (getChatMembersCount_ token (Just chat_id)) $ ClientEnv manager telegramBaseUrl + +-- | Use this method to get information about a member of a chat. Returns a 'ChatMember' object on success. +getChatMember :: Token -> Text -> Int -> Manager -> IO (Either ServantError GetChatMemberResponse) +getChatMember token chat_id user_id manager = runClientM (getChatMember_ token (Just chat_id) (Just user_id)) $ ClientEnv manager telegramBaseUrl + +-- | Use this method to edit text messages sent by the bot. On success, 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. On success, 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. On success, the edited 'Message' is returned. +editMessageReplyMarkup :: Token -> EditMessageReplyMarkupRequest -> Manager -> IO (Either ServantError MessageResponse) +editMessageReplyMarkup = run telegramBaseUrl editMessageReplyMarkup_ + +-- | Use this method to edit text messages sent via the bot (for inline bots). +editInlineMessageText :: Token -> EditMessageTextRequest -> Manager -> IO (Either ServantError (Response Bool)) +editInlineMessageText = run telegramBaseUrl editMessageText__ + +-- | Use this method to edit captions of messages sent via the bot (for inline bots). +editInlineMessageCaption :: Token -> EditMessageCaptionRequest -> Manager -> IO (Either ServantError (Response Bool)) +editInlineMessageCaption = run telegramBaseUrl editMessageCaption__ + +-- | Use this method to edit only the reply markup of messages sent via the bot (for inline bots). +editInlineMessageReplyMarkup :: Token -> EditMessageReplyMarkupRequest -> Manager -> IO (Either ServantError (Response Bool)) +editInlineMessageReplyMarkup = run telegramBaseUrl editMessageReplyMarkup__ + +run :: BaseUrl -> (Token -> a -> ClientM b) -> Token -> a -> Manager -> IO (Either ServantError b) +run b e t r m = runClientM (e t r) (ClientEnv m b) diff --git a/src/Web/Telegram/API/Bot/Data.hs b/src/Web/Telegram/API/Bot/Data.hs --- a/src/Web/Telegram/API/Bot/Data.hs +++ b/src/Web/Telegram/API/Bot/Data.hs @@ -1,790 +1,879 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE OverloadedStrings #-} - --- | This module contains objects which represent data of Telegram Bot API responses -module Web.Telegram.API.Bot.Data - ( -- * Types - User (..) - , ChatMember (..) - , Chat (..) - , Message (..) - , MessageEntity (..) - , PhotoSize (..) - , Audio (..) - , Document (..) - , Sticker (..) - , Video (..) - , Voice (..) - , Venue (..) - , 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.Maybe() -import Data.Aeson.Types -import Data.Text (Text) -import qualified Data.Char as Char -import GHC.Generics -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 "Cached" `isPrefixOf` name then drop 6 name else name - -tagModifier :: String -> String -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. - , edited_message :: Maybe Message -- ^ New version of a message that is known to the bot and was edited - , 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/@. 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/@ 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) - -data ChatMember = ChatMember - { - cm_user :: User -- ^ Information about the user - , cm_status :: Text -- ^ The member's status in the chat. Can be “creator”, “administrator”, “member”, “left” or “kicked” - } deriving (Show, Generic) - -instance ToJSON ChatMember where - toJSON = toJsonDrop 3 - -instance FromJSON ChatMember where - parseJSON = parseJsonDrop 3 - --- | 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. - , edit_date :: Maybe Int -- ^ Date the message was last edited in Unix time - , 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. Can be 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), text_mention (for users without usernames) - , 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 - , me_user :: Maybe User -- ^ For “text_mention” only, the mentioned user - } 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 +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | This module contains objects which represent data of Telegram Bot API responses +module Web.Telegram.API.Bot.Data + ( -- * Types + User (..) + , ChatMember (..) + , Chat (..) + , Message (..) + , MessageEntity (..) + , PhotoSize (..) + , Audio (..) + , Document (..) + , Game (..) + , Animation (..) + , Sticker (..) + , Video (..) + , Voice (..) + , Venue (..) + , Contact (..) + , Location (..) + , Update (..) + , File (..) + , UserProfilePhotos (..) + , InlineQuery (..) + , ChosenInlineResult (..) + , InlineQueryResult (..) + , InlineKeyboardMarkup (..) + , InlineKeyboardButton (..) + , CallbackGame (..) + , CallbackQuery (..) + , ChatType (..) + , ParseMode (..) + , InputMessageContent (..) + , KeyboardButton (..) + , WebhookInfo (..) + -- * Functions + , inlineKeyboardButton + , keyboardButton + , inlineQueryResultArticle + , inlineQueryResultAudio + , inlineQueryResultContact + , inlineQueryResultDocument + , inlineQueryResultGif + , inlineQueryResultLocation + , inlineQueryResultMpeg4Gif + , inlineQueryResultPhoto + , inlineQueryResultVenue + , inlineQueryResultVideo + , inlineQueryResultVoice + , inlineQueryResultCachedAudio + , inlineQueryResultCachedDocument + , inlineQueryResultCachedGif + , inlineQueryResultCachedMpeg4Gif + , inlineQueryResultGame + , inlineQueryResultCachedPhoto + , inlineQueryResultCachedSticker + , inlineQueryResultCachedVideo + , inlineQueryResultCachedVoice + + ) where + +import Prelude hiding (id) + +import Data.Aeson +import Data.Maybe() +import Data.Aeson.Types +import Data.Text (Text) +import qualified Data.Char as Char +import GHC.Generics +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 + , chat_all_members_are_administrators :: Maybe Bool -- ^ True if a group has ‘All Members Are Admins’ enabled. + } 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 game. Use BotFather to create and edit games, their short names will act as unique identifiers. +data Game = Game + { + game_title :: Text -- ^ Title of the game + , game_description :: Text -- ^ Description of the game + , game_photo :: [PhotoSize] -- ^ Photo that will be displayed in the game message in chats. + , game_text :: Maybe Text -- ^ Brief description of the game or high scores included in the game message. Can be automatically edited to include current high scores for the game when the bot calls setGameScore, or manually edited using editMessageText. 0-4096 characters. + , game_text_entities :: Maybe [MessageEntity] -- ^ Special entities that appear in text, such as usernames, URLs, bot commands, etc. + , game_animation :: Maybe Animation -- ^ Animation that will be displayed in the game message in chats. Upload via BotFather + } deriving (Show, Generic) + +instance ToJSON Game where + toJSON = toJsonDrop 5 + +instance FromJSON Game where + parseJSON = parseJsonDrop 5 + +-- | This object represents an animation file to be displayed in the message containing a game. +data Animation = Animation + { + anim_file_id :: Text -- ^ Unique file identifier + , anim_thumb :: Maybe PhotoSize -- ^ Animation thumbnail as defined by sender + , anim_file_name :: Maybe Text -- ^ Original animation filename as defined by sender + , anim_mime_type :: Maybe Text -- ^ MIME type of the file as defined by sender + , anim_file_size :: Maybe Int -- ^ File size + } deriving (Show, Generic) + +instance ToJSON Animation where + toJSON = toJsonDrop 5 + +instance FromJSON Animation where + parseJSON = parseJsonDrop 5 + +-- | 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_caption :: Maybe Text -- ^ Caption, 0-200 characters + , 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_caption :: Maybe Text -- ^ Caption, 0-200 characters + , 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 Game. + | InlineQueryResultGame + { + iq_res_id :: Text -- ^ Unique identifier for this result, 1-64 bytes + , iq_res_game_short_name :: Text -- ^ Short name of the game + , iq_res_reply_markup :: Maybe InlineKeyboardMarkup -- ^ Inline keyboard attached to the message + } + -- | 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_caption :: Maybe Text -- ^ Caption, 0-200 characters + , 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_caption :: Maybe Text -- ^ Caption, 0-200 characters + , 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 "Cached" `isPrefixOf` name then drop 6 name else name + +tagModifier :: String -> String +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 Nothing + +inlineQueryResultVoice :: Text -> Text -> Text -> InlineQueryResult +inlineQueryResultVoice id voiceUrl title = InlineQueryResultVoice id voiceUrl (Just title) Nothing 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 + +inlineQueryResultGame :: Text -> Text -> InlineQueryResult +inlineQueryResultGame id gameShortName = InlineQueryResultGame id gameShortName 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 Nothing + +inlineQueryResultCachedAudio :: Text -> Text -> InlineQueryResult +inlineQueryResultCachedAudio id fileId = InlineQueryResultCachedAudio id fileId Nothing 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 + , ikb_callback_game :: Maybe CallbackGame + , ikb_switch_inline_query_current_chat :: Maybe Text -- ^ If set, pressing the button will insert the bot‘s username and the specified inline query in the current chat's input field. Can be empty, in which case only the bot’s username will be inserted. + } deriving (Show, Generic) + +instance ToJSON InlineKeyboardButton where + toJSON = toJsonDrop 4 + +instance FromJSON InlineKeyboardButton where + parseJSON = parseJsonDrop 4 + +inlineKeyboardButton :: Text -> InlineKeyboardButton +inlineKeyboardButton buttonText = + InlineKeyboardButton buttonText Nothing Nothing Nothing Nothing Nothing + +data CallbackGame = CallbackGame + { + } deriving (Show, Generic) + +instance ToJSON CallbackGame where + toJSON = toJsonDrop 3 + +instance FromJSON CallbackGame where + parseJSON = parseJsonDrop 3 + +data CallbackQuery = CallbackQuery + { + cq_id :: Text + , cq_from :: User + , cq_message :: Maybe Message + , cq_inline_message_id :: Maybe Text + , cq_chat_instance :: Text + , cq_data :: Maybe Text + , cq_game_short_name :: 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. + , edited_message :: Maybe Message -- ^ New version of a message that is known to the bot and was edited + , channel_post :: Maybe Message -- ^ New incoming channel post of any kind — text, photo, sticker, etc. + , edited_channel_post :: Maybe Message -- ^ New version of a channel post that is known to the bot and was edited + , 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/@. 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/@ 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) + +data ChatMember = ChatMember + { + cm_user :: User -- ^ Information about the user + , cm_status :: Text -- ^ The member's status in the chat. Can be “creator”, “administrator”, “member”, “left” or “kicked” + } deriving (Show, Generic) + +instance ToJSON ChatMember where + toJSON = toJsonDrop 3 + +instance FromJSON ChatMember where + parseJSON = parseJsonDrop 3 + +-- | 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_from_message_id :: Maybe Int -- ^ For forwarded channel posts, identifier of the original message in the 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. + , edit_date :: Maybe Int -- ^ Date the message was last edited in Unix time + , 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 + , game :: Maybe Game -- ^ Message is a game, information about the game + , 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. Can be 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), text_mention (for users without usernames) + , 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 + , me_user :: Maybe User -- ^ For “text_mention” only, the mentioned user + } 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 buttonText = KeyboardButton buttonText Nothing Nothing + +data WebhookInfo = WebhookInfo + { + whi_url :: Text -- ^ Webhook URL, may be empty if webhook is not set up + , whi_has_custom_certificate :: Bool -- ^ True, if a custom certificate was provided for webhook certificate checks + , whi_pending_update_count :: Int -- ^ Number of updates awaiting delivery + , whi_last_error_date :: Maybe Int -- ^ Unix time for the most recent error that happened when trying to deliver an update via webhook + , whi_last_error_message :: Maybe Text -- ^ Error message in human-readable format for the most recent error that happened when trying to deliver an update via webhook + } deriving (Show, Generic) + +instance ToJSON WebhookInfo where + toJSON = toJsonDrop 4 + +instance FromJSON WebhookInfo where + parseJSON = parseJsonDrop 4 diff --git a/src/Web/Telegram/API/Bot/JsonExt.hs b/src/Web/Telegram/API/Bot/JsonExt.hs --- a/src/Web/Telegram/API/Bot/JsonExt.hs +++ b/src/Web/Telegram/API/Bot/JsonExt.hs @@ -1,24 +1,24 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE RankNTypes #-} - --- | 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 - --- | Method used to drop prefix from field name during serialization -toJsonDrop :: forall a.(Generic a, GToJSON Zero (Rep a)) => Int -> a -> Value -toJsonDrop prefix = genericToJSON defaultOptions { - fieldLabelModifier = drop prefix - , omitNothingFields = True - } - --- | Method used to drop prefix from field name during deserialization -parseJsonDrop :: forall a.(Generic a, GFromJSON Zero (Rep a)) => Int -> Value -> Parser a -parseJsonDrop prefix = genericParseJSON defaultOptions { fieldLabelModifier = drop prefix } +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} + +-- | 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 + +-- | Method used to drop prefix from field name during serialization +toJsonDrop :: forall a.(Generic a, GToJSON Zero (Rep a)) => Int -> a -> Value +toJsonDrop prefix = genericToJSON defaultOptions { + fieldLabelModifier = drop prefix + , omitNothingFields = True + } + +-- | Method used to drop prefix from field name during deserialization +parseJsonDrop :: forall a.(Generic a, GFromJSON Zero (Rep a)) => Int -> Value -> Parser a +parseJsonDrop prefix = genericParseJSON defaultOptions { fieldLabelModifier = drop prefix } diff --git a/src/Web/Telegram/API/Bot/Requests.hs b/src/Web/Telegram/API/Bot/Requests.hs --- a/src/Web/Telegram/API/Bot/Requests.hs +++ b/src/Web/Telegram/API/Bot/Requests.hs @@ -1,634 +1,667 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} -{-# 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 (..) - , SetWebhookRequest (..) - , SendPhotoRequest (..) - , SendAudioRequest (..) - , SendDocumentRequest (..) - , SendStickerRequest (..) - , SendVideoRequest (..) - , SendVoiceRequest (..) - , SendLocationRequest (..) - , SendVenueRequest (..) - , SendContactRequest (..) - , SendChatActionRequest (..) - , ChatAction (..) - , AnswerInlineQueryRequest (..) - , AnswerCallbackQueryRequest (..) - , ReplyKeyboard (..) - , EditMessageTextRequest (..) - , EditMessageCaptionRequest (..) - , EditMessageReplyMarkupRequest (..) - -- * Functions - , localFileUpload - , setWebhookRequest - , sendMessageRequest - , forwardMessageRequest - , sendPhotoRequest - , uploadPhotoRequest - , sendAudioRequest - , uploadAudioRequest - , sendDocumentRequest - , uploadDocumentRequest - , sendStickerRequest - , uploadStickerRequest - , sendVideoRequest - , uploadVideoRequest - , sendVoiceRequest - , uploadVoiceRequest - , sendLocationRequest - , sendVenueRequest - , sendContactRequest - , sendChatActionRequest - , answerInlineQueryRequest - , answerCallbackQueryRequest - , inlineKeyboardMarkup - , replyKeyboardMarkup - , replyKeyboardHide - , forceReply - , editMessageTextRequest - , editInlineMessageTextRequest - , editMessageCaptionRequest - , editInlineMessageCaptionRequest - , editMessageReplyMarkupRequest - , editInlineMessageReplyMarkupRequest - ) where - -import Data.Aeson -import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as LBS -import Data.Maybe -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import GHC.Generics -import Network.HTTP.Client.MultipartFormData -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 :: Maybe MimeType -- ^ Mime type of the upload. - , fileUpload_content :: FileUploadContent -- ^ The payload/source to upload. - } - -localFileUpload :: FilePath -> FileUpload -localFileUpload path = FileUpload - { fileUpload_type = Nothing - , fileUpload_content = FileUploadFile path - } - -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 = fileUpload_type fileUpload } - -utf8Part :: Text -> Text -> Part -utf8Part inputName = partBS inputName . T.encodeUtf8 - --- | This object represents request for 'setWebhookWithCertificate' -data SetWebhookRequest = SetWebhookRequest - { - webhook_url :: Text -- ^ HTTPS url to send updates to. Use `setWebhook` function and an empty string to remove webhook integration - , webhook_certificate :: FileUpload -- ^ Upload your public key certificate so that the root certificate in use can be checked. - } - -instance ToMultipartFormData SetWebhookRequest where - toMultipartFormData req = - [ utf8Part "url" $ webhook_url req - , fileUploadToPart "certificate" $ webhook_certificate req - ] - -setWebhookRequest :: Text -> FileUpload -> SetWebhookRequest -setWebhookRequest = SetWebhookRequest - --- | 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 req = - [ utf8Part "chat_id" (photo_chat_id req) ] ++ - catMaybes - [ utf8Part "caption" <$> photo_caption req - , partLBS "disable_notification" . encode <$> photo_disable_notification req - , utf8Part "reply_to_message_id" . T.pack . show <$> photo_reply_to_message_id req - , partLBS "reply_markup" . encode <$> photo_reply_markup req - ] ++ - [ fileUploadToPart "photo" (photo_photo req) ] - --- | This object represents request for 'sendAudio' -data SendAudioRequest payload = SendAudioRequest - { - _audio_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) - , _audio_audio :: payload -- ^ Audio to send. You can either pass a file_id as String to resend an audio that is already on the Telegram servers, or upload a new audio file. - , _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 Text) where - toJSON = toJsonDrop 7 - -instance FromJSON (SendAudioRequest Text) where - parseJSON = parseJsonDrop 7 - -instance ToMultipartFormData (SendAudioRequest FileUpload) where - toMultipartFormData req = - [ utf8Part "chat_id" (_audio_chat_id req) ] ++ - catMaybes - [ utf8Part "duration" . T.pack . show <$> _audio_duration req - , utf8Part "performer" <$> _audio_performer req - , utf8Part "title" <$> _audio_title req - , partLBS "disable_notification" . encode <$> _audio_disable_notification req - , utf8Part "reply_to_message_id" . T.pack . show <$> _audio_reply_to_message_id req - , partLBS "reply_markup" . encode <$> _audio_reply_markup req - ] ++ - [ fileUploadToPart "audio" (_audio_audio req) ] - -sendAudioRequest :: Text -> Text -> SendAudioRequest Text -sendAudioRequest chatId audio = SendAudioRequest chatId audio Nothing Nothing Nothing Nothing Nothing Nothing - -uploadAudioRequest :: Text -> FileUpload -> SendAudioRequest FileUpload -uploadAudioRequest chatId audio = SendAudioRequest chatId audio Nothing Nothing Nothing Nothing Nothing Nothing - --- | This object represents request for 'sendSticker' -data SendStickerRequest payload = SendStickerRequest - { - sticker_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) - , sticker_sticker :: payload -- ^ Sticker to send. You can either pass a file_id as String to resend a sticker that is already on the Telegram servers, or upload a new sticker. - , 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 Text) where - toJSON = toJsonDrop 8 - -instance FromJSON (SendStickerRequest Text) where - parseJSON = parseJsonDrop 8 - -instance ToMultipartFormData (SendStickerRequest FileUpload) where - toMultipartFormData req = - [ utf8Part "chat_id" (sticker_chat_id req) ] ++ - catMaybes - [ partLBS "disable_notification" . encode <$> sticker_disable_notification req - , utf8Part "reply_to_message_id" . T.pack . show <$> sticker_reply_to_message_id req - , partLBS "reply_markup" . encode <$> sticker_reply_markup req - ] ++ - [ fileUploadToPart "sticker" (sticker_sticker req) ] - -sendStickerRequest :: Text -> Text -> SendStickerRequest Text -sendStickerRequest chatId sticker = SendStickerRequest chatId sticker Nothing Nothing Nothing - -uploadStickerRequest :: Text -> FileUpload -> SendStickerRequest FileUpload -uploadStickerRequest chatId sticker = SendStickerRequest chatId sticker Nothing Nothing Nothing - --- | This object represents request for 'sendDocument' -data SendDocumentRequest payload = SendDocumentRequest - { - document_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) - , document_document :: payload -- ^ File to send. You can either pass a file_id as String to resend a file that is already on the Telegram servers, or upload a new file. - , 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 Text) where - toJSON = toJsonDrop 9 - -instance FromJSON (SendDocumentRequest Text) where - parseJSON = parseJsonDrop 9 - -instance ToMultipartFormData (SendDocumentRequest FileUpload) where - toMultipartFormData req = - [ utf8Part "chat_id" (document_chat_id req) ] ++ - catMaybes - [ utf8Part "caption" <$> document_caption req - , partLBS "disable_notification" . encode <$> document_disable_notification req - , utf8Part "reply_to_message_id" . T.pack . show <$> document_reply_to_message_id req - , partLBS "reply_markup" . encode <$> document_reply_markup req - ] ++ - [ fileUploadToPart "document" (document_document req) ] - -sendDocumentRequest :: Text -> Text -> SendDocumentRequest Text -sendDocumentRequest chatId document = SendDocumentRequest chatId document Nothing Nothing Nothing Nothing - -uploadDocumentRequest :: Text -> FileUpload -> SendDocumentRequest FileUpload -uploadDocumentRequest chatId document = SendDocumentRequest chatId document Nothing Nothing Nothing Nothing - --- | This object represents request for 'sendVideo' -data SendVideoRequest payload = SendVideoRequest - { - _video_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) - , _video_video :: payload -- ^ Video to send. You can either pass a file_id as String to resend a video that is already on the Telegram servers, or upload a new video. - , _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 Text) where - toJSON = toJsonDrop 7 - -instance FromJSON (SendVideoRequest Text) where - parseJSON = parseJsonDrop 7 - -instance ToMultipartFormData (SendVideoRequest FileUpload) where - toMultipartFormData req = - [ utf8Part "chat_id" (_video_chat_id req) ] ++ - catMaybes - [ partLBS "duration" . encode <$> _video_duration req - , utf8Part "caption" <$> _video_caption req - , partLBS "disable_notification" . encode <$> _video_disable_notification req - , utf8Part "reply_to_message_id" . T.pack . show <$> _video_reply_to_message_id req - , partLBS "reply_markup" . encode <$> _video_reply_markup req - ] ++ - [ fileUploadToPart "video" (_video_video req) ] - -sendVideoRequest :: Text -> Text -> SendVideoRequest Text -sendVideoRequest chatId video = SendVideoRequest chatId video Nothing Nothing Nothing Nothing Nothing - -uploadVideoRequest :: Text -> FileUpload -> SendVideoRequest FileUpload -uploadVideoRequest chatId video = SendVideoRequest chatId video Nothing Nothing Nothing Nothing Nothing - --- | This object represents request for 'sendVoice' -data SendVoiceRequest payload = SendVoiceRequest - { - _voice_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) - , _voice_voice :: payload -- ^ Audio file to send. You can either pass a file_id as String to resend an audio that is already on the Telegram servers, or upload a new audio file. - , _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 Text) where - toJSON = toJsonDrop 7 - -instance FromJSON (SendVoiceRequest Text) where - parseJSON = parseJsonDrop 7 - -instance ToMultipartFormData (SendVoiceRequest FileUpload) where - toMultipartFormData req = - [ utf8Part "chat_id" (_voice_chat_id req) ] ++ - catMaybes - [ partLBS "duration" . encode <$> _voice_duration req - , partLBS "disable_notification" . encode <$> _voice_disable_notification req - , utf8Part "reply_to_message_id" . T.pack . show <$> _voice_reply_to_message_id req - , partLBS "reply_markup" . encode <$> _voice_reply_markup req - ] ++ - [ fileUploadToPart "voice" (_voice_voice req) ] - -sendVoiceRequest :: Text -> Text -> SendVoiceRequest Text -sendVoiceRequest chatId voice = SendVoiceRequest chatId voice Nothing Nothing Nothing Nothing - -uploadVoiceRequest :: Text -> FileUpload -> SendVoiceRequest FileUpload -uploadVoiceRequest 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 = SendChatActionRequest - -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 - ReplyInlineKeyboardMarkup - { - reply_inline_keyboard :: [[InlineKeyboardButton]] -- ^ Array of button rows, each represented by an Array of InlineKeyboardButton objects - } - | 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 - -inlineKeyboardMarkup :: [[InlineKeyboardButton]] -> ReplyKeyboard -inlineKeyboardMarkup = ReplyInlineKeyboardMarkup - -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 +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# 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 (..) + , SetWebhookRequest (..) + , SendPhotoRequest (..) + , SendAudioRequest (..) + , SendDocumentRequest (..) + , SendStickerRequest (..) + , SendVideoRequest (..) + , SendVoiceRequest (..) + , SendLocationRequest (..) + , SendVenueRequest (..) + , SendContactRequest (..) + , SendChatActionRequest (..) + , SendGameRequest (..) + , ChatAction (..) + , AnswerInlineQueryRequest (..) + , AnswerCallbackQueryRequest (..) + , ReplyKeyboard (..) + , EditMessageTextRequest (..) + , EditMessageCaptionRequest (..) + , EditMessageReplyMarkupRequest (..) + -- * Functions + , localFileUpload + , setWebhookRequest + , sendMessageRequest + , forwardMessageRequest + , sendPhotoRequest + , uploadPhotoRequest + , sendAudioRequest + , uploadAudioRequest + , sendDocumentRequest + , uploadDocumentRequest + , sendStickerRequest + , uploadStickerRequest + , sendVideoRequest + , uploadVideoRequest + , sendVoiceRequest + , uploadVoiceRequest + , sendLocationRequest + , sendVenueRequest + , sendContactRequest + , sendChatActionRequest + , sendGameRequest + , answerInlineQueryRequest + , answerCallbackQueryRequest + , inlineKeyboardMarkup + , replyKeyboardMarkup + , replyKeyboardHide + , forceReply + , editMessageTextRequest + , editInlineMessageTextRequest + , editMessageCaptionRequest + , editInlineMessageCaptionRequest + , editMessageReplyMarkupRequest + , editInlineMessageReplyMarkupRequest + ) where + +import Data.Aeson +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS +import Data.Maybe +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import GHC.Generics +import Network.HTTP.Client.MultipartFormData +import Network.Mime +import Servant.Client.MultipartFormData (ToMultipartFormData (..)) +import Web.Telegram.API.Bot.Data (InlineKeyboardButton, + InlineKeyboardMarkup, + InlineQueryResult, KeyboardButton, + ParseMode) +import Web.Telegram.API.Bot.JsonExt + + +-- | 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 :: Maybe MimeType -- ^ Mime type of the upload. + , fileUpload_content :: FileUploadContent -- ^ The payload/source to upload. + } + +localFileUpload :: FilePath -> FileUpload +localFileUpload path = FileUpload + { fileUpload_type = Nothing + , fileUpload_content = FileUploadFile path + } + +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 = fileUpload_type fileUpload } + +utf8Part :: Text -> Text -> Part +utf8Part inputName = partBS inputName . T.encodeUtf8 + +-- | This object represents request for 'setWebhookWithCertificate' +data SetWebhookRequest = SetWebhookRequest + { + webhook_url :: Text -- ^ HTTPS url to send updates to. Use `setWebhook` function and an empty string to remove webhook integration + , webhook_certificate :: FileUpload -- ^ Upload your public key certificate so that the root certificate in use can be checked. + } + +instance ToMultipartFormData SetWebhookRequest where + toMultipartFormData req = + [ utf8Part "url" $ webhook_url req + , fileUploadToPart "certificate" $ webhook_certificate req + ] + +setWebhookRequest :: Text -> FileUpload -> SetWebhookRequest +setWebhookRequest = SetWebhookRequest + +-- | 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 req = + [ utf8Part "chat_id" (photo_chat_id req) ] ++ + catMaybes + [ utf8Part "caption" <$> photo_caption req + , partLBS "disable_notification" . encode <$> photo_disable_notification req + , utf8Part "reply_to_message_id" . T.pack . show <$> photo_reply_to_message_id req + , partLBS "reply_markup" . encode <$> photo_reply_markup req + ] ++ + [ fileUploadToPart "photo" (photo_photo req) ] + +-- | This object represents request for 'sendAudio' +data SendAudioRequest payload = SendAudioRequest + { + _audio_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) + , _audio_audio :: payload -- ^ Audio to send. You can either pass a file_id as String to resend an audio that is already on the Telegram servers, or upload a new audio file. + , _audio_caption :: Maybe Text -- ^ Audio caption, 0-200 characters + , _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 Text) where + toJSON = toJsonDrop 7 + +instance FromJSON (SendAudioRequest Text) where + parseJSON = parseJsonDrop 7 + +instance ToMultipartFormData (SendAudioRequest FileUpload) where + toMultipartFormData req = + [ utf8Part "chat_id" (_audio_chat_id req) ] ++ + catMaybes + [ utf8Part "duration" . T.pack . show <$> _audio_duration req + , utf8Part "performer" <$> _audio_performer req + , utf8Part "title" <$> _audio_title req + , partLBS "disable_notification" . encode <$> _audio_disable_notification req + , utf8Part "reply_to_message_id" . T.pack . show <$> _audio_reply_to_message_id req + , partLBS "reply_markup" . encode <$> _audio_reply_markup req + ] ++ + [ fileUploadToPart "audio" (_audio_audio req) ] + +sendAudioRequest :: Text -> Text -> SendAudioRequest Text +sendAudioRequest chatId audio = SendAudioRequest chatId audio Nothing Nothing Nothing Nothing Nothing Nothing Nothing + +uploadAudioRequest :: Text -> FileUpload -> SendAudioRequest FileUpload +uploadAudioRequest chatId audio = SendAudioRequest chatId audio Nothing Nothing Nothing Nothing Nothing Nothing Nothing + +-- | This object represents request for 'sendSticker' +data SendStickerRequest payload = SendStickerRequest + { + sticker_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) + , sticker_sticker :: payload -- ^ Sticker to send. You can either pass a file_id as String to resend a sticker that is already on the Telegram servers, or upload a new sticker. + , 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 Text) where + toJSON = toJsonDrop 8 + +instance FromJSON (SendStickerRequest Text) where + parseJSON = parseJsonDrop 8 + +instance ToMultipartFormData (SendStickerRequest FileUpload) where + toMultipartFormData req = + [ utf8Part "chat_id" (sticker_chat_id req) ] ++ + catMaybes + [ partLBS "disable_notification" . encode <$> sticker_disable_notification req + , utf8Part "reply_to_message_id" . T.pack . show <$> sticker_reply_to_message_id req + , partLBS "reply_markup" . encode <$> sticker_reply_markup req + ] ++ + [ fileUploadToPart "sticker" (sticker_sticker req) ] + +sendStickerRequest :: Text -> Text -> SendStickerRequest Text +sendStickerRequest chatId sticker = SendStickerRequest chatId sticker Nothing Nothing Nothing + +uploadStickerRequest :: Text -> FileUpload -> SendStickerRequest FileUpload +uploadStickerRequest chatId sticker = SendStickerRequest chatId sticker Nothing Nothing Nothing + +-- | This object represents request for 'sendDocument' +data SendDocumentRequest payload = SendDocumentRequest + { + document_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) + , document_document :: payload -- ^ File to send. You can either pass a file_id as String to resend a file that is already on the Telegram servers, or upload a new file. + , 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 Text) where + toJSON = toJsonDrop 9 + +instance FromJSON (SendDocumentRequest Text) where + parseJSON = parseJsonDrop 9 + +instance ToMultipartFormData (SendDocumentRequest FileUpload) where + toMultipartFormData req = + [ utf8Part "chat_id" (document_chat_id req) ] ++ + catMaybes + [ utf8Part "caption" <$> document_caption req + , partLBS "disable_notification" . encode <$> document_disable_notification req + , utf8Part "reply_to_message_id" . T.pack . show <$> document_reply_to_message_id req + , partLBS "reply_markup" . encode <$> document_reply_markup req + ] ++ + [ fileUploadToPart "document" (document_document req) ] + +sendDocumentRequest :: Text -> Text -> SendDocumentRequest Text +sendDocumentRequest chatId document = SendDocumentRequest chatId document Nothing Nothing Nothing Nothing + +uploadDocumentRequest :: Text -> FileUpload -> SendDocumentRequest FileUpload +uploadDocumentRequest chatId document = SendDocumentRequest chatId document Nothing Nothing Nothing Nothing + +-- | This object represents request for 'sendVideo' +data SendVideoRequest payload = SendVideoRequest + { + _video_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) + , _video_video :: payload -- ^ Video to send. You can either pass a file_id as String to resend a video that is already on the Telegram servers, or upload a new video. + , _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 Text) where + toJSON = toJsonDrop 7 + +instance FromJSON (SendVideoRequest Text) where + parseJSON = parseJsonDrop 7 + +instance ToMultipartFormData (SendVideoRequest FileUpload) where + toMultipartFormData req = + [ utf8Part "chat_id" (_video_chat_id req) ] ++ + catMaybes + [ partLBS "duration" . encode <$> _video_duration req + , utf8Part "caption" <$> _video_caption req + , partLBS "disable_notification" . encode <$> _video_disable_notification req + , utf8Part "reply_to_message_id" . T.pack . show <$> _video_reply_to_message_id req + , partLBS "reply_markup" . encode <$> _video_reply_markup req + ] ++ + [ fileUploadToPart "video" (_video_video req) ] + +sendVideoRequest :: Text -> Text -> SendVideoRequest Text +sendVideoRequest chatId video = SendVideoRequest chatId video Nothing Nothing Nothing Nothing Nothing + +uploadVideoRequest :: Text -> FileUpload -> SendVideoRequest FileUpload +uploadVideoRequest chatId video = SendVideoRequest chatId video Nothing Nothing Nothing Nothing Nothing + +-- | This object represents request for 'sendVoice' +data SendVoiceRequest payload = SendVoiceRequest + { + _voice_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) + , _voice_voice :: payload -- ^ Audio file to send. You can either pass a file_id as String to resend an audio that is already on the Telegram servers, or upload a new audio file. + , _voice_caption :: Maybe Text -- ^ Voice message caption, 0-200 characters + , _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 Text) where + toJSON = toJsonDrop 7 + +instance FromJSON (SendVoiceRequest Text) where + parseJSON = parseJsonDrop 7 + +instance ToMultipartFormData (SendVoiceRequest FileUpload) where + toMultipartFormData req = + [ utf8Part "chat_id" (_voice_chat_id req) ] ++ + catMaybes + [ partLBS "duration" . encode <$> _voice_duration req + , partLBS "disable_notification" . encode <$> _voice_disable_notification req + , utf8Part "reply_to_message_id" . T.pack . show <$> _voice_reply_to_message_id req + , partLBS "reply_markup" . encode <$> _voice_reply_markup req + ] ++ + [ fileUploadToPart "voice" (_voice_voice req) ] + +sendVoiceRequest :: Text -> Text -> SendVoiceRequest Text +sendVoiceRequest chatId voice = SendVoiceRequest chatId voice Nothing Nothing Nothing Nothing Nothing + +uploadVoiceRequest :: Text -> FileUpload -> SendVoiceRequest FileUpload +uploadVoiceRequest chatId voice = SendVoiceRequest chatId voice Nothing 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 = SendChatActionRequest + +-- | This object represents request for 'sendGame' +data SendGameRequest = SendGameRequest + { + game_chat_id :: Text -- ^ Unique identifier for the target chat + , game_game_short_name :: Text -- ^ Short name of the game, serves as the unique identifier for the game. Set up your games via Botfather. + , game_disable_notification :: Maybe Bool -- ^ Sends the message silently. iOS users will not receive a notification, Android users will receive a notification with no sound. + , game_reply_to_message_id :: Maybe Int -- ^ If the message is a reply, ID of the original message + , game_reply_markup :: Maybe InlineKeyboardMarkup -- ^ A JSON-serialized object for an inline keyboard. If empty, one ‘Play game_title’ button will be shown. If not empty, the first button must launch the game. + } deriving (Show, Generic) + +instance ToJSON SendGameRequest where + toJSON = toJsonDrop 5 + +instance FromJSON SendGameRequest where + parseJSON = parseJsonDrop 5 + +sendGameRequest :: Text -> Text -> SendGameRequest +sendGameRequest chatId shortName = SendGameRequest chatId shortName Nothing Nothing Nothing + +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. + , cq_url :: Maybe Text -- ^ URL that will be opened by the user's client. If you have created a `Game` and accepted the conditions via `@Botfather`, specify the URL that opens your game – note that this will only work if the query comes from a `callback_game` button. Otherwise, you may use links like telegram.me/your_bot?start=XXXX that open your bot with a parameter. + , cq_cache_time :: Maybe Int -- ^ The maximum amount of time in seconds that the result of the callback query may be cached client-side. Telegram apps will support caching starting in version 3.14. Defaults to 0. + } deriving (Show, Generic) + +instance ToJSON AnswerCallbackQueryRequest where + toJSON = toJsonDrop 3 + +instance FromJSON AnswerCallbackQueryRequest where + parseJSON = parseJsonDrop 3 + +answerCallbackQueryRequest :: Text -> AnswerCallbackQueryRequest +answerCallbackQueryRequest queryId = AnswerCallbackQueryRequest queryId Nothing Nothing Nothing Nothing + +data ReplyKeyboard = + -- | This object represents a custom keyboard with reply options + ReplyInlineKeyboardMarkup + { + reply_inline_keyboard :: [[InlineKeyboardButton]] -- ^ Array of button rows, each represented by an Array of InlineKeyboardButton objects + } + | 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. + } + | ReplyKeyboardRemove + { + reply_remove_keyboard :: Bool -- ^ Requests clients to remove the custom keyboard (user will not be able to summon this keyboard; if you want to hide the keyboard from sight but keep it accessible, use one_time_keyboard in 'ReplyKeyboardMarkup') + , 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 + +inlineKeyboardMarkup :: [[InlineKeyboardButton]] -> ReplyKeyboard +inlineKeyboardMarkup = ReplyInlineKeyboardMarkup + +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 diff --git a/src/Web/Telegram/API/Bot/Responses.hs b/src/Web/Telegram/API/Bot/Responses.hs --- a/src/Web/Telegram/API/Bot/Responses.hs +++ b/src/Web/Telegram/API/Bot/Responses.hs @@ -1,77 +1,92 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE OverloadedStrings #-} - --- | This module contains responses from Telegram Bot API -module Web.Telegram.API.Bot.Responses - ( -- * Types - Response (..) - , GetMeResponse - , MessageResponse - , ChatActionResponse - , UpdatesResponse - , FileResponse - , UserProfilePhotosResponse - , SetWebhookResponse - , InlineQueryResponse - , CallbackQueryResponse - , KickChatMemberResponse - , LeaveChatResponse - , UnbanChatMemberResponse - , GetChatResponse - , GetChatAdministratorsResponse - , GetChatMembersCountResponse - , GetChatMemberResponse - ) where - -import Data.Aeson -import GHC.Generics -import Web.Telegram.API.Bot.Data - -data Response a = Response - { - result :: a - } deriving (Show, Generic, FromJSON) - --- | This object represents 'getMe' response -type GetMeResponse = Response User - --- | This object represents message response -type MessageResponse = Response Message - --- | This object represents 'sendChatAction' response -type ChatActionResponse = Response Bool - --- | This object represents 'getUpdates' response -type UpdatesResponse = Response [Update] - --- | This object represents file response -type FileResponse = Response File - --- | This object represents user profile photos response -type UserProfilePhotosResponse = Response UserProfilePhotos - --- | This object represents 'setWebhook' response -type SetWebhookResponse = Response Bool - --- | This object represents 'answerInlineQuery' response -type InlineQueryResponse = Response Bool - --- | This object represents 'answerCallbackQuery' response -type CallbackQueryResponse = Response Bool - --- | This object represents 'kickChatMember' response -type KickChatMemberResponse = Response Bool - -type LeaveChatResponse = Response Bool - --- | This object represents 'unbanChatMember' response -type UnbanChatMemberResponse = Response Bool - -type GetChatResponse = Response Chat - -type GetChatAdministratorsResponse = Response [ChatMember] - -type GetChatMembersCountResponse = Response Int - -type GetChatMemberResponse = Response ChatMember +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | This module contains responses from Telegram Bot API +module Web.Telegram.API.Bot.Responses + ( -- * Types + Response (..) + , ResponseParameters (..) + , GetMeResponse + , MessageResponse + , ChatActionResponse + , UpdatesResponse + , FileResponse + , UserProfilePhotosResponse + , SetWebhookResponse + , InlineQueryResponse + , CallbackQueryResponse + , KickChatMemberResponse + , LeaveChatResponse + , UnbanChatMemberResponse + , GetChatResponse + , GetChatAdministratorsResponse + , GetChatMembersCountResponse + , GetChatMemberResponse + , GetWebhookInfoResponse + ) where + +import Data.Aeson +import GHC.Generics +import Web.Telegram.API.Bot.Data +import Web.Telegram.API.Bot.JsonExt + +data Response a = Response + { + result :: a + , parameters :: Maybe ResponseParameters + } deriving (Show, Generic, FromJSON) + +data ResponseParameters = ResponseParameters + { + res_migrate_to_chat_id :: Maybe Int -- ^ The group has been migrated to a supergroup with the specified identifier. This number may be greater than 32 bits and some programming languages may have difficulty/silent defects in interpreting it. But it is smaller than 52 bits, so a signed 64 bit integer or double-precision float type are safe for storing this identifier. + , res_retry_after :: Maybe Int -- ^ In case of exceeding flood control, the number of seconds left to wait before the request can be repeated + } deriving (Show, Generic) + +instance FromJSON ResponseParameters where + parseJSON = parseJsonDrop 4 + +-- | This object represents 'getMe' response +type GetMeResponse = Response User + +-- | This object represents message response +type MessageResponse = Response Message + +-- | This object represents 'sendChatAction' response +type ChatActionResponse = Response Bool + +-- | This object represents 'getUpdates' response +type UpdatesResponse = Response [Update] + +-- | This object represents file response +type FileResponse = Response File + +-- | This object represents user profile photos response +type UserProfilePhotosResponse = Response UserProfilePhotos + +-- | This object represents 'setWebhook' response +type SetWebhookResponse = Response Bool + +-- | This object represents 'answerInlineQuery' response +type InlineQueryResponse = Response Bool + +-- | This object represents 'answerCallbackQuery' response +type CallbackQueryResponse = Response Bool + +-- | This object represents 'kickChatMember' response +type KickChatMemberResponse = Response Bool + +type LeaveChatResponse = Response Bool + +-- | This object represents 'unbanChatMember' response +type UnbanChatMemberResponse = Response Bool + +type GetChatResponse = Response Chat + +type GetChatAdministratorsResponse = Response [ChatMember] + +type GetChatMembersCountResponse = Response Int + +type GetChatMemberResponse = Response ChatMember + +type GetWebhookInfoResponse = Response WebhookInfo diff --git a/telegram-api.cabal b/telegram-api.cabal --- a/telegram-api.cabal +++ b/telegram-api.cabal @@ -1,82 +1,82 @@ -name: telegram-api -version: 0.5.1.2 -synopsis: Telegram Bot API bindings -description: High-level bindings to the Telegram Bot API -homepage: http://github.com/klappvisor/haskell-telegram-api#readme -license: BSD3 -license-file: LICENSE -author: Alexey Rodiontsev -maintainer: alex.rodiontsev@gmail.com -copyright: Alexey Rodiontsev (c) 2016 -category: Web -build-type: Simple --- extra-source-files: -cabal-version: >=1.10 -data-files: test-data/christmas-cat.jpg - , test-data/cert.pem - , test-data/haskell-logo.webp - , test-data/lego-video.mp4 - , test-data/Possible_PDM_signal_labeled_as_Sputnik_by_NASA.ogg - , test-data/concerto-for-2-trumpets-in-c-major.mp3 - , test-data/wikipedia-telegram.txt - -extra-source-files: - README.md - CHANGELOG.md - -library - hs-source-dirs: src - exposed-modules: Web.Telegram.API.Bot - , Web.Telegram.API.Bot.API - , Web.Telegram.API.Bot.Data - , Web.Telegram.API.Bot.Responses - , Web.Telegram.API.Bot.Requests - other-modules: Web.Telegram.API.Bot.JsonExt - , Servant.Client.MultipartFormData - build-depends: base >= 4.7 && < 5 - , aeson == 1.0.* - , http-api-data - , http-client >= 0.5 && < 0.6 - , servant >= 0.9 && <0.10 - , servant-client >= 0.9 && <0.10 - , mtl >= 2.2 && < 2.3 - , text - , transformers - , http-media - , http-types - , mime-types - , bytestring - , string-conversions - default-language: Haskell2010 - ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-binds - -test-suite telegram-api-test - type: exitcode-stdio-1.0 - hs-source-dirs: test - main-is: Spec.hs - other-modules: MainSpec - , InlineSpec - , JsonSpec - build-depends: base - , aeson == 1.0.* - , hjpath - , ansi-wl-pprint - , http-client >= 0.5 && < 0.6 - , http-client-tls - , http-types - , hspec - , optparse-applicative - , servant >= 0.9 && <0.10 - , servant-client >= 0.9 && <0.10 - , telegram-api - , http-types - , filepath - , text - , transformers - , utf8-string - ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -fno-warn-name-shadowing - default-language: Haskell2010 - -source-repository head - type: git - location: https://github.com/klappvisor/haskell-telegram-api +name: telegram-api +version: 0.5.2.0 +synopsis: Telegram Bot API bindings +description: High-level bindings to the Telegram Bot API +homepage: http://github.com/klappvisor/haskell-telegram-api#readme +license: BSD3 +license-file: LICENSE +author: Alexey Rodiontsev +maintainer: alex.rodiontsev@gmail.com +copyright: Alexey Rodiontsev (c) 2016 +category: Web +build-type: Simple +-- extra-source-files: +cabal-version: >=1.10 +data-files: test-data/christmas-cat.jpg + , test-data/cert.pem + , test-data/haskell-logo.webp + , test-data/lego-video.mp4 + , test-data/Possible_PDM_signal_labeled_as_Sputnik_by_NASA.ogg + , test-data/concerto-for-2-trumpets-in-c-major.mp3 + , test-data/wikipedia-telegram.txt + +extra-source-files: + README.md + CHANGELOG.md + +library + hs-source-dirs: src + exposed-modules: Web.Telegram.API.Bot + , Web.Telegram.API.Bot.API + , Web.Telegram.API.Bot.Data + , Web.Telegram.API.Bot.Responses + , Web.Telegram.API.Bot.Requests + other-modules: Web.Telegram.API.Bot.JsonExt + , Servant.Client.MultipartFormData + build-depends: base >= 4.7 && < 5 + , aeson == 1.0.* + , http-api-data + , http-client >= 0.5 && < 0.6 + , servant >= 0.9 && <0.10 + , servant-client >= 0.9 && <0.10 + , mtl >= 2.2 && < 2.3 + , text + , transformers + , http-media + , http-types + , mime-types + , bytestring + , string-conversions + default-language: Haskell2010 + ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-binds + +test-suite telegram-api-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + other-modules: MainSpec + , InlineSpec + , JsonSpec + build-depends: base + , aeson == 1.0.* + , hjpath + , ansi-wl-pprint + , http-client >= 0.5 && < 0.6 + , http-client-tls + , http-types + , hspec + , optparse-applicative + , servant >= 0.9 && <0.10 + , servant-client >= 0.9 && <0.10 + , telegram-api + , http-types + , filepath + , text + , transformers + , utf8-string + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -fno-warn-name-shadowing + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/klappvisor/haskell-telegram-api diff --git a/test-data/cert.pem b/test-data/cert.pem --- a/test-data/cert.pem +++ b/test-data/cert.pem @@ -1,22 +1,22 @@ ------BEGIN CERTIFICATE----- -MIIDqzCCApOgAwIBAgIJALwlJJK1qK3DMA0GCSqGSIb3DQEBCwUAMGwxCzAJBgNV -BAYTAlVTMREwDwYDVQQIDAhOZXcgWW9yazERMA8GA1UEBwwIQnJvb2tseW4xITAf -BgNVBAoMGEV4YW1wbGUgQnJvb2tseW4gQ29tcGFueTEUMBIGA1UEAwwLZXhhbXBs -ZS5jb20wHhcNMTYwNzA5MTMyMzMxWhcNMTcwNzA5MTMyMzMxWjBsMQswCQYDVQQG -EwJVUzERMA8GA1UECAwITmV3IFlvcmsxETAPBgNVBAcMCEJyb29rbHluMSEwHwYD -VQQKDBhFeGFtcGxlIEJyb29rbHluIENvbXBhbnkxFDASBgNVBAMMC2V4YW1wbGUu -Y29tMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA2NmLUaOzaUC/OE29 -hMkraWcCUu3EKVTQK8xF0CGEoOSE4kGSELT7i9o8eFRaEYeYoM5dI27VSAM1L7nO -11y1vp08XOMaN8mNKl12FlxCdV6UCb0aIjOFxqYbWnLyEW8b8lOnnX21cLI1fDsn -lO2OSpZXBhOhttG5u6JOhnyu2tWBu8rAjm/0DV7wgxJKqR/yLe5purWjAoRpKFEf -hXloN7LTLlb30xmVlVE7VR3dpK44LfXaW1hBfZRlAalwmpgl9+BW0b4Fyj+OKyyx -X9XpbSYbv2N8l7fRpI/UjNzoand2EVGUPy1WOnoVjHNWkqbpgkAYWeBXZorTyGh4 -Vf/uQwIDAQABo1AwTjAdBgNVHQ4EFgQUeyEkNLWp1//1Ko4iysRyRM9FeV8wHwYD -VR0jBBgwFoAUeyEkNLWp1//1Ko4iysRyRM9FeV8wDAYDVR0TBAUwAwEB/zANBgkq -hkiG9w0BAQsFAAOCAQEASQ5idy2Ii3MfL38aHhc/cblgJ9SU3anKuOMnW3dDjlle -MLVpf09ccWsaObLAp3CNLgf/KdWVIZUSHUX37fNgy1IMVUcEKdl1U9nrsH47IwAn -kNZ1uBROhcW+Vf1jzrxFkHd81eGmkqQseE+uqKpiHpiAvSPYPhBNgOf6xOSS57PG -Q5pMoUTdZytJsOzRPzNDkJ32BXE/ysm39wnWyk1rz7AJudDnxMKg6bsjBPApKs7I -ktTY3d0/NJ9Ie2TB7OISQtPWwo5iSrFeBoBDo0ybuCVVBVYo0YPUdcwMIPO8pH3z -N6kaYyC1G67cCmLp4lOuvOKKKkrRgmscZht9aoNCFw== +-----BEGIN CERTIFICATE----- +MIIDqzCCApOgAwIBAgIJALwlJJK1qK3DMA0GCSqGSIb3DQEBCwUAMGwxCzAJBgNV +BAYTAlVTMREwDwYDVQQIDAhOZXcgWW9yazERMA8GA1UEBwwIQnJvb2tseW4xITAf +BgNVBAoMGEV4YW1wbGUgQnJvb2tseW4gQ29tcGFueTEUMBIGA1UEAwwLZXhhbXBs +ZS5jb20wHhcNMTYwNzA5MTMyMzMxWhcNMTcwNzA5MTMyMzMxWjBsMQswCQYDVQQG +EwJVUzERMA8GA1UECAwITmV3IFlvcmsxETAPBgNVBAcMCEJyb29rbHluMSEwHwYD +VQQKDBhFeGFtcGxlIEJyb29rbHluIENvbXBhbnkxFDASBgNVBAMMC2V4YW1wbGUu +Y29tMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA2NmLUaOzaUC/OE29 +hMkraWcCUu3EKVTQK8xF0CGEoOSE4kGSELT7i9o8eFRaEYeYoM5dI27VSAM1L7nO +11y1vp08XOMaN8mNKl12FlxCdV6UCb0aIjOFxqYbWnLyEW8b8lOnnX21cLI1fDsn +lO2OSpZXBhOhttG5u6JOhnyu2tWBu8rAjm/0DV7wgxJKqR/yLe5purWjAoRpKFEf +hXloN7LTLlb30xmVlVE7VR3dpK44LfXaW1hBfZRlAalwmpgl9+BW0b4Fyj+OKyyx +X9XpbSYbv2N8l7fRpI/UjNzoand2EVGUPy1WOnoVjHNWkqbpgkAYWeBXZorTyGh4 +Vf/uQwIDAQABo1AwTjAdBgNVHQ4EFgQUeyEkNLWp1//1Ko4iysRyRM9FeV8wHwYD +VR0jBBgwFoAUeyEkNLWp1//1Ko4iysRyRM9FeV8wDAYDVR0TBAUwAwEB/zANBgkq +hkiG9w0BAQsFAAOCAQEASQ5idy2Ii3MfL38aHhc/cblgJ9SU3anKuOMnW3dDjlle +MLVpf09ccWsaObLAp3CNLgf/KdWVIZUSHUX37fNgy1IMVUcEKdl1U9nrsH47IwAn +kNZ1uBROhcW+Vf1jzrxFkHd81eGmkqQseE+uqKpiHpiAvSPYPhBNgOf6xOSS57PG +Q5pMoUTdZytJsOzRPzNDkJ32BXE/ysm39wnWyk1rz7AJudDnxMKg6bsjBPApKs7I +ktTY3d0/NJ9Ie2TB7OISQtPWwo5iSrFeBoBDo0ybuCVVBVYo0YPUdcwMIPO8pH3z +N6kaYyC1G67cCmLp4lOuvOKKKkrRgmscZht9aoNCFw== -----END CERTIFICATE----- diff --git a/test-data/wikipedia-telegram.txt b/test-data/wikipedia-telegram.txt --- a/test-data/wikipedia-telegram.txt +++ b/test-data/wikipedia-telegram.txt @@ -1,7 +1,7 @@ -From the English Wikipedia about Telegram, -https://en.wikipedia.org/wiki/Telegram_(software) - -Telegram is a cloud-based instant messaging service. Telegram clients exist for both mobile (Android, iOS, Windows Phone, Ubuntu Touch) and desktop systems (Windows, OS X, Linux). Users can send messages and exchange photos, videos, stickers and files of any type. Telegram also provides optional end-to-end encrypted messaging with self-destruct timers, but Telegram's implementation of these features has been contested by security researchers and cryptography experts. - -Telegram is supported by the Russian-born entrepreneur Pavel Durov, who is now a citizen of Saint Kitts and Nevis, travelling the world in self-imposed exile. Its client-side code is open-source software, whereas its server-side code is closed-sourced and proprietary. The service also provides APIs to independent developers. - +From the English Wikipedia about Telegram, +https://en.wikipedia.org/wiki/Telegram_(software) + +Telegram is a cloud-based instant messaging service. Telegram clients exist for both mobile (Android, iOS, Windows Phone, Ubuntu Touch) and desktop systems (Windows, OS X, Linux). Users can send messages and exchange photos, videos, stickers and files of any type. Telegram also provides optional end-to-end encrypted messaging with self-destruct timers, but Telegram's implementation of these features has been contested by security researchers and cryptography experts. + +Telegram is supported by the Russian-born entrepreneur Pavel Durov, who is now a citizen of Saint Kitts and Nevis, travelling the world in self-imposed exile. Its client-side code is open-source software, whereas its server-side code is closed-sourced and proprietary. The service also provides APIs to independent developers. + diff --git a/test/InlineSpec.hs b/test/InlineSpec.hs --- a/test/InlineSpec.hs +++ b/test/InlineSpec.hs @@ -1,53 +1,53 @@ -{-# LANGUAGE OverloadedStrings #-} - -module InlineSpec (spec) where - -import Web.Telegram.API.Bot -import Test.Hspec -import Data.Text (Text) -import Network.HTTP.Client (newManager) -import Network.HTTP.Client.TLS (tlsManagerSettings) - -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 Response { result = res } <- - answerInlineQuery token (answerInlineQueryRequest inline_query_id [inline_article]) manager - res `shouldBe` True - it "should answer with photo" $ do - Right Response { result = res } <- - answerInlineQuery token (answerInlineQueryRequest inline_query_id [inline_photo]) manager - res `shouldBe` True - it "should answer with gif" $ do - Right Response { result = res } <- - answerInlineQuery token (answerInlineQueryRequest inline_query_id [inline_gif]) manager - res `shouldBe` True - it "should answer with mpeg gif" $ do - Right Response { result = res } <- - answerInlineQuery token (answerInlineQueryRequest inline_query_id [inline_mpeg]) manager - res `shouldBe` True - it "should answer with video" $ do - Right Response { result = res } <- - answerInlineQuery token (answerInlineQueryRequest inline_query_id [inline_video]) manager - res `shouldBe` True - - describe "/answerInlineQuery" $ - it "should get updates and answer" $ do - Right Response { result = updates} <- - getUpdates token Nothing Nothing Nothing manager - Update { inline_query = Just (InlineQuery { query_id = id } ) } <- pure (last updates) - e <- - answerInlineQuery token (answerInlineQueryRequest id [inline_video]) manager - putStrLn (show e) - -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 +{-# LANGUAGE OverloadedStrings #-} + +module InlineSpec (spec) where + +import Web.Telegram.API.Bot +import Test.Hspec +import Data.Text (Text) +import Network.HTTP.Client (newManager) +import Network.HTTP.Client.TLS (tlsManagerSettings) + +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 Response { result = res } <- + answerInlineQuery token (answerInlineQueryRequest inline_query_id [inline_article]) manager + res `shouldBe` True + it "should answer with photo" $ do + Right Response { result = res } <- + answerInlineQuery token (answerInlineQueryRequest inline_query_id [inline_photo]) manager + res `shouldBe` True + it "should answer with gif" $ do + Right Response { result = res } <- + answerInlineQuery token (answerInlineQueryRequest inline_query_id [inline_gif]) manager + res `shouldBe` True + it "should answer with mpeg gif" $ do + Right Response { result = res } <- + answerInlineQuery token (answerInlineQueryRequest inline_query_id [inline_mpeg]) manager + res `shouldBe` True + it "should answer with video" $ do + Right Response { result = res } <- + answerInlineQuery token (answerInlineQueryRequest inline_query_id [inline_video]) manager + res `shouldBe` True + + describe "/answerInlineQuery" $ + it "should get updates and answer" $ do + Right Response { result = updates} <- + getUpdates token Nothing Nothing Nothing manager + Update { inline_query = Just (InlineQuery { query_id = id } ) } <- pure (last updates) + e <- + answerInlineQuery token (answerInlineQueryRequest id [inline_video]) manager + putStrLn (show e) + +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 diff --git a/test/JsonSpec.hs b/test/JsonSpec.hs --- a/test/JsonSpec.hs +++ b/test/JsonSpec.hs @@ -1,109 +1,109 @@ -{-# LANGUAGE OverloadedStrings #-} - -module JsonSpec (spec) where - -import Web.Telegram.API.Bot -import Test.Hspec -import qualified Data.Text as T -import Data.Aeson.Encode -import Text.JSON.JPath -import Data.ByteString.Lazy.UTF8 - -spec :: Spec -spec = do - let getType q = jPath (T.unpack "type") (toString (encode q)) - describe "type of serialized inline query result" $ do - it "should be article" $ - getType iq_article `shouldBe` ["\"article\""] - it "should be photo" $ - getType iq_photo `shouldBe` ["\"photo\""] - it "should be gif" $ - getType iq_gif `shouldBe` ["\"gif\""] - it "should be mpeg4_gif" $ - getType iq_mpeg `shouldBe` ["\"mpeg4_gif\""] - it "should be video" $ - getType iq_video `shouldBe` ["\"video\""] - it "should be audio" $ - getType iq_audio `shouldBe` ["\"audio\""] - it "should be contact" $ - getType iq_contact `shouldBe` ["\"contact\""] - it "should be document" $ - getType iq_document `shouldBe` ["\"document\""] - it "should be location" $ - getType iq_location `shouldBe` ["\"location\""] - it "should be venue" $ - getType iq_venue `shouldBe` ["\"venue\""] - describe "type of serialized cached inline query result" $ do - it "should be audio" $ - getType cached_audio `shouldBe` ["\"audio\""] - it "should be voice" $ - getType cached_voice `shouldBe` ["\"voice\""] - it "should be video" $ - getType cached_video `shouldBe` ["\"video\""] - it "should be document" $ - getType cached_doc `shouldBe` ["\"document\""] - it "should be sticker" $ - getType cached_sticker `shouldBe` ["\"sticker\""] - it "should be mpeg4_gif" $ - getType cached_mpeg `shouldBe` ["\"mpeg4_gif\""] - it "should be gif" $ - getType cached_gif `shouldBe` ["\"gif\""] - it "should be photo" $ - getType cached_photo `shouldBe` ["\"photo\""] - -message_content :: InputMessageContent -message_content = InputTextMessageContent "test message content" Nothing Nothing - -iq_article :: InlineQueryResult -iq_article = inlineQueryResultArticle "" "text article content" message_content - -iq_photo :: InlineQueryResult -iq_photo = inlineQueryResultPhoto "" "" "" - -iq_gif :: InlineQueryResult -iq_gif = inlineQueryResultGif "" "" "" - -iq_mpeg :: InlineQueryResult -iq_mpeg = inlineQueryResultMpeg4Gif "" "" "" - -iq_video :: InlineQueryResult -iq_video = inlineQueryResultVideo "" "" "video/mpeg" "" "" - -iq_audio :: InlineQueryResult -iq_audio = inlineQueryResultAudio "" "" "" - -iq_contact :: InlineQueryResult -iq_contact = inlineQueryResultContact "" "" "" - -iq_document :: InlineQueryResult -iq_document = inlineQueryResultDocument "" "" "" "" - -iq_location :: InlineQueryResult -iq_location = inlineQueryResultLocation "" 0.0 0.0 "" - -iq_venue :: InlineQueryResult -iq_venue = inlineQueryResultVenue "" 0.0 0.0 "" "" - -cached_audio :: InlineQueryResult -cached_audio = inlineQueryResultCachedAudio "" "" - -cached_voice :: InlineQueryResult -cached_voice = inlineQueryResultCachedVoice "" "" "" - -cached_video :: InlineQueryResult -cached_video = inlineQueryResultCachedVideo "" "" "" - -cached_doc :: InlineQueryResult -cached_doc = inlineQueryResultCachedDocument "" "" "" - -cached_sticker :: InlineQueryResult -cached_sticker = inlineQueryResultCachedSticker "" "" - -cached_mpeg :: InlineQueryResult -cached_mpeg = inlineQueryResultCachedMpeg4Gif "" "" - -cached_gif :: InlineQueryResult -cached_gif = inlineQueryResultCachedGif "" "" - -cached_photo :: InlineQueryResult -cached_photo = inlineQueryResultCachedPhoto "" "" +{-# LANGUAGE OverloadedStrings #-} + +module JsonSpec (spec) where + +import Web.Telegram.API.Bot +import Test.Hspec +import qualified Data.Text as T +import Data.Aeson +import Text.JSON.JPath +import Data.ByteString.Lazy.UTF8 + +spec :: Spec +spec = do + let getType q = jPath (T.unpack "type") (toString (encode q)) + describe "type of serialized inline query result" $ do + it "should be article" $ + getType iq_article `shouldBe` ["\"article\""] + it "should be photo" $ + getType iq_photo `shouldBe` ["\"photo\""] + it "should be gif" $ + getType iq_gif `shouldBe` ["\"gif\""] + it "should be mpeg4_gif" $ + getType iq_mpeg `shouldBe` ["\"mpeg4_gif\""] + it "should be video" $ + getType iq_video `shouldBe` ["\"video\""] + it "should be audio" $ + getType iq_audio `shouldBe` ["\"audio\""] + it "should be contact" $ + getType iq_contact `shouldBe` ["\"contact\""] + it "should be document" $ + getType iq_document `shouldBe` ["\"document\""] + it "should be location" $ + getType iq_location `shouldBe` ["\"location\""] + it "should be venue" $ + getType iq_venue `shouldBe` ["\"venue\""] + describe "type of serialized cached inline query result" $ do + it "should be audio" $ + getType cached_audio `shouldBe` ["\"audio\""] + it "should be voice" $ + getType cached_voice `shouldBe` ["\"voice\""] + it "should be video" $ + getType cached_video `shouldBe` ["\"video\""] + it "should be document" $ + getType cached_doc `shouldBe` ["\"document\""] + it "should be sticker" $ + getType cached_sticker `shouldBe` ["\"sticker\""] + it "should be mpeg4_gif" $ + getType cached_mpeg `shouldBe` ["\"mpeg4_gif\""] + it "should be gif" $ + getType cached_gif `shouldBe` ["\"gif\""] + it "should be photo" $ + getType cached_photo `shouldBe` ["\"photo\""] + +message_content :: InputMessageContent +message_content = InputTextMessageContent "test message content" Nothing Nothing + +iq_article :: InlineQueryResult +iq_article = inlineQueryResultArticle "" "text article content" message_content + +iq_photo :: InlineQueryResult +iq_photo = inlineQueryResultPhoto "" "" "" + +iq_gif :: InlineQueryResult +iq_gif = inlineQueryResultGif "" "" "" + +iq_mpeg :: InlineQueryResult +iq_mpeg = inlineQueryResultMpeg4Gif "" "" "" + +iq_video :: InlineQueryResult +iq_video = inlineQueryResultVideo "" "" "video/mpeg" "" "" + +iq_audio :: InlineQueryResult +iq_audio = inlineQueryResultAudio "" "" "" + +iq_contact :: InlineQueryResult +iq_contact = inlineQueryResultContact "" "" "" + +iq_document :: InlineQueryResult +iq_document = inlineQueryResultDocument "" "" "" "" + +iq_location :: InlineQueryResult +iq_location = inlineQueryResultLocation "" 0.0 0.0 "" + +iq_venue :: InlineQueryResult +iq_venue = inlineQueryResultVenue "" 0.0 0.0 "" "" + +cached_audio :: InlineQueryResult +cached_audio = inlineQueryResultCachedAudio "" "" + +cached_voice :: InlineQueryResult +cached_voice = inlineQueryResultCachedVoice "" "" "" + +cached_video :: InlineQueryResult +cached_video = inlineQueryResultCachedVideo "" "" "" + +cached_doc :: InlineQueryResult +cached_doc = inlineQueryResultCachedDocument "" "" "" + +cached_sticker :: InlineQueryResult +cached_sticker = inlineQueryResultCachedSticker "" "" + +cached_mpeg :: InlineQueryResult +cached_mpeg = inlineQueryResultCachedMpeg4Gif "" "" + +cached_gif :: InlineQueryResult +cached_gif = inlineQueryResultCachedGif "" "" + +cached_photo :: InlineQueryResult +cached_photo = inlineQueryResultCachedPhoto "" "" diff --git a/test/MainSpec.hs b/test/MainSpec.hs --- a/test/MainSpec.hs +++ b/test/MainSpec.hs @@ -1,302 +1,322 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} - -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 Network.HTTP.Types.Status -import System.FilePath -import Control.Concurrent - -import Paths_telegram_api - --- to print out remote response if response success not match -success, nosuccess :: (Show a, Show b) =>Either a b ->Expectation -success e = e `shouldSatisfy` isRight -nosuccess e = e `shouldSatisfy` isLeft - -spec :: Token -> Text -> Text -> Spec -spec token chatId botName = do - manager <- runIO $ newManager tlsManagerSettings - dataDir <- runIO getDataDir - let testFile name = dataDir "test-data" name - describe "/getMe" $ - it "responds with correct bot's name" $ do - Right Response { result = u } <- - 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") manager - success res - let Right Response { result = m } = res - text m `shouldBe` Just "test message" - - it "should return error message" $ do - 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 - 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 Response { result = m } = res - text m `shouldBe` Just "text bold italic github" - - it "should set keyboard" $ do - 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 Response { result = m } = res - text m `shouldBe` Just "set keyboard" - - it "should remove keyboard" $ do - let message = (sendMessageRequest chatId "remove keyboard") { - message_reply_markup = Just replyKeyboardHide - } - res <- sendMessage token message manager - success res - let Right Response { result = m } = res - text m `shouldBe` Just "remove keyboard" - - it "should send message with inline keyboard" $ do - let kbA = (inlineKeyboardButton "A") { ikb_callback_data = Just "A" } - kbB = (inlineKeyboardButton "B") { ikb_callback_data = Just "B" } - kbC = (inlineKeyboardButton "C") { ikb_callback_data = Just "C" } - let message = (sendMessageRequest chatId "set inline keyboard") { - message_reply_markup = Just $ inlineKeyboardMarkup [[kbA, kbB, kbC]] - } - res <- sendMessage token message manager - success res - let Right Response { result = m } = res - text m `shouldBe` Just "set inline keyboard" - - it "should force reply" $ do - let message = (sendMessageRequest chatId "force reply") { - message_reply_markup = Just forceReply - } - res <- sendMessage token message manager - success res - let Right Response { result = m } = res - text m `shouldBe` Just "force reply" - - describe "/forwardMessage" $ - it "should forward message" $ do - 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 - 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 upload photo and resend it by id" $ do - let fileUpload = localFileUpload (testFile "christmas-cat.jpg") - let upload = (uploadPhotoRequest chatId fileUpload) { - photo_caption = Just "uploaded photo" - } - Right Response { 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 Response { result = Message { caption = Just cpt } } <- - 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 audio manager - msg `shouldBe` "Bad Request" - it "should upload audio and resend it by id" $ do - let fileUpload = localFileUpload (testFile "concerto-for-2-trumpets-in-c-major.mp3") - audioTitle = "Concerto for 2 Trumpets in C major, RV. 537 (Rondeau arr.) All." - audioPerformer = "Michel Rondeau" - audio = (uploadAudioRequest chatId fileUpload) { _audio_performer = Just audioPerformer, _audio_title = Just audioTitle } - Right Response { result = Message { audio = Just Audio { audio_file_id = file_id, audio_title = Just title, audio_performer = Just performer } } } <- - uploadAudio token audio manager - title `shouldBe` audioTitle - performer `shouldBe` audioPerformer - let audio = sendAudioRequest chatId file_id - Right Response { result = Message { audio = Just Audio { audio_title = Just title' } } } <- - sendAudio token audio manager - title' `shouldBe` audioTitle - - describe "/sendSticker" $ do - it "should send sticker" $ do - let sticker = sendStickerRequest chatId "BQADAgADGgADkWgMAAGXlYGBiM_d2wI" - Right Response { result = Message { sticker = Just sticker } } <- - sendSticker token sticker manager - sticker_file_id sticker `shouldBe` "BQADAgADGgADkWgMAAGXlYGBiM_d2wI" - it "should upload sticker" $ do - let fileUpload = localFileUpload (testFile "haskell-logo.webp") - stickerReq = uploadStickerRequest chatId fileUpload - Right Response { result = Message { sticker = Just sticker } } <- - uploadSticker token stickerReq manager - sticker_height sticker `shouldBe` 128 - - describe "/sendVoice" $ - it "should upload voice" $ do - -- audio source: https://commons.wikimedia.org/wiki/File:Possible_PDM_signal_labeled_as_Sputnik_by_NASA.ogg - let fileUpload = localFileUpload (testFile "Possible_PDM_signal_labeled_as_Sputnik_by_NASA.ogg") - voiceReq = (uploadVoiceRequest chatId fileUpload) { _voice_duration = Just 10 } - Right Response { result = Message { voice = Just voice } } <- - uploadVoice token voiceReq manager - voice_duration voice `shouldBe` 10 - - describe "/sendVideo" $ - it "should upload video" $ do - -- video source: http://techslides.com/sample-webm-ogg-and-mp4-video-files-for-html5 - let fileUpload = localFileUpload (testFile "lego-video.mp4") - videoReq = uploadVideoRequest chatId fileUpload - Right Response { result = Message { video = Just video } } <- - uploadVideo token videoReq manager - video_width video `shouldBe` 560 - - describe "/sendDocument" $ - it "should upload document" $ do - let fileUpload = localFileUpload (testFile "wikipedia-telegram.txt") - documentReq = uploadDocumentRequest chatId fileUpload - Right Response { result = Message { document = Just document } } <- - uploadDocument token documentReq manager - doc_mime_type document `shouldBe` Just "text/plain" - doc_file_name document `shouldBe` Just "wikipedia-telegram.txt" - - describe "/sendLocation" $ - it "should send location" $ do - let location = sendLocationRequest chatId 52.38 4.9 - Right Response { result = Message { location = Just loc } } <- - sendLocation token location manager - latitude loc `shouldSatisfy` liftM2 (&&) (> 52) (< 52.4) - longitude loc `shouldSatisfy` liftM2 (&&) (> 4.89) (< 5) - - describe "/sendVenue" $ - it "should send a venue" $ do - let venue = sendVenueRequest chatId 52.38 4.9 "Amsterdam Centraal" "Amsterdam" - Right Response { 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" $ - it "should send a contact" $ do - let contact = sendContactRequest chatId "06-18035176" "Hilbert" - Right Response { 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 Response { result = res} <- - sendChatAction token (SendChatActionRequest chatId Typing) manager - res `shouldBe` True - it "should set find location action" $ do - Right Response { result = res} <- - sendChatAction token (SendChatActionRequest chatId FindLocation) manager - res `shouldBe` True - it "should set upload photo action" $ do - Right Response { result = res} <- - sendChatAction token (SendChatActionRequest chatId UploadPhoto) manager - res `shouldBe` True - - describe "/getUpdates" $ - it "should get all messages" $ do - Right Response { result = updates} <- - getUpdates token Nothing Nothing Nothing manager - length updates `shouldSatisfy` (>= 0) - - describe "/getFile" $ do - it "should get file" $ do - Right Response { result = file } <- - 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" manager - msg `shouldBe` "Bad Request" - - describe "/getUserProfilePhotos" $ - it "should get user profile photos" $ do - Right Response { result = photos } <- - getUserProfilePhotos token (read (T.unpack chatId)) Nothing Nothing manager - total_count photos `shouldSatisfy` (>= 0) - - describe "/setWebhook" $ do - it "should set webhook with certificate" $ do - let cert = localFileUpload $ testFile "cert.pem" - req = SetWebhookRequest "https://example.com/secret_token" cert - res <- setWebhookWithCertificate token req manager - success res - let Right Response { result = val } = res - val `shouldBe` True - - it "should set webhook" $ do - threadDelay $ 2 * 1000 * 1000 - Right Response { result = res } <- - setWebhook token (Just "https://example.com/secret_token") manager - res `shouldBe` True - - it "should remove webhook" $ do - Right Response { result = res } <- - setWebhook token Nothing manager - res `shouldBe` True - - describe "/editTextMessage" $ do - it "should edit message" $ do - let originalMessage = sendMessageRequest chatId "veritas" - Right Response { result = Message { message_id = msg_id, text = Just txt } } <- - sendMessage token originalMessage manager - let editRequest = editMessageTextRequest chatId msg_id $ "edited " <> txt - Right Response { result = Message { text = txt' } } <- - editMessageText token editRequest manager - txt' `shouldBe` Just "edited veritas" - - it "should edit caption" $ do - let fileUpload = localFileUpload (testFile "christmas-cat.jpg") - let originalMessage = (uploadPhotoRequest chatId fileUpload) { - photo_caption = Just "cat picture" - } - Right Response { result = Message { message_id = msg_id, caption = Just cpt } } <- - uploadPhoto token originalMessage manager - let editRequest = editMessageCaptionRequest chatId msg_id $ Just $ "edited " <> cpt - Right Response { 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 +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} + +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 Network.HTTP.Types.Status +import System.FilePath +import Control.Concurrent + +import Paths_telegram_api + +-- to print out remote response if response success not match +success, nosuccess :: (Show a, Show b) =>Either a b ->Expectation +success e = e `shouldSatisfy` isRight +nosuccess e = e `shouldSatisfy` isLeft + +spec :: Token -> Text -> Text -> Spec +spec token chatId botName = do + manager <- runIO $ newManager tlsManagerSettings + dataDir <- runIO getDataDir + let testFile name = dataDir "test-data" name + describe "/getMe" $ + it "responds with correct bot's name" $ do + Right Response { result = u } <- + 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") manager + success res + let Right Response { result = m } = res + text m `shouldBe` Just "test message" + + it "should return error message" $ do + 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 + 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 Response { result = m } = res + text m `shouldBe` Just "text bold italic github" + + it "should set keyboard" $ do + 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 Response { result = m } = res + text m `shouldBe` Just "set keyboard" + + it "should remove keyboard" $ do + let message = (sendMessageRequest chatId "remove keyboard") { + message_reply_markup = Just replyKeyboardHide + } + res <- sendMessage token message manager + success res + let Right Response { result = m } = res + text m `shouldBe` Just "remove keyboard" + + it "should send message with inline keyboard" $ do + let kbA = (inlineKeyboardButton "A") { ikb_callback_data = Just "A" } + kbB = (inlineKeyboardButton "B") { ikb_callback_data = Just "B" } + kbC = (inlineKeyboardButton "C") { ikb_callback_data = Just "C" } + let message = (sendMessageRequest chatId "set inline keyboard") { + message_reply_markup = Just $ inlineKeyboardMarkup [[kbA, kbB, kbC]] + } + res <- sendMessage token message manager + success res + let Right Response { result = m } = res + text m `shouldBe` Just "set inline keyboard" + + it "should force reply" $ do + let message = (sendMessageRequest chatId "force reply") { + message_reply_markup = Just forceReply + } + res <- sendMessage token message manager + success res + let Right Response { result = m } = res + text m `shouldBe` Just "force reply" + + describe "/forwardMessage" $ + it "should forward message" $ do + 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 + 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 upload photo and resend it by id" $ do + let fileUpload = localFileUpload (testFile "christmas-cat.jpg") + let upload = (uploadPhotoRequest chatId fileUpload) { + photo_caption = Just "uploaded photo" + } + Right Response { 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 Response { result = Message { caption = Just cpt } } <- + 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 audio manager + msg `shouldBe` "Bad Request" + it "should upload audio and resend it by id" $ do + let fileUpload = localFileUpload (testFile "concerto-for-2-trumpets-in-c-major.mp3") + audioTitle = "Concerto for 2 Trumpets in C major, RV. 537 (Rondeau arr.) All." + audioPerformer = "Michel Rondeau" + audio = (uploadAudioRequest chatId fileUpload) { + _audio_performer = Just audioPerformer, + _audio_title = Just audioTitle + } + Right Response { + result = Message { + audio = Just Audio { + audio_file_id = file_id, audio_title = Just title, audio_performer = Just performer + } + } + } <- uploadAudio token audio manager + title `shouldBe` audioTitle + performer `shouldBe` audioPerformer + let audio = sendAudioRequest chatId file_id + Right Response { result = Message { audio = Just Audio { audio_title = Just title' } } } <- + sendAudio token audio manager + title' `shouldBe` audioTitle + + describe "/sendSticker" $ do + it "should send sticker" $ do + let sticker = sendStickerRequest chatId "BQADAgADGgADkWgMAAGXlYGBiM_d2wI" + Right Response { result = Message { sticker = Just sticker } } <- + sendSticker token sticker manager + sticker_file_id sticker `shouldBe` "BQADAgADGgADkWgMAAGXlYGBiM_d2wI" + it "should upload sticker" $ do + let fileUpload = localFileUpload (testFile "haskell-logo.webp") + stickerReq = uploadStickerRequest chatId fileUpload + Right Response { result = Message { sticker = Just sticker } } <- + uploadSticker token stickerReq manager + sticker_height sticker `shouldBe` 128 + + describe "/sendVoice" $ + it "should upload voice" $ do + -- audio source: https://commons.wikimedia.org/wiki/File:Possible_PDM_signal_labeled_as_Sputnik_by_NASA.ogg + let fileUpload = localFileUpload (testFile "Possible_PDM_signal_labeled_as_Sputnik_by_NASA.ogg") + voiceReq = (uploadVoiceRequest chatId fileUpload) { _voice_duration = Just 10 } + Right Response { result = Message { voice = Just voice } } <- + uploadVoice token voiceReq manager + voice_duration voice `shouldBe` 10 + + describe "/sendVideo" $ + it "should upload video" $ do + -- video source: http://techslides.com/sample-webm-ogg-and-mp4-video-files-for-html5 + let fileUpload = localFileUpload (testFile "lego-video.mp4") + videoReq = uploadVideoRequest chatId fileUpload + Right Response { result = Message { video = Just video } } <- + uploadVideo token videoReq manager + video_width video `shouldBe` 560 + + describe "/sendDocument" $ + it "should upload document" $ do + let fileUpload = localFileUpload (testFile "wikipedia-telegram.txt") + documentReq = uploadDocumentRequest chatId fileUpload + Right Response { result = Message { document = Just document } } <- + uploadDocument token documentReq manager + doc_mime_type document `shouldBe` Just "text/plain" + doc_file_name document `shouldBe` Just "wikipedia-telegram.txt" + + describe "/sendLocation" $ + it "should send location" $ do + let location = sendLocationRequest chatId 52.38 4.9 + Right Response { result = Message { location = Just loc } } <- + sendLocation token location manager + latitude loc `shouldSatisfy` liftM2 (&&) (> 52) (< 52.4) + longitude loc `shouldSatisfy` liftM2 (&&) (> 4.89) (< 5) + + describe "/sendVenue" $ + it "should send a venue" $ do + let venue = sendVenueRequest chatId 52.38 4.9 "Amsterdam Centraal" "Amsterdam" + Right Response { 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" $ + it "should send a contact" $ do + let contact = sendContactRequest chatId "06-18035176" "Hilbert" + Right Response { 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 Response { result = res} <- + sendChatAction token (SendChatActionRequest chatId Typing) manager + res `shouldBe` True + it "should set find location action" $ do + Right Response { result = res} <- + sendChatAction token (SendChatActionRequest chatId FindLocation) manager + res `shouldBe` True + it "should set upload photo action" $ do + Right Response { result = res} <- + sendChatAction token (SendChatActionRequest chatId UploadPhoto) manager + res `shouldBe` True + + describe "/getUpdates" $ + it "should get all messages" $ do + Right Response { result = updates} <- + getUpdates token Nothing Nothing Nothing manager + length updates `shouldSatisfy` (>= 0) + + describe "/getFile" $ do + it "should get file" $ do + Right Response { result = file } <- + 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" manager + msg `shouldBe` "Bad Request" + + describe "/getUserProfilePhotos" $ + it "should get user profile photos" $ do + Right Response { result = photos } <- + getUserProfilePhotos token (read (T.unpack chatId)) Nothing Nothing manager + total_count photos `shouldSatisfy` (>= 0) + + describe "/setWebhook and /getWebhookInfo" $ do + it "should set webhook with certificate" $ do + let cert = localFileUpload $ testFile "cert.pem" + req = SetWebhookRequest "https://example.com/secret_token" cert + res <- setWebhookWithCertificate token req manager + success res + let Right Response { result = val } = res + val `shouldBe` True + + it "should set webhook" $ do + threadDelay $ 2 * 1000 * 1000 + Right Response { result = res } <- + setWebhook token (Just "https://example.com/secret_token") manager + res `shouldBe` True + + it "should get webhook info" $ do + Right Response { result = WebhookInfo { whi_url = url } } <- getWebhookInfo token manager + url `shouldBe` "https://example.com/secret_token" + + it "should remove webhook" $ do + Right Response { result = res } <- + setWebhook token Nothing manager + res `shouldBe` True + + it "should remove webhood with deleteWebhook" $ do + threadDelay $ 2 * 1000 * 1000 + _ <- setWebhook token (Just "https://example.com/secret_token") manager + res <- deleteWebhook token manager + success res + let Right Response { result = val } = res + val `shouldBe` True + + describe "/editTextMessage" $ do + it "should edit message" $ do + let originalMessage = sendMessageRequest chatId "veritas" + Right Response { result = Message { message_id = msg_id, text = Just txt } } <- + sendMessage token originalMessage manager + let editRequest = editMessageTextRequest chatId msg_id $ "edited " <> txt + Right Response { result = Message { text = txt' } } <- + editMessageText token editRequest manager + txt' `shouldBe` Just "edited veritas" + + it "should edit caption" $ do + let fileUpload = localFileUpload (testFile "christmas-cat.jpg") + let originalMessage = (uploadPhotoRequest chatId fileUpload) { + photo_caption = Just "cat picture" + } + Right Response { result = Message { message_id = msg_id, caption = Just cpt } } <- + uploadPhoto token originalMessage manager + let editRequest = editMessageCaptionRequest chatId msg_id $ Just $ "edited " <> cpt + Right Response { 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 diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,84 +1,84 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} - -module Main (main) where - -import Data.Monoid ((<>)) -import Data.Maybe (fromMaybe) -import Data.Text (Text) -import qualified Data.Text as T -import qualified MainSpec -import qualified JsonSpec -import Options.Applicative -import System.Environment (withArgs) -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 - 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" - - -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 -- ")) +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module Main (main) where + +import Data.Monoid ((<>)) +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import qualified Data.Text as T +import qualified MainSpec +import qualified JsonSpec +import Options.Applicative +import System.Environment (withArgs) +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 + 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" + + +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 -- "))