diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,14 @@ +## 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: diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -13,9 +13,7 @@ Inline mode is supported. Uploading stickers, documents, video, etc is not supported yet, but you can send items which are already uploaded on the Telegram servers. -**Almost full support of [Bot-2.0 API][bot-2.0]** - -See TODO section for details. +**Support of [Bot-2.0 API][bot-2.0]** ## Usage @@ -135,16 +133,6 @@ Note: Inline Spec is disabled for now... If everything is fine after running the tests you will receive a few new messages from your bot. - -## TODO - -* ~~`sendPhoto` - upload photo~~ done -* ~~`sendAudio` - upload audio~~ done -* ~~`sendDocument` - upload documents~~ done -* ~~`sendSticker` - upload stickers~~ done -* ~~`sendVideo` - upload video~~ done -* ~~`sendVoice` - upload voice~~ done -* `setWebhook` - upload certificate [telegram-bot-api]: https://core.telegram.org/bots/api [servant]: https://haskell-servant.github.io/ 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 @@ -28,6 +28,7 @@ , getFile , getUserProfilePhotos , setWebhook + , setWebhookWithCertificate , answerInlineQuery , answerCallbackQuery , kickChatMember @@ -40,6 +41,9 @@ , editMessageText , editMessageCaption , editMessageReplyMarkup + , editInlineMessageText + , editInlineMessageCaption + , editInlineMessageReplyMarkup -- * API , TelegramBotAPI , api @@ -141,6 +145,9 @@ :<|> TelegramToken :> "setWebhook" :> QueryParam "url" Text :> Get '[JSON] SetWebhookResponse + :<|> TelegramToken :> "setWebhook" + :> MultipartFormDataReqBody SetWebhookRequest + :> Post '[JSON] SetWebhookResponse :<|> TelegramToken :> "answerInlineQuery" :> ReqBody '[JSON] AnswerInlineQueryRequest :> Post '[JSON] InlineQueryResponse @@ -180,7 +187,15 @@ :<|> 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 @@ -209,6 +224,7 @@ getFile_ :: Token -> Maybe Text -> Manager -> BaseUrl -> ExceptT ServantError IO FileResponse getUserProfilePhotos_ :: Token -> Maybe Int -> Maybe Int -> Maybe Int -> Manager -> BaseUrl -> ExceptT ServantError IO UserProfilePhotosResponse setWebhook_ :: Token -> Maybe Text -> Manager -> BaseUrl -> ExceptT ServantError IO SetWebhookResponse +setWebhookWithCert_ :: Token -> SetWebhookRequest -> Manager -> BaseUrl -> ExceptT ServantError IO SetWebhookResponse answerInlineQuery_ :: Token -> AnswerInlineQueryRequest -> Manager -> BaseUrl -> ExceptT ServantError IO InlineQueryResponse answerCallbackQuery_ :: Token -> AnswerCallbackQueryRequest -> Manager -> BaseUrl -> ExceptT ServantError IO CallbackQueryResponse kickChatMember_ :: Token -> Maybe Text -> Maybe Int -> Manager -> BaseUrl -> ExceptT ServantError IO KickChatMemberResponse @@ -221,6 +237,9 @@ editMessageText_ :: Token -> EditMessageTextRequest -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse editMessageCaption_ :: Token -> EditMessageCaptionRequest -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse editMessageReplyMarkup_ :: Token -> EditMessageReplyMarkupRequest -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse +editMessageText__ :: Token -> EditMessageTextRequest -> Manager -> BaseUrl -> ExceptT ServantError IO (Response Bool) +editMessageCaption__ :: Token -> EditMessageCaptionRequest -> Manager -> BaseUrl -> ExceptT ServantError IO (Response Bool) +editMessageReplyMarkup__ :: Token -> EditMessageReplyMarkupRequest -> Manager -> BaseUrl -> ExceptT ServantError IO (Response Bool) getMe_ :<|> sendMessage_ :<|> forwardMessage_ @@ -244,6 +263,7 @@ :<|> getFile_ :<|> getUserProfilePhotos_ :<|> setWebhook_ + :<|> setWebhookWithCert_ :<|> answerInlineQuery_ :<|> answerCallbackQuery_ :<|> kickChatMember_ @@ -255,7 +275,10 @@ :<|> getChatMember_ :<|> editMessageText_ :<|> editMessageCaption_ - :<|> editMessageReplyMarkup_ = + :<|> editMessageReplyMarkup_ + :<|> editMessageText__ + :<|> editMessageCaption__ + :<|> editMessageReplyMarkup__ = client api -- | A simple method for testing your bot's auth token. Requires no parameters. @@ -327,11 +350,11 @@ 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. +-- | 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. +-- | 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_ @@ -362,6 +385,12 @@ -> IO (Either ServantError SetWebhookResponse) setWebhook token url manager = runExceptT $ setWebhook_ token url 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_ @@ -386,29 +415,41 @@ getChat :: Token -> Text -> Manager -> IO (Either ServantError GetChatResponse) getChat token chat_id manager = runExceptT $ getChat_ token (Just chat_id) 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. +-- | 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 = runExceptT $ getChatAdministrators_ token (Just chat_id) manager telegramBaseUrl --- | Use this method to get the number of members in a chat. Returns Int on success. +-- | 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 = runExceptT $ getChatMembersCount_ token (Just chat_id) manager telegramBaseUrl --- | Use this method to get information about a member of a chat. Returns a ChatMember object on success. +-- | 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 = runExceptT $ getChatMember_ token (Just chat_id) (Just user_id) manager telegramBaseUrl --- | Use this method to edit text messages sent by the bot or via the bot (for inline bots). On success, if edited message is sent by the bot, the edited `Message` is returned, otherwise True is returned. +-- | 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 or via the bot (for inline bots). On success, if edited message is sent by the bot, the edited `Message` is returned. +-- | 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 or via the bot (for inline bots). On success, if edited message is sent by the bot, the edited `Message` is returned. +-- | 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 -> Manager -> BaseUrl -> ExceptT ServantError IO b) -> Token -> a -> Manager -> IO (Either ServantError b) run b e t r m = runExceptT $ e t r m b 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 @@ -58,7 +58,7 @@ ) where import Data.Aeson -import Data.Maybe +import Data.Maybe() import Data.Aeson.Types import Data.Text (Text) import qualified Data.Char as Char @@ -307,23 +307,7 @@ } deriving (Show, Generic) instance ToJSON InputMessageContent where - toJSON (InputTextMessageContent txt mode preview) = object $ - ("message_text" .= txt) : catMaybes [ - ("parse_mode" .=) <$> mode, - ("disable_web_page_preview" .=) <$> preview] - toJSON (InputLocationMessageContent lat lon) = object [ - "latitude" .= lat, - "longitude" .= lon ] - toJSON (InputVenueMessageContent lat lon title addr fsq_id) = object $ [ - "latitude" .= lat, - "longitude" .= lon, - "title" .= title, - "address" .= addr ] ++ maybeToList - (("foursquare_id" .=) <$> fsq_id) - toJSON (InputContactMessageContent phone fName lName) = object $ [ - "phone_number" .= phone, - "first_name" .= fName] ++ maybeToList - (("last_name" .=) <$> lName) + toJSON = toJsonDrop 4 instance FromJSON InputMessageContent where parseJSON = parseJsonDrop 4 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 @@ -9,6 +9,7 @@ , ForwardMessageRequest (..) , FileUpload (..) , FileUploadContent (..) + , SetWebhookRequest (..) , SendPhotoRequest (..) , SendAudioRequest (..) , SendDocumentRequest (..) @@ -28,6 +29,7 @@ , EditMessageReplyMarkupRequest (..) -- * Functions , localFileUpload + , setWebhookRequest , sendMessageRequest , forwardMessageRequest , sendPhotoRequest @@ -89,8 +91,7 @@ } localFileUpload :: FilePath -> FileUpload -localFileUpload path = - FileUpload +localFileUpload path = FileUpload { fileUpload_type = Nothing , fileUpload_content = FileUploadFile path } @@ -106,6 +107,22 @@ 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 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 @@ -5,22 +5,23 @@ -- | This module contains responses from Telegram Bot API module Web.Telegram.API.Bot.Responses ( -- * Types - GetMeResponse (..) - , MessageResponse (..) - , ChatActionResponse (..) - , UpdatesResponse (..) - , FileResponse (..) - , UserProfilePhotosResponse (..) - , SetWebhookResponse (..) - , InlineQueryResponse (..) - , CallbackQueryResponse (..) - , KickChatMemberResponse (..) - , LeaveChatResponse (..) - , UnbanChatMemberResponse (..) - , GetChatResponse (..) - , GetChatAdministratorsResponse (..) - , GetChatMembersCountResponse (..) - , GetChatMemberResponse (..) + Response (..) + , GetMeResponse + , MessageResponse + , ChatActionResponse + , UpdatesResponse + , FileResponse + , UserProfilePhotosResponse + , SetWebhookResponse + , InlineQueryResponse + , CallbackQueryResponse + , KickChatMemberResponse + , LeaveChatResponse + , UnbanChatMemberResponse + , GetChatResponse + , GetChatAdministratorsResponse + , GetChatMembersCountResponse + , GetChatMemberResponse ) where import Data.Aeson @@ -28,191 +29,50 @@ import Web.Telegram.API.Bot.Data import Web.Telegram.API.Bot.JsonExt --- TODO: use generic response i.e. `data Response a = Response ` - --- | This object represents 'getMe' response -data GetMeResponse = GetMeResponse +data Response a = Response { - user_result :: User - } deriving (Show, Generic) - -instance ToJSON GetMeResponse where - toJSON = toJsonDrop 5 + result :: a + } deriving (Show, Generic, FromJSON) -instance FromJSON GetMeResponse where - parseJSON = parseJsonDrop 5 +-- | This object represents 'getMe' response +type GetMeResponse = Response User -- | This object represents message response -data MessageResponse = MessageResponse - { - message_result :: Message - } deriving (Show, Generic) - -instance ToJSON MessageResponse where - toJSON = toJsonDrop 8 - -instance FromJSON MessageResponse where - parseJSON = parseJsonDrop 8 +type MessageResponse = Response Message -- | This object represents 'sendChatAction' response -data ChatActionResponse = ChatActionResponse - { - action_result :: Bool - } deriving (Show, Generic) - -instance ToJSON ChatActionResponse where - toJSON = toJsonDrop 7 - -instance FromJSON ChatActionResponse where - parseJSON = parseJsonDrop 7 +type ChatActionResponse = Response Bool -- | This object represents 'getUpdates' response -data UpdatesResponse = UpdatesResponse - { - update_result :: [Update] - } deriving (Show, Generic) - -instance ToJSON UpdatesResponse where - toJSON = toJsonDrop 7 - -instance FromJSON UpdatesResponse where - parseJSON = parseJsonDrop 7 +type UpdatesResponse = Response [Update] -- | This object represents file response -data FileResponse = FileResponse - { - file_result :: File - } deriving (Show, Generic) - -instance ToJSON FileResponse where - toJSON = toJsonDrop 5 - -instance FromJSON FileResponse where - parseJSON = parseJsonDrop 5 +type FileResponse = Response File -- | This object represents user profile photos response -data UserProfilePhotosResponse = UserProfilePhotosResponse - { - photos_result :: UserProfilePhotos - } deriving (Show, Generic) - -instance ToJSON UserProfilePhotosResponse where - toJSON = toJsonDrop 7 - -instance FromJSON UserProfilePhotosResponse where - parseJSON = parseJsonDrop 7 +type UserProfilePhotosResponse = Response UserProfilePhotos -- | This object represents 'setWebhook' response -data SetWebhookResponse = SetWebhookResponse - { - webhook_result :: Bool - } deriving (Show, Generic) - -instance ToJSON SetWebhookResponse where - toJSON = toJsonDrop 8 - -instance FromJSON SetWebhookResponse where - parseJSON = parseJsonDrop 8 +type SetWebhookResponse = Response Bool -- | This object represents 'answerInlineQuery' response -data InlineQueryResponse = InlineQueryResponse - { - query_result :: Bool - } deriving (Show, Generic) - -instance ToJSON InlineQueryResponse where - toJSON = toJsonDrop 6 - -instance FromJSON InlineQueryResponse where - parseJSON = parseJsonDrop 6 +type InlineQueryResponse = Response Bool -- | This object represents 'answerCallbackQuery' response -data CallbackQueryResponse = CallbackQueryResponse - { - callback_result :: Bool - } deriving (Show, Generic) - -instance ToJSON CallbackQueryResponse where - toJSON = toJsonDrop 9 - -instance FromJSON CallbackQueryResponse where - parseJSON = parseJsonDrop 9 +type CallbackQueryResponse = Response Bool -- | This object represents 'kickChatMember' response -data KickChatMemberResponse = KickChatMemberResponse - { - kick_result :: Bool - } deriving (Show, Generic) - -instance ToJSON KickChatMemberResponse where - toJSON = toJsonDrop 5 - -instance FromJSON KickChatMemberResponse where - parseJSON = parseJsonDrop 5 - -data LeaveChatResponse = LeaveChatResponse - { - leave_result :: Bool - } deriving (Show, Generic) - -instance ToJSON LeaveChatResponse where - toJSON = toJsonDrop 6 +type KickChatMemberResponse = Response Bool -instance FromJSON LeaveChatResponse where - parseJSON = parseJsonDrop 6 +type LeaveChatResponse = Response Bool -- | This object represents 'unbanChatMember' response -data UnbanChatMemberResponse = UnbanChatMemberResponse - { - unban_result :: Bool - } deriving (Show, Generic) - -instance ToJSON UnbanChatMemberResponse where - toJSON = toJsonDrop 6 - -instance FromJSON UnbanChatMemberResponse where - parseJSON = parseJsonDrop 6 - -data GetChatResponse = GetChatResponse - { - chat_result :: Chat - } deriving (Show, Generic) - -instance ToJSON GetChatResponse where - toJSON = toJsonDrop 5 - -instance FromJSON GetChatResponse where - parseJSON = parseJsonDrop 5 - -data GetChatAdministratorsResponse = GetChatAdministratorsResponse - { - ca_result :: [ChatMember] - } deriving (Show, Generic) - -instance ToJSON GetChatAdministratorsResponse where - toJSON = toJsonDrop 3 - -instance FromJSON GetChatAdministratorsResponse where - parseJSON = parseJsonDrop 3 - -data GetChatMembersCountResponse = GetChatMembersCountResponse - { - cmc_result :: Int - } deriving (Show, Generic) - -instance ToJSON GetChatMembersCountResponse where - toJSON = toJsonDrop 4 +type UnbanChatMemberResponse = Response Bool -instance FromJSON GetChatMembersCountResponse where - parseJSON = parseJsonDrop 4 +type GetChatResponse = Response Chat -data GetChatMemberResponse = GetChatMemberResponse - { - gcm_result :: Int - } deriving (Show, Generic) +type GetChatAdministratorsResponse = Response [ChatMember] -instance ToJSON GetChatMemberResponse where - toJSON = toJsonDrop 4 +type GetChatMembersCountResponse = Response Int -instance FromJSON GetChatMemberResponse where - parseJSON = parseJsonDrop 4 +type GetChatMemberResponse = Response ChatMember diff --git a/telegram-api.cabal b/telegram-api.cabal --- a/telegram-api.cabal +++ b/telegram-api.cabal @@ -1,5 +1,5 @@ name: telegram-api -version: 0.4.3.1 +version: 0.5.0.0 synopsis: Telegram Bot API bindings description: High-level bindings to the Telegram Bot API homepage: http://github.com/klappvisor/haskell-telegram-api#readme @@ -13,6 +13,7 @@ -- 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 diff --git a/test-data/cert.pem b/test-data/cert.pem new file mode 100644 --- /dev/null +++ b/test-data/cert.pem @@ -0,0 +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== +-----END CERTIFICATE----- diff --git a/test/InlineSpec.hs b/test/InlineSpec.hs --- a/test/InlineSpec.hs +++ b/test/InlineSpec.hs @@ -2,17 +2,11 @@ module InlineSpec (spec) where -import Control.Monad import Web.Telegram.API.Bot import Test.Hspec import Data.Text (Text) -import qualified Data.Text as T import Network.HTTP.Client (newManager) import Network.HTTP.Client.TLS (tlsManagerSettings) -import Servant.Client -import Servant.API -import Network.HTTP.Types.Status -import System.Environment spec :: Token -> Text -> Spec spec token chatId = do @@ -21,33 +15,33 @@ -- Create the tls connection manager describe "/answerInlineQuery" $ do it "should answer with article" $ do - Right InlineQueryResponse { query_result = res } <- - answerInlineQuery token (AnswerInlineQueryRequest inline_query_id [inline_article] Nothing Nothing Nothing Nothing Nothing) manager + Right Response { result = res } <- + answerInlineQuery token (answerInlineQueryRequest inline_query_id [inline_article]) manager res `shouldBe` True it "should answer with photo" $ do - Right InlineQueryResponse { query_result = res } <- - answerInlineQuery token (AnswerInlineQueryRequest inline_query_id [inline_photo] Nothing Nothing Nothing Nothing Nothing) manager + Right Response { result = res } <- + answerInlineQuery token (answerInlineQueryRequest inline_query_id [inline_photo]) manager res `shouldBe` True it "should answer with gif" $ do - Right InlineQueryResponse { query_result = res } <- - answerInlineQuery token (AnswerInlineQueryRequest inline_query_id [inline_gif] Nothing Nothing Nothing Nothing Nothing) manager + Right Response { result = res } <- + answerInlineQuery token (answerInlineQueryRequest inline_query_id [inline_gif]) manager res `shouldBe` True it "should answer with mpeg gif" $ do - Right InlineQueryResponse { query_result = res } <- - answerInlineQuery token (AnswerInlineQueryRequest inline_query_id [inline_mpeg] Nothing Nothing Nothing Nothing Nothing) manager + Right Response { result = res } <- + answerInlineQuery token (answerInlineQueryRequest inline_query_id [inline_mpeg]) manager res `shouldBe` True it "should answer with video" $ do - Right InlineQueryResponse { query_result = res } <- - answerInlineQuery token (AnswerInlineQueryRequest inline_query_id [inline_video] Nothing Nothing Nothing Nothing Nothing) manager + Right Response { result = res } <- + answerInlineQuery token (answerInlineQueryRequest inline_query_id [inline_video]) manager res `shouldBe` True - describe "/answerInlineQuery" $ do + describe "/answerInlineQuery" $ it "should get updates and answer" $ do - Right UpdatesResponse { update_result = updates} <- + 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] Nothing Nothing Nothing Nothing Nothing) manager + answerInlineQuery token (answerInlineQueryRequest id [inline_video]) manager putStrLn (show e) message_content = InputTextMessageContent "test message content" Nothing Nothing diff --git a/test/JsonSpec.hs b/test/JsonSpec.hs --- a/test/JsonSpec.hs +++ b/test/JsonSpec.hs @@ -13,43 +13,43 @@ spec = do let getType q = jPath (T.unpack "type") (toString (encode q)) describe "type of serialized inline query result" $ do - it "should be article" $ do - (getType iq_article) `shouldBe` ["\"article\""] - it "should be photo" $ do - (getType iq_photo) `shouldBe` ["\"photo\""] - it "should be gif" $ do - (getType iq_gif) `shouldBe` ["\"gif\""] - it "should be mpeg4_gif" $ do - (getType iq_mpeg) `shouldBe` ["\"mpeg4_gif\""] - it "should be video" $ do - (getType iq_video) `shouldBe` ["\"video\""] - it "should be audio" $ do - (getType iq_audio) `shouldBe` ["\"audio\""] - it "should be contact" $ do - (getType iq_contact) `shouldBe` ["\"contact\""] - it "should be document" $ do - (getType iq_document) `shouldBe` ["\"document\""] - it "should be location" $ do - (getType iq_location) `shouldBe` ["\"location\""] - it "should be venue" $ do - (getType iq_venue) `shouldBe` ["\"venue\""] + 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" $ do - (getType cached_audio) `shouldBe` ["\"audio\""] - it "should be voice" $ do - (getType cached_voice) `shouldBe` ["\"voice\""] - it "should be video" $ do - (getType cached_video) `shouldBe` ["\"video\""] - it "should be document" $ do - (getType cached_doc) `shouldBe` ["\"document\""] - it "should be sticker" $ do - (getType cached_sticker) `shouldBe` ["\"sticker\""] - it "should be mpeg4_gif" $ do - (getType cached_mpeg) `shouldBe` ["\"mpeg4_gif\""] - it "should be gif" $ do - (getType cached_gif) `shouldBe` ["\"gif\""] - it "should be photo" $ do - (getType cached_photo) `shouldBe` ["\"photo\""] + 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 diff --git a/test/MainSpec.hs b/test/MainSpec.hs --- a/test/MainSpec.hs +++ b/test/MainSpec.hs @@ -32,7 +32,7 @@ let testFile name = dataDir "test-data" name describe "/getMe" $ it "responds with correct bot's name" $ do - Right GetMeResponse { user_result = u } <- + Right Response { result = u } <- getMe token manager user_first_name u `shouldBe` botName -- f.e. "TelegramAPIBot" @@ -40,7 +40,7 @@ it "should send message" $ do res <- sendMessage token (sendMessageRequest chatId "test message") manager success res - let Right MessageResponse { message_result = m } = res + let Right Response { result = m } = res text m `shouldBe` Just "test message" it "should return error message" $ do @@ -55,7 +55,7 @@ } res <- sendMessage token request manager success res - let Right MessageResponse { message_result = m } = res + let Right Response { result = m } = res text m `shouldBe` Just "text bold italic github" it "should set keyboard" $ do @@ -67,7 +67,7 @@ } res <- sendMessage token message manager success res - let Right MessageResponse { message_result = m } = res + let Right Response { result = m } = res text m `shouldBe` Just "set keyboard" it "should remove keyboard" $ do @@ -76,7 +76,7 @@ } res <- sendMessage token message manager success res - let Right MessageResponse { message_result = m } = res + let Right Response { result = m } = res text m `shouldBe` Just "remove keyboard" it "should send message with inline keyboard" $ do @@ -88,7 +88,7 @@ } res <- sendMessage token message manager success res - let Right MessageResponse { message_result = m } = res + let Right Response { result = m } = res text m `shouldBe` Just "set inline keyboard" it "should force reply" $ do @@ -97,7 +97,7 @@ } res <- sendMessage token message manager success res - let Right MessageResponse { message_result = m } = res + let Right Response { result = m } = res text m `shouldBe` Just "force reply" describe "/forwardMessage" $ @@ -119,7 +119,7 @@ let upload = (uploadPhotoRequest chatId fileUpload) { photo_caption = Just "uploaded photo" } - Right MessageResponse { message_result = Message { caption = Just cpt, photo = Just photos } } <- + Right Response { result = Message { caption = Just cpt, photo = Just photos } } <- uploadPhoto token upload manager cpt `shouldBe` "uploaded photo" -- resend by id @@ -127,7 +127,7 @@ let photo = (sendPhotoRequest chatId id) { photo_caption = Just "photo caption" } - Right MessageResponse { message_result = Message { caption = Just cpt } } <- + Right Response { result = Message { caption = Just cpt } } <- sendPhoto token photo manager cpt `shouldBe` "photo caption" @@ -145,25 +145,25 @@ 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 MessageResponse { message_result = Message { audio = Just Audio { audio_file_id = file_id, audio_title = Just title, audio_performer = Just performer } } } <- + 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 MessageResponse { message_result = Message { audio = Just Audio { audio_title = Just title' } } } <- + 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 MessageResponse { message_result = Message { sticker = Just sticker } } <- + 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 MessageResponse { message_result = Message { sticker = Just sticker } } <- + Right Response { result = Message { sticker = Just sticker } } <- uploadSticker token stickerReq manager sticker_height sticker `shouldBe` 128 @@ -172,7 +172,7 @@ -- 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 MessageResponse { message_result = Message { voice = Just voice } } <- + Right Response { result = Message { voice = Just voice } } <- uploadVoice token voiceReq manager voice_duration voice `shouldBe` 10 @@ -181,7 +181,7 @@ -- 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 MessageResponse { message_result = Message { video = Just video } } <- + Right Response { result = Message { video = Just video } } <- uploadVideo token videoReq manager video_width video `shouldBe` 560 @@ -189,7 +189,7 @@ it "should upload document" $ do let fileUpload = localFileUpload (testFile "wikipedia-telegram.txt") documentReq = uploadDocumentRequest chatId fileUpload - Right MessageResponse { message_result = Message { document = Just document } } <- + 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" @@ -197,7 +197,7 @@ describe "/sendLocation" $ it "should send location" $ do let location = sendLocationRequest chatId 52.38 4.9 - Right MessageResponse { message_result = Message { location = Just loc } } <- + 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) @@ -205,7 +205,7 @@ describe "/sendVenue" $ it "should send a venue" $ do let venue = sendVenueRequest chatId 52.38 4.9 "Amsterdam Centraal" "Amsterdam" - Right MessageResponse { message_result = Message { location = Just loc } } <- + 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) @@ -213,7 +213,7 @@ describe "/sendContact" $ it "should send a contact" $ do let contact = sendContactRequest chatId "06-18035176" "Hilbert" - Right MessageResponse { message_result = Message { contact = Just con } } <- + 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" @@ -221,27 +221,27 @@ describe "/sendChatAction" $ do it "should set typing action" $ do - Right ChatActionResponse { action_result = res} <- + Right Response { result = res} <- sendChatAction token (SendChatActionRequest chatId Typing) manager res `shouldBe` True it "should set find location action" $ do - Right ChatActionResponse { action_result = res} <- + Right Response { result = res} <- sendChatAction token (SendChatActionRequest chatId FindLocation) manager res `shouldBe` True it "should set upload photo action" $ do - Right ChatActionResponse { action_result = res} <- + Right Response { result = res} <- sendChatAction token (SendChatActionRequest chatId UploadPhoto) manager res `shouldBe` True describe "/getUpdates" $ it "should get all messages" $ do - Right UpdatesResponse { update_result = updates} <- + Right Response { result = updates} <- getUpdates token Nothing Nothing Nothing manager length updates `shouldSatisfy` (>= 0) describe "/getFile" $ do it "should get file" $ do - Right FileResponse { file_result = file } <- + Right Response { result = file } <- getFile token "AAQEABMXDZEwAARC0Kj3twkzNcMkAAIC" manager fmap (T.take 10) (file_path file) `shouldBe` Just "thumb/file" @@ -252,28 +252,36 @@ describe "/getUserProfilePhotos" $ it "should get user profile photos" $ do - Right UserProfilePhotosResponse { photos_result = photos } <- + 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 - Right SetWebhookResponse { webhook_result = res } <- + Right Response { result = res } <- setWebhook token (Just "https://example.com/secret_token") manager res `shouldBe` True it "should remove webhook" $ do - Right SetWebhookResponse { webhook_result = res } <- + 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 MessageResponse { message_result = Message { message_id = msg_id, text = Just txt } } <- + Right Response { result = Message { message_id = msg_id, text = Just txt } } <- sendMessage token originalMessage manager let editRequest = editMessageTextRequest chatId msg_id $ "edited " <> txt - Right MessageResponse { message_result = Message { text = txt' } } <- + Right Response { result = Message { text = txt' } } <- editMessageText token editRequest manager txt' `shouldBe` Just "edited veritas" @@ -282,10 +290,10 @@ let originalMessage = (uploadPhotoRequest chatId fileUpload) { photo_caption = Just "cat picture" } - Right MessageResponse { message_result = Message { message_id = msg_id, caption = Just cpt } } <- + 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 MessageResponse { message_result = Message { caption = Just cpt' } } <- + Right Response { result = Message { caption = Just cpt' } } <- editMessageCaption token editRequest manager cpt' `shouldBe` "edited cat picture"