diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,11 @@ +## 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: 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 @@ -18,7 +18,6 @@ import Control.Monad.Trans.Except import Data.ByteString.Lazy hiding (pack, filter, map, null, elem) import Data.Proxy -import GHC.TypeLits import Data.String.Conversions import Data.Typeable (Typeable) import Network.HTTP.Client hiding (Proxy, path) @@ -29,18 +28,9 @@ import qualified Network.HTTP.Types as H import qualified Network.HTTP.Types.Header as HTTP import Servant.API -import Servant.API.Verbs import Servant.Common.BaseUrl import Servant.Client import Servant.Common.Req - -import Data.ByteString.Lazy (ByteString) -import Data.List -import Data.Text (unpack) -import Network.HTTP.Client (Manager, Response) -import Servant.Client.Experimental.Auth -import Servant.Common.BasicAuth - -- | A type that can be converted to a multipart/form-data value. class ToMultipartFormData a where -- | Convert a Haskell value to a multipart/form-data-friendly intermediate type. @@ -102,7 +92,7 @@ let acceptCT = contentType ct (_status, respBody, respCT, hdrs, _response) <- performRequest' reqToRequest' reqMethod (req { reqAccept = [acceptCT] }) manager reqHost - unless (matches respCT (acceptCT)) $ throwE $ UnsupportedContentType respCT respBody + unless (matches respCT acceptCT) $ throwE $ UnsupportedContentType respCT respBody case mimeUnrender ct respBody of Left err -> throwE $ 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,3 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TemplateHaskell #-} - -- | This module provides Telegram Bot API module Web.Telegram.API.Bot ( 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,5 +1,4 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeOperators #-} @@ -32,7 +31,12 @@ , answerInlineQuery , answerCallbackQuery , kickChatMember + , leaveChat , unbanChatMember + , getChat + , getChatAdministrators + , getChatMembersCount + , getChatMember , editMessageText , editMessageCaption , editMessageReplyMarkup @@ -43,23 +47,13 @@ , Token (..) ) where -import Control.Applicative -import Control.Monad.Trans.Either import Control.Monad.Trans.Except (ExceptT, runExceptT) -import Data.Aeson -import Data.Aeson.Types -import Data.Maybe import Data.Proxy import Data.Text (Text) -import qualified Data.Text as T -import GHC.Generics -import GHC.TypeLits import Network.HTTP.Client (Manager) import Servant.API import Servant.Client -import Web.HttpApiData import Servant.Client.MultipartFormData -import Web.Telegram.API.Bot.Data import Web.Telegram.API.Bot.Responses import Web.Telegram.API.Bot.Requests @@ -146,8 +140,7 @@ :> Get '[JSON] UserProfilePhotosResponse :<|> TelegramToken :> "setWebhook" :> QueryParam "url" Text - :> Get '[JSON] - SetWebhookResponse + :> Get '[JSON] SetWebhookResponse :<|> TelegramToken :> "answerInlineQuery" :> ReqBody '[JSON] AnswerInlineQueryRequest :> Post '[JSON] InlineQueryResponse @@ -158,10 +151,26 @@ :> 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 @@ -203,7 +212,12 @@ 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 +leaveChat_ :: Token -> Maybe Text -> Manager -> BaseUrl -> ExceptT ServantError IO LeaveChatResponse unbanChatMember_ :: Token -> Maybe Text -> Maybe Int -> Manager -> BaseUrl -> ExceptT ServantError IO UnbanChatMemberResponse +getChat_ :: Token -> Maybe Text -> Manager -> BaseUrl -> ExceptT ServantError IO GetChatResponse +getChatAdministrators_ :: Token -> Maybe Text -> Manager -> BaseUrl -> ExceptT ServantError IO GetChatAdministratorsResponse +getChatMembersCount_ :: Token -> Maybe Text -> Manager -> BaseUrl -> ExceptT ServantError IO GetChatMembersCountResponse +getChatMember_ :: Token -> Maybe Text -> Maybe Int -> Manager -> BaseUrl -> ExceptT ServantError IO GetChatMemberResponse 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 @@ -233,7 +247,12 @@ :<|> answerInlineQuery_ :<|> answerCallbackQuery_ :<|> kickChatMember_ + :<|> leaveChat_ :<|> unbanChatMember_ + :<|> getChat_ + :<|> getChatAdministrators_ + :<|> getChatMembersCount_ + :<|> getChatMember_ :<|> editMessageText_ :<|> editMessageCaption_ :<|> editMessageReplyMarkup_ = @@ -355,9 +374,29 @@ kickChatMember :: Token -> Text -> Int -> Manager -> IO (Either ServantError KickChatMemberResponse) kickChatMember token chat_id user_id manager = runExceptT $ kickChatMember_ token (Just chat_id) (Just user_id) manager telegramBaseUrl +-- | Use this method 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 = runExceptT $ leaveChat_ token (Just chat_id) manager telegramBaseUrl + -- | Use this method to unban a previously kicked user in a supergroup. The user will not return to the group automatically, but will be able to join via link, etc. The bot must be an administrator in the group for this to work. unbanChatMember :: Token -> Text -> Int -> Manager -> IO (Either ServantError UnbanChatMemberResponse) unbanChatMember token chat_id user_id manager = runExceptT $ unbanChatMember_ token (Just chat_id) (Just user_id) manager telegramBaseUrl + +-- | Use this method to 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 = 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. +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. +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. +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. editMessageText :: Token -> EditMessageTextRequest -> Manager -> IO (Either ServantError MessageResponse) 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,14 +1,12 @@ -{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TemplateHaskell #-} -- | This module contains objects which represent data of Telegram Bot API responses module Web.Telegram.API.Bot.Data ( -- * Types User (..) + , ChatMember (..) , Chat (..) , Message (..) , PhotoSize (..) @@ -17,6 +15,7 @@ , Sticker (..) , Video (..) , Voice (..) + , Venue (..) , Contact (..) , Location (..) , Update (..) @@ -59,13 +58,9 @@ import Data.Aeson import Data.Aeson.Types -import Data.Maybe -import Data.Proxy import Data.Text (Text) -import qualified Data.Text as T import qualified Data.Char as Char import GHC.Generics -import GHC.TypeLits import Data.List import Web.Telegram.API.Bot.JsonExt @@ -545,9 +540,10 @@ dropCached :: String -> String dropCached name = if isPrefixOf "Cached" 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 +tagModifier x = ((fmap Char.toLower) . dropCached . (drop 17)) x inlineQueryJSONOptions :: Options inlineQueryJSONOptions = defaultOptions { @@ -663,6 +659,7 @@ { 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. @@ -692,8 +689,20 @@ { 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) + } 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 { @@ -705,6 +714,7 @@ , 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 @@ -733,10 +743,11 @@ -- | This object represents one special entity in a text message. For example, hashtags, usernames, URLs, etc. data MessageEntity = MessageEntity { - me_type :: Text -- ^ Type of the entity. One of mention (@username), hashtag, bot_command, url, email, bold (bold text), italic (italic text), code (monowidth string), pre (monowidth block), text_link (for clickable text URLs) - , me_offset :: Int -- ^ Offset in UTF-16 code units to the start of the entity - , me_length :: Int -- ^ Length of the entity in UTF-16 code units - , me_url :: Maybe Text -- ^ For “text_link” only, url that will be opened after user taps on the text + 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 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,10 +1,5 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} -- | This module contains helper functions to work with JSON module Web.Telegram.API.Bot.JsonExt @@ -16,13 +11,14 @@ import Data.Aeson import Data.Aeson.Types import GHC.Generics -import GHC.TypeLits -- | Method used to drop prefix from field name during serialization +toJsonDrop :: forall a.(GHC.Generics.Generic a, GToJSON (GHC.Generics.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 (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,10 +1,5 @@ -{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} -- | This module contains data objects which represents requests to Telegram Bot API @@ -65,18 +60,14 @@ ) where import Data.Aeson -import Data.Aeson.Types import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import Data.Maybe -import Data.Proxy import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T import GHC.Generics -import GHC.TypeLits import Network.HTTP.Client.MultipartFormData -import Network.HTTP.Types.Header (hContentType) import Network.Mime import Servant.Client.MultipartFormData (ToMultipartFormData (..)) import Web.Telegram.API.Bot.JsonExt 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,38 +1,35 @@ -{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE FlexibleContexts #-} -- | This module contains responses from Telegram Bot API module Web.Telegram.API.Bot.Responses ( -- * Types - GetMeResponse (..) - , MessageResponse (..) - , ChatActionResponse (..) - , UpdatesResponse (..) - , FileResponse (..) - , UserProfilePhotosResponse (..) - , SetWebhookResponse (..) - , InlineQueryResponse (..) - , CallbackQueryResponse (..) - , KickChatMemberResponse (..) - , UnbanChatMemberResponse (..) + GetMeResponse (..) + , MessageResponse (..) + , ChatActionResponse (..) + , UpdatesResponse (..) + , FileResponse (..) + , UserProfilePhotosResponse (..) + , SetWebhookResponse (..) + , InlineQueryResponse (..) + , CallbackQueryResponse (..) + , KickChatMemberResponse (..) + , LeaveChatResponse (..) + , UnbanChatMemberResponse (..) + , GetChatResponse (..) + , GetChatAdministratorsResponse (..) + , GetChatMembersCountResponse (..) + , GetChatMemberResponse (..) ) where import Data.Aeson -import Data.Aeson.Types -import Data.Maybe -import Data.Proxy -import Data.Text (Text) -import qualified Data.Text as T import GHC.Generics -import GHC.TypeLits import Web.Telegram.API.Bot.Data import Web.Telegram.API.Bot.JsonExt +-- TODO: use generic response i.e. `data Response a = Response ` + -- | This object represents 'getMe' response data GetMeResponse = GetMeResponse { @@ -153,6 +150,17 @@ instance FromJSON KickChatMemberResponse where parseJSON = parseJsonDrop 5 +data LeaveChatResponse = LeaveChatResponse + { + leave_result :: Bool + } deriving (Show, Generic) + +instance ToJSON LeaveChatResponse where + toJSON = toJsonDrop 6 + +instance FromJSON LeaveChatResponse where + parseJSON = parseJsonDrop 6 + -- | This object represents 'unbanChatMember' response data UnbanChatMemberResponse = UnbanChatMemberResponse { @@ -164,3 +172,47 @@ 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 + +instance FromJSON GetChatMembersCountResponse where + parseJSON = parseJsonDrop 4 + +data GetChatMemberResponse = GetChatMemberResponse + { + gcm_result :: Int + } deriving (Show, Generic) + +instance ToJSON GetChatMemberResponse where + toJSON = toJsonDrop 4 + +instance FromJSON GetChatMemberResponse where + parseJSON = parseJsonDrop 4 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.1.0 +version: 0.4.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 @@ -47,6 +47,7 @@ , bytestring , string-conversions default-language: Haskell2010 + ghc-options: -O2 -Wall -fno-warn-name-shadowing -fno-warn-unused-binds test-suite telegram-api-test type: exitcode-stdio-1.0 @@ -72,7 +73,7 @@ , text , transformers , utf8-string - ghc-options: -threaded -rtsopts -with-rtsopts=-N + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -fno-warn-name-shadowing default-language: Haskell2010 source-repository head diff --git a/test/InlineSpec.hs b/test/InlineSpec.hs --- a/test/InlineSpec.hs +++ b/test/InlineSpec.hs @@ -1,9 +1,4 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TemplateHaskell #-} module InlineSpec (spec) where diff --git a/test/JsonSpec.hs b/test/JsonSpec.hs --- a/test/JsonSpec.hs +++ b/test/JsonSpec.hs @@ -1,25 +1,17 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TemplateHaskell #-} module JsonSpec (spec) where -import Control.Monad import Web.Telegram.API.Bot import Test.Hspec -import Data.Text (Text) import qualified Data.Text as T -import System.Environment 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)) + 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\""] @@ -59,23 +51,59 @@ it "should be photo" $ do (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 @@ -128,21 +128,19 @@ Left FailureResponse { responseStatus = Status { statusMessage = msg } } <- sendAudio token audio manager msg `shouldBe` "Bad Request" - it "should send audio" $ do - -- audio source: https://musopen.org/music/2698/antonio-vivaldi/concerto-for-2-trumpets-in-c-major-rv-537-trumpet-and-organ-arr/ - let audio = sendAudioRequest chatId "BQADBAADAQQAAiBOnQHThzc4cz1-IwI" - Right MessageResponse { message_result = Message { audio = Just Audio { audio_title = Just title } } } <- - sendAudio token audio manager - title `shouldBe` "The Nutcracker Suite - Act II, No.12. Pas de Deux variations" - it "should upload audio" $ do + 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 MessageResponse { message_result = Message { audio = Just Audio { audio_title = Just title, audio_performer = Just performer } } } <- + Right MessageResponse { message_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' } } } <- + sendAudio token audio manager + title' `shouldBe` audioTitle describe "/sendSticker" $ do it "should send sticker" $ do diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -3,15 +3,13 @@ module Main (main) where -import Control.Monad (when) 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 (getArgs, withArgs) -import System.Exit (exitSuccess) +import System.Environment (withArgs) import Test.Hspec import qualified Text.PrettyPrint.ANSI.Leijen as PP import Web.Telegram.API.Bot @@ -52,7 +50,6 @@ main :: IO () main = do - args <- getArgs Options{..} <- execParser opts let integration = opt_integration token = fmap (\x -> Token ("bot" <> T.pack x)) opt_token