telegram-api 0.2.1.1 → 0.3.0.0
raw patch · 8 files changed
+362/−347 lines, 8 filessetup-changed
Files
- LICENSE +29/−29
- Setup.hs +2/−2
- src/Web/Telegram/API/Bot.hs +19/−19
- src/Web/Telegram/API/Bot/Data.hs +2/−2
- telegram-api.cabal +53/−53
- test/InlineSpec.hs +57/−57
- test/MainSpec.hs +156/−143
- test/Spec.hs +44/−42
LICENSE view
@@ -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.
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple -main = defaultMain +import Distribution.Simple+main = defaultMain
src/Web/Telegram/API/Bot.hs view
@@ -1,20 +1,20 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TemplateHaskell #-} - --- | This module provides Telegram Bot API -module Web.Telegram.API.Bot - ( - module Web.Telegram.API.Bot.API - , module Web.Telegram.API.Bot.Data - , module Web.Telegram.API.Bot.Responses - , module Web.Telegram.API.Bot.Requests - ) where - -import Web.Telegram.API.Bot.API -import Web.Telegram.API.Bot.Data -import Web.Telegram.API.Bot.Responses +{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TemplateHaskell #-}++-- | This module provides Telegram Bot API+module Web.Telegram.API.Bot+ (+ module Web.Telegram.API.Bot.API+ , module Web.Telegram.API.Bot.Data+ , module Web.Telegram.API.Bot.Responses+ , module Web.Telegram.API.Bot.Requests+ ) where++import Web.Telegram.API.Bot.API+import Web.Telegram.API.Bot.Data+import Web.Telegram.API.Bot.Responses import Web.Telegram.API.Bot.Requests
src/Web/Telegram/API/Bot/Data.hs view
@@ -375,7 +375,7 @@ data Message = Message { message_id :: Int -- ^ Unique message identifier - , from :: User -- ^ Sender, can be empty for messages sent to channels + , 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 @@ -401,4 +401,4 @@ , channel_chat_created :: Maybe Bool -- ^ Service message: the channel has been created , migrate_to_chat_id :: Maybe Int -- ^ The group has been migrated to a supergroup with the specified identifier, not exceeding 1e13 by absolute value , migrate_from_chat_id :: Maybe Int -- ^ The supergroup has been migrated from a group with the specified identifier, not exceeding 1e13 by absolute value - } deriving (FromJSON, ToJSON, Show, Generic)+ } deriving (FromJSON, ToJSON, Show, Generic)
telegram-api.cabal view
@@ -1,53 +1,53 @@-name: telegram-api -version: 0.2.1.1 -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 - -extra-source-files: - README.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 - build-depends: base >= 4.7 && < 5 - , aeson - , servant - , servant-client - , text - , either - default-language: Haskell2010 - -test-suite telegram-api-test - type: exitcode-stdio-1.0 - hs-source-dirs: test - main-is: Spec.hs - other-modules: MainSpec - , InlineSpec - build-depends: base - , text - , hspec - , servant - , servant-client - , telegram-api - , http-types - ghc-options: -threaded -rtsopts -with-rtsopts=-N - default-language: Haskell2010 - -source-repository head - type: git - location: https://github.com/klappvisor/haskell-telegram-api +name: telegram-api+version: 0.3.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+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++extra-source-files:+ README.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+ build-depends: base >= 4.7 && < 5+ , aeson+ , servant+ , servant-client+ , text+ , either+ default-language: Haskell2010++test-suite telegram-api-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ other-modules: MainSpec+ , InlineSpec+ build-depends: base+ , text+ , hspec+ , servant+ , servant-client+ , telegram-api+ , http-types+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/klappvisor/haskell-telegram-api
test/InlineSpec.hs view
@@ -1,58 +1,58 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TemplateHaskell #-} - -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 Servant.Client -import Servant.API -import Network.HTTP.Types.Status -import System.Environment - -spec :: Token -> Text -> Spec -spec token chatId = do - let inline_query_id = "" - 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) - 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) - 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) - 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) - 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) - res `shouldBe` True - - describe "/answerInlineQuery" $ do - it "should get updates and answer" $ do - Right UpdatesResponse { update_result = updates} <- - getUpdates token Nothing Nothing Nothing - Update { inline_query = Just (InlineQuery { query_id = id } ) } <- pure (last updates) - e <- - answerInlineQuery token (AnswerInlineQueryRequest id [inline_video] Nothing Nothing Nothing) - putStrLn (show e) - -inline_article = InlineQueryResultArticle "2131341" (Just "text article content") Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing -inline_photo = InlineQueryResultPhoto "1430810" "http://vignette3.wikia.nocookie.net/victorious/images/f/f8/NyanCat.jpg" Nothing Nothing (Just "http://vignette3.wikia.nocookie.net/victorious/images/f/f8/NyanCat.jpg") Nothing Nothing Nothing Nothing Nothing Nothing -inline_gif = InlineQueryResultGif "131231234" "https://media.giphy.com/media/zEO5eq3ZsEwbS/giphy.gif" Nothing Nothing (Just "https://media.giphy.com/media/zEO5eq3ZsEwbS/100.gif") Nothing Nothing Nothing Nothing Nothing -inline_mpeg = InlineQueryResultMpeg4Gif "131251234" "https://media.giphy.com/media/zEO5eq3ZsEwbS/giphy.gif" Nothing Nothing (Just "https://media.giphy.com/media/zEO5eq3ZsEwbS/100.gif") Nothing Nothing Nothing Nothing Nothing +{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TemplateHaskell #-}++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 Servant.Client+import Servant.API+import Network.HTTP.Types.Status+import System.Environment++spec :: Token -> Text -> Spec+spec token chatId = do+ let inline_query_id = ""+ 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)+ 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)+ 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)+ 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)+ 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)+ res `shouldBe` True++ describe "/answerInlineQuery" $ do+ it "should get updates and answer" $ do+ Right UpdatesResponse { update_result = updates} <-+ getUpdates token Nothing Nothing Nothing+ Update { inline_query = Just (InlineQuery { query_id = id } ) } <- pure (last updates)+ e <-+ answerInlineQuery token (AnswerInlineQueryRequest id [inline_video] Nothing Nothing Nothing)+ putStrLn (show e)++inline_article = InlineQueryResultArticle "2131341" (Just "text article content") Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing+inline_photo = InlineQueryResultPhoto "1430810" "http://vignette3.wikia.nocookie.net/victorious/images/f/f8/NyanCat.jpg" Nothing Nothing (Just "http://vignette3.wikia.nocookie.net/victorious/images/f/f8/NyanCat.jpg") Nothing Nothing Nothing Nothing Nothing Nothing+inline_gif = InlineQueryResultGif "131231234" "https://media.giphy.com/media/zEO5eq3ZsEwbS/giphy.gif" Nothing Nothing (Just "https://media.giphy.com/media/zEO5eq3ZsEwbS/100.gif") Nothing Nothing Nothing Nothing Nothing+inline_mpeg = InlineQueryResultMpeg4Gif "131251234" "https://media.giphy.com/media/zEO5eq3ZsEwbS/giphy.gif" Nothing Nothing (Just "https://media.giphy.com/media/zEO5eq3ZsEwbS/100.gif") Nothing Nothing Nothing Nothing Nothing inline_video = InlineQueryResultVideo "123413542" "https://www.youtube.com/embed/TBKN7_vx2xo" "text/html" (Just "Enjoykin — Nyash Myash") Nothing Nothing Nothing Nothing Nothing (Just "https://i.ytimg.com/vi_webp/TBKN7_vx2xo/mqdefault.webp") (Just "Enjoykin — Nyash Myash") Nothing
test/MainSpec.hs view
@@ -1,144 +1,157 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TemplateHaskell #-} - -module MainSpec (spec) where - -import Control.Monad -import Web.Telegram.API.Bot -import Test.Hspec -import Data.Text (Text) -import qualified Data.Text as T -import Servant.Client -import Servant.API -import Network.HTTP.Types.Status -import System.Environment - -spec :: Token -> Text -> Spec -spec token chatId = do - describe "/getMe" $ do - it "responds with correct bot's name" $ do - Right GetMeResponse { user_result = u } <- - getMe token - (user_first_name u) `shouldBe` "TelegramAPIBot" - - describe "/sendMessage" $ do - it "should send message" $ do - Right MessageResponse { message_result = m } <- - sendMessage token (SendMessageRequest chatId "test message" Nothing Nothing Nothing Nothing) - (text m) `shouldBe` (Just "test message") - - it "should return error message" $ do - Left FailureResponse { responseStatus = Status { statusMessage = msg } } <- - sendMessage token (SendMessageRequest "" "test message" Nothing Nothing Nothing Nothing) - msg `shouldBe` "Bad Request" - - it "should send message markdown" $ do - Right MessageResponse { message_result = m } <- - sendMessage token (SendMessageRequest chatId "text *bold* _italic_ [github](github.com/klappvisor/telegram-api)" (Just Markdown) Nothing Nothing Nothing) - (text m) `shouldBe` (Just "text bold italic github") - - it "should set keyboard" $ do - Right MessageResponse { message_result = m } <- - sendMessage token (SendMessageRequest chatId "set keyboard" Nothing Nothing Nothing (Just (ReplyKeyboardMarkup [["A", "B"], ["C"]] Nothing Nothing Nothing))) - (text m) `shouldBe` (Just "set keyboard") - - it "should remove keyboard" $ do - Right MessageResponse { message_result = m } <- - sendMessage token (SendMessageRequest chatId "remove keyboard" Nothing Nothing Nothing (Just (ReplyKeyboardHide True Nothing))) - (text m) `shouldBe` (Just "remove keyboard") - - it "should force reply" $ do - Right MessageResponse { message_result = m } <- - sendMessage token (SendMessageRequest chatId "force reply" Nothing Nothing Nothing (Just (ForceReply True Nothing))) - (text m) `shouldBe` (Just "force reply") - - describe "/forwardMessage" $ do - it "should forward message" $ do - Left FailureResponse { responseStatus = Status { statusMessage = msg } } <- - forwardMessage token (ForwardMessageRequest chatId chatId 123) - msg `shouldBe` "Bad Request" - - describe "/sendPhoto" $ do - it "should return error message" $ do - Left FailureResponse { responseStatus = Status { statusMessage = msg } } <- - sendPhoto token (SendPhotoRequest "" "photo_id" (Just "photo caption") Nothing Nothing) - msg `shouldBe` "Bad Request" - it "should send photo" $ do - Right MessageResponse { message_result = Message { caption = Just cpt } } <- - sendPhoto token (SendPhotoRequest chatId "AgADBAADv6cxGybVMgABtZ_EOpBSdxYD5xwZAAQ4ElUVMAsbbBqFAAIC" (Just "photo caption") Nothing Nothing) - cpt `shouldBe` "photo caption" - - describe "/sendAudio" $ do - it "should return error message" $ do - Left FailureResponse { responseStatus = Status { statusMessage = msg } } <- - sendAudio token (SendAudioRequest "" "audio_id" Nothing (Just "performer") (Just "title") Nothing Nothing) - msg `shouldBe` "Bad Request" --- it "should send audio" $ do --- Right MessageResponse { message_result = Message { audio = Just Audio { audio_title = Just title } } } <- --- sendAudio token (SendAudioRequest chatId "audio_id" Nothing (Just "performer") (Just "my title 1") Nothing) --- title `shouldBe` "my title 1" - - describe "/sendSticker" $ do - it "should send sticker" $ do - Right MessageResponse { message_result = Message { sticker = Just sticker } } <- - sendSticker token (SendStickerRequest chatId "BQADAgADGgADkWgMAAGXlYGBiM_d2wI" Nothing Nothing) - (sticker_file_id sticker) `shouldBe` "BQADAgADGgADkWgMAAGXlYGBiM_d2wI" - - describe "/sendLocation" $ do - it "should send location" $ do - Right MessageResponse { message_result = Message { location = Just loc } } <- - sendLocation token (SendLocationRequest chatId 52.38 4.9 Nothing Nothing) - (latitude loc) `shouldSatisfy` (liftM2 (&&) (> 52) (< 52.4)) - (longitude loc) `shouldSatisfy` (liftM2 (&&) (> 4.89) (< 5)) - - describe "/sendChatAction" $ do - it "should set typing action" $ do - Right ChatActionResponse { action_result = res} <- - sendChatAction token (SendChatActionRequest chatId Typing) - res `shouldBe` True - it "should set find location action" $ do - Right ChatActionResponse { action_result = res} <- - sendChatAction token (SendChatActionRequest chatId FindLocation) - res `shouldBe` True - it "should set upload photo action" $ do - Right ChatActionResponse { action_result = res} <- - sendChatAction token (SendChatActionRequest chatId UploadPhoto) - res `shouldBe` True - - describe "/getUpdates" $ do - it "should get all messages" $ do - Right UpdatesResponse { update_result = updates} <- - getUpdates token Nothing Nothing Nothing - (length updates) `shouldSatisfy` (>= 0) - - describe "/getFile" $ do - it "should get file" $ do - Right FileResponse { file_result = file } <- - getFile token "AAQEABMXDZEwAARC0Kj3twkzNcMkAAIC" - (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" - msg `shouldBe` "Bad Request" - - describe "/getUserProfilePhotos" $ do - it "should get user profile photos" $ do - Right UserProfilePhotosResponse { photos_result = photos } <- - getUserProfilePhotos token (read (T.unpack chatId)) Nothing Nothing - (total_count photos) `shouldSatisfy` (> 0) - - describe "/setWebhook" $ do - it "should set webhook" $ do - Right SetWebhookResponse { webhook_result = res } <- - setWebhook token (Just "https://example.com/secret_token") - res `shouldBe` True - - it "should remove webhook" $ do - Right SetWebhookResponse { webhook_result = res } <- - setWebhook token Nothing +{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TemplateHaskell #-}++module MainSpec (spec) where++import Control.Monad+import Web.Telegram.API.Bot+import Test.Hspec+import Data.Either (isRight, isLeft)+import Data.Text (Text)+import qualified Data.Text as T+import Servant.Client+import Servant.API+import Network.HTTP.Types.Status+import System.Environment++-- 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+ describe "/getMe" $ do+ it "responds with correct bot's name" $ do+ Right GetMeResponse { user_result = u } <-+ getMe token+ (user_first_name u) `shouldBe` botName -- "TelegramAPIBot"++ describe "/sendMessage" $ do+ it "should send message" $ do+ res <-sendMessage token (SendMessageRequest chatId "test message" Nothing Nothing Nothing Nothing)+ success res+ let Right MessageResponse { message_result = m } = res+ (text m) `shouldBe` (Just "test message")++ it "should return error message" $ do+ res <-sendMessage token (SendMessageRequest "" "test message" Nothing Nothing Nothing Nothing)+ nosuccess res+ let Left FailureResponse { responseStatus = Status { statusMessage = msg } } = res+ msg `shouldBe` "Bad Request"++ it "should send message markdown" $ do+ res <-sendMessage token (SendMessageRequest chatId "text *bold* _italic_ [github](github.com/klappvisor/telegram-api)" (Just Markdown) Nothing Nothing Nothing)+ success res+ let Right MessageResponse { message_result = m } = res+ (text m) `shouldBe` (Just "text bold italic github")++ it "should set keyboard" $ do+ res <-sendMessage token (SendMessageRequest chatId "set keyboard" Nothing Nothing Nothing (Just (ReplyKeyboardMarkup [["A", "B"], ["C"]] Nothing Nothing Nothing)))+ success res+ let Right MessageResponse { message_result = m } = res+ (text m) `shouldBe` (Just "set keyboard")++ it "should remove keyboard" $ do+ res <-sendMessage token (SendMessageRequest chatId "remove keyboard" Nothing Nothing Nothing (Just (ReplyKeyboardHide True Nothing)))+ success res+ let Right MessageResponse { message_result = m } = res+ (text m) `shouldBe` (Just "remove keyboard")++ it "should force reply" $ do+ res <-sendMessage token (SendMessageRequest chatId "force reply" Nothing Nothing Nothing (Just (ForceReply True Nothing)))+ success res+ let Right MessageResponse { message_result = m } = res+ (text m) `shouldBe` (Just "force reply")++ describe "/forwardMessage" $ do+ it "should forward message" $ do+ res <-forwardMessage token (ForwardMessageRequest chatId chatId 123)+ nosuccess res+ let Left FailureResponse { responseStatus = Status { statusMessage = msg } } = res+ msg `shouldBe` "Bad Request"++ describe "/sendPhoto" $ do+ it "should return error message" $ do+ Left FailureResponse { responseStatus = Status { statusMessage = msg } } <-+ sendPhoto token (SendPhotoRequest "" "photo_id" (Just "photo caption") Nothing Nothing)+ msg `shouldBe` "Bad Request"+ it "should send photo" $ do+ Right MessageResponse { message_result = Message { caption = Just cpt } } <-+ sendPhoto token (SendPhotoRequest chatId "AgADBAADv6cxGybVMgABtZ_EOpBSdxYD5xwZAAQ4ElUVMAsbbBqFAAIC" (Just "photo caption") Nothing Nothing)+ cpt `shouldBe` "photo caption"++ describe "/sendAudio" $ do+ it "should return error message" $ do+ Left FailureResponse { responseStatus = Status { statusMessage = msg } } <-+ sendAudio token (SendAudioRequest "" "audio_id" Nothing (Just "performer") (Just "title") Nothing Nothing)+ msg `shouldBe` "Bad Request"+-- it "should send audio" $ do+-- Right MessageResponse { message_result = Message { audio = Just Audio { audio_title = Just title } } } <-+-- sendAudio token (SendAudioRequest chatId "audio_id" Nothing (Just "performer") (Just "my title 1") Nothing)+-- title `shouldBe` "my title 1"++ describe "/sendSticker" $ do+ it "should send sticker" $ do+ Right MessageResponse { message_result = Message { sticker = Just sticker } } <-+ sendSticker token (SendStickerRequest chatId "BQADAgADGgADkWgMAAGXlYGBiM_d2wI" Nothing Nothing)+ (sticker_file_id sticker) `shouldBe` "BQADAgADGgADkWgMAAGXlYGBiM_d2wI"++ describe "/sendLocation" $ do+ it "should send location" $ do+ Right MessageResponse { message_result = Message { location = Just loc } } <-+ sendLocation token (SendLocationRequest chatId 52.38 4.9 Nothing Nothing)+ (latitude loc) `shouldSatisfy` (liftM2 (&&) (> 52) (< 52.4))+ (longitude loc) `shouldSatisfy` (liftM2 (&&) (> 4.89) (< 5))++ describe "/sendChatAction" $ do+ it "should set typing action" $ do+ Right ChatActionResponse { action_result = res} <-+ sendChatAction token (SendChatActionRequest chatId Typing)+ res `shouldBe` True+ it "should set find location action" $ do+ Right ChatActionResponse { action_result = res} <-+ sendChatAction token (SendChatActionRequest chatId FindLocation)+ res `shouldBe` True+ it "should set upload photo action" $ do+ Right ChatActionResponse { action_result = res} <-+ sendChatAction token (SendChatActionRequest chatId UploadPhoto)+ res `shouldBe` True++ describe "/getUpdates" $ do+ it "should get all messages" $ do+ Right UpdatesResponse { update_result = updates} <-+ getUpdates token Nothing Nothing Nothing+ (length updates) `shouldSatisfy` (>= 0)++ describe "/getFile" $ do+ it "should get file" $ do+ Right FileResponse { file_result = file } <-+ getFile token "AAQEABMXDZEwAARC0Kj3twkzNcMkAAIC"+ (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"+ msg `shouldBe` "Bad Request"++ describe "/getUserProfilePhotos" $ do+ it "should get user profile photos" $ do+ Right UserProfilePhotosResponse { photos_result = photos } <-+ getUserProfilePhotos token (read (T.unpack chatId)) Nothing Nothing+ (total_count photos) `shouldSatisfy` (> 0)++ describe "/setWebhook" $ do+ it "should set webhook" $ do+ Right SetWebhookResponse { webhook_result = res } <-+ setWebhook token (Just "https://example.com/secret_token")+ res `shouldBe` True++ it "should remove webhook" $ do+ Right SetWebhookResponse { webhook_result = res } <-+ setWebhook token Nothing res `shouldBe` True
test/Spec.hs view
@@ -1,42 +1,44 @@-{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TemplateHaskell #-} - -module Main (main) where - -import Control.Monad -import Web.Telegram.API.Bot -import Test.Hspec -import Data.Text (Text) -import qualified Data.Text as T -import Servant.Client -import Servant.API -import Network.HTTP.Types.Status -import System.Environment -import qualified MainSpec -import qualified InlineSpec - -main :: IO () -main = do - args <- getArgs - withArgs [] $ hspec (runSpec args) - --- Don't run integration tests if no token and chat id provided -runSpec :: [String] -> SpecWith () -runSpec [] = do - describe "NoTests" $ do - it "Does not run integration tests if no token and chat id provided" $ do - pending - -runSpec [tkn,cId] = do - let token = Token (T.pack tkn) - let chatId = T.pack cId - runSpec' token chatId - -runSpec' :: Token -> Text -> SpecWith () -runSpec' token chatId = do - describe "Main" $ MainSpec.spec token chatId - --describe "Inline" $ InlineSpec.spec token chatId+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TemplateHaskell #-}++module Main (main) where++import Control.Monad+import Web.Telegram.API.Bot+import Test.Hspec+import Data.Text (Text)+import qualified Data.Text as T+import Servant.Client+import Servant.API+import Network.HTTP.Types.Status+import System.Environment+import qualified MainSpec+import qualified InlineSpec++main :: IO ()+main = do+ args <- getArgs+ withArgs [] $ hspec (runSpec args)++-- Don't run integration tests if no token and chat id provided+runSpec :: [String] -> SpecWith ()+runSpec [] = do+ describe "NoTests" $ do+ it "Does not run integration tests if no token, chat id and boot name provided" $ do+ pending++runSpec [tkn,cId,bNm] = do+ let token = Token (T.pack tkn)+ let chatId = T.pack cId+ let botName = T.pack bNm+ runSpec' token chatId botName++runSpec' :: Token -> Text -> Text -> SpecWith ()+runSpec' token chatId botName = do+ describe "Main" $ MainSpec.spec token chatId botName+ --describe "Inline" $ InlineSpec.spec token chatId botName+