telegram-api 0.3.0.0 → 0.3.1.0
raw patch · 9 files changed
+235/−23 lines, 9 filesdep +bytestringdep +filepathdep +http-clientdep ~eitherdep ~servant-clientbinary-added
Dependencies added: bytestring, filepath, http-client, http-media, mime-types, string-conversions, transformers
Dependency ranges changed: either, servant-client
Files
- README.md +38/−3
- src/Servant/Client/MultipartFormData.hs +99/−0
- src/Web/Telegram/API/Bot/API.hs +15/−4
- src/Web/Telegram/API/Bot/Data.hs +1/−0
- src/Web/Telegram/API/Bot/Requests.hs +51/−5
- telegram-api.cabal +13/−3
- test-data/klappvisor.jpg binary
- test/MainSpec.hs +16/−7
- test/Spec.hs +2/−1
README.md view
@@ -1,5 +1,7 @@ # telegram-api +[](https://gitter.im/klappvisor/haskell-telegram-api?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) +    @@ -27,7 +29,7 @@ main = do Right GetMeResponse { user_result = u } <- getMe token - T.putStrLn (user_first_name u) + T.putStrLn (user_first_name u) where token = Token "bot<token>" -- entire Token should be bot123456:ABC-DEF1234ghIkl-zyx57W2v1u123ew11 ``` @@ -43,12 +45,45 @@ main = do Right MessageResponse { message_result = m } <- sendMessage token (SendMessageRequest chatId message (Just Markdown) Nothing Nothing Nothing) - T.putStrLn (message_id m) - T.putStrLn (text m) + T.putStrLn (message_id m) + T.putStrLn (text m) where token = Token "bot<token>" -- entire Token should be bot123456:ABC-DEF1234ghIkl-zyx57W2v1u123ew11 chatId = "<chat_id> or <@channelusername>" message = "text *bold* _italic_ [github](github.com/klappvisor/haskell-telegram-api)" ``` + +## Contribution + +Contributions are welcome! + +1. Fork repository +2. Do some changes +3. Create pull request +4. Wait for CI build and review +5. ?????? +6. PROFIT + +You can use `stack` to build project + +``` +stack build +``` + +To run test you have to create your own bot. Go to [BotFather](https://telegram.me/botfather) and create the bot. As the result you will have private bot's access token. Keep it safe! + +``` +stack test --test-arguments "$BOT_TOKEN $CHAT_ID $BOT_NAME" +``` + +where + +* `$BOT_TOKEN` is token obtained from BotFather with prefix `<token from BotFather>` +* `$CHAT_ID` can be id of your chat with your bot. Send some message to this chat in Telegram and do `curl "https://api.telegram.org/bot<replace_with_token>/getUpdates"`, you have to parse some JSON with your brain ;-) or any other suitable tool and you will find chat id there. +* `$BOT_NAME` name of your bot + +Note: Inline Spec is disabled for now... + +If everything is fine after test you will see receive a few new messages from your bot. ## TODO
+ src/Servant/Client/MultipartFormData.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++module Servant.Client.MultipartFormData+ ( ToMultipartFormData (..)+ , MultipartFormDataReqBody+ ) where++import Control.Exception+import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Trans.Either+import Data.ByteString.Lazy hiding (pack, filter, map, null, elem)+import Data.Proxy+import Data.String.Conversions+import Data.Typeable (Typeable)+import Network.HTTP.Client hiding (Proxy, path)+import qualified Network.HTTP.Client as Client+import Network.HTTP.Client.MultipartFormData+import Network.HTTP.Media+import Network.HTTP.Types+import qualified Network.HTTP.Types as H+import qualified Network.HTTP.Types.Header as HTTP+import Servant.API+import Servant.API.Post+import Servant.Client+import Servant.Common.Req++-- | A type that can be converted to a multipart/form-data value.+class ToMultipartFormData a where+ -- | Convert a Haskell value to a multipart/form-data-friendly intermediate type.+ toMultipartFormData :: a -> [Part]++-- | Extract the request body as a value of type @a@.+data MultipartFormDataReqBody a+ deriving (Typeable)++instance (ToMultipartFormData b, MimeUnrender ct a)+ => HasClient (MultipartFormDataReqBody b :> Post (ct ': cts) a) where+ type Client (MultipartFormDataReqBody b :> Post (ct ': cts) a)+ = b -> EitherT ServantError IO a+ clientWithRoute Proxy req baseurl reqData =+ let reqToRequest' req' baseurl' = do+ requestWithoutBody <- reqToRequest req' baseurl'+ formDataBody (toMultipartFormData reqData) requestWithoutBody+ in snd <$> performRequestCT' reqToRequest' (Proxy :: Proxy ct) H.methodPost req [200, 201, 202] baseurl++-- copied `performRequest` from servant-0.4.4.7, then modified so it takes a variant of `reqToRequest`+-- as an argument.+performRequest' :: (Req -> BaseUrl -> IO Request)+ -> Method -> Req -> (Int -> Bool) -> BaseUrl+ -> EitherT ServantError IO ( Int, ByteString, MediaType+ , [HTTP.Header], Response ByteString)+performRequest' reqToRequest' reqMethod req isWantedStatus reqHost = do+ partialRequest <- liftIO $ reqToRequest' req reqHost++ let request = partialRequest { Client.method = reqMethod+ , checkStatus = \ _status _headers _cookies -> Nothing+ }++ eResponse <- liftIO $ __withGlobalManager $ \ manager ->+ catchHttpException $+ Client.httpLbs request manager+ case eResponse of+ Left err ->+ left $ ConnectionError err++ Right response -> do+ let status = Client.responseStatus response+ body = Client.responseBody response+ hrds = Client.responseHeaders response+ status_code = statusCode status+ ct <- case lookup "Content-Type" $ Client.responseHeaders response of+ Nothing -> pure $ "application"//"octet-stream"+ Just t -> case parseAccept t of+ Nothing -> left $ InvalidContentTypeHeader (cs t) body+ Just t' -> pure t'+ unless (isWantedStatus status_code) $+ left $ FailureResponse status ct body+ return (status_code, body, ct, hrds, response)++-- copied `performRequestCT` from servant-0.4.4.7, then modified so it takes a variant of `reqToRequest`+-- as an argument.+performRequestCT' :: MimeUnrender ct result =>+ (Req -> BaseUrl -> IO Request) ->+ Proxy ct -> Method -> Req -> [Int] -> BaseUrl -> EitherT ServantError IO ([HTTP.Header], result)+performRequestCT' reqToRequest' ct reqMethod req wantedStatus reqHost = do+ let acceptCT = contentType ct+ (_status, respBody, respCT, hrds, _response) <-+ performRequest' reqToRequest' reqMethod (req { reqAccept = [acceptCT] }) (`elem` wantedStatus) reqHost+ unless (matches respCT (acceptCT)) $ left $ UnsupportedContentType respCT respBody+ case mimeUnrender ct respBody of+ Left err -> left $ DecodeFailure err respCT respBody+ Right val -> return (hrds, val)
src/Web/Telegram/API/Bot/API.hs view
@@ -11,6 +11,7 @@ , sendMessage , forwardMessage , sendPhoto + , sendPhotoById , sendAudio , sendDocument , sendSticker @@ -42,6 +43,7 @@ import GHC.TypeLits import Servant.API import Servant.Client +import Servant.Client.MultipartFormData import Web.Telegram.API.Bot.Data import Web.Telegram.API.Bot.Responses import Web.Telegram.API.Bot.Requests @@ -70,8 +72,11 @@ :> ReqBody '[JSON] ForwardMessageRequest :> Post '[JSON] MessageResponse :<|> TelegramToken :> "sendPhoto" - :> ReqBody '[JSON] SendPhotoRequest + :> MultipartFormDataReqBody (SendPhotoRequest FileUpload) :> Post '[JSON] MessageResponse + :<|> TelegramToken :> "sendPhoto" + :> ReqBody '[JSON] (SendPhotoRequest Text) + :> Post '[JSON] MessageResponse :<|> TelegramToken :> "sendAudio" :> ReqBody '[JSON] SendAudioRequest :> Post '[JSON] MessageResponse @@ -121,7 +126,8 @@ getMe_ :: Token -> EitherT ServantError IO GetMeResponse sendMessage_ :: Token -> SendMessageRequest -> EitherT ServantError IO MessageResponse forwardMessage_ :: Token -> ForwardMessageRequest -> EitherT ServantError IO MessageResponse -sendPhoto_ :: Token -> SendPhotoRequest -> EitherT ServantError IO MessageResponse +sendPhotoById_ :: Token -> SendPhotoRequest Text -> EitherT ServantError IO MessageResponse +sendPhoto_ :: Token -> SendPhotoRequest FileUpload -> EitherT ServantError IO MessageResponse sendAudio_ :: Token -> SendAudioRequest -> EitherT ServantError IO MessageResponse sendDocument_ :: Token -> SendDocumentRequest -> EitherT ServantError IO MessageResponse sendSticker_ :: Token -> SendStickerRequest -> EitherT ServantError IO MessageResponse @@ -138,6 +144,7 @@ :<|> sendMessage_ :<|> forwardMessage_ :<|> sendPhoto_ + :<|> sendPhotoById_ :<|> sendAudio_ :<|> sendDocument_ :<|> sendSticker_ @@ -165,9 +172,13 @@ forwardMessage :: Token -> ForwardMessageRequest -> IO (Either ServantError MessageResponse) forwardMessage = run forwardMessage_ --- | Use this method to send photos. On success, the sent 'Message' is returned. -sendPhoto :: Token -> SendPhotoRequest -> IO (Either ServantError MessageResponse) +-- | Use this method to upload and send photos. On success, the sent 'Message' is returned. +sendPhoto :: Token -> SendPhotoRequest FileUpload -> IO (Either ServantError MessageResponse) sendPhoto = run sendPhoto_ + +-- | Use this method to send photos that have already been uploaded. On success, the sent 'Message' is returned. +sendPhotoById :: Token -> SendPhotoRequest Text -> IO (Either ServantError MessageResponse) +sendPhotoById = run sendPhotoById_ -- | Use this method to send audio files, if you want Telegram clients to display them in the music player. Your audio must be in the .mp3 format. On success, the sent 'Message' is returned. Bots can currently send audio files of up to 50 MB in size, this limit may be changed in the future. --
src/Web/Telegram/API/Bot/Data.hs view
@@ -105,6 +105,7 @@ parseJSON "group" = pure Group parseJSON "supergroup" = pure Supergroup parseJSON "channel" = pure Channel + parseJSON _ = fail "Failed to parse ChatType" -- | Parse mode for text message data ParseMode = Markdown deriving (Show, Generic)
src/Web/Telegram/API/Bot/Requests.hs view
@@ -5,11 +5,14 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} -- | This module contains data objects which represents requests to Telegram Bot API module Web.Telegram.API.Bot.Requests ( -- * Types - SendMessageRequest (..) + FileUploadContent (..) + , FileUpload (..) + , SendMessageRequest (..) , ForwardMessageRequest (..) , SendPhotoRequest (..) , SendAudioRequest (..) @@ -26,15 +29,47 @@ import Data.Aeson import Data.Aeson.Types +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS import Data.Maybe import Data.Proxy import Data.Text (Text) import qualified Data.Text as T +import qualified Data.Text.Encoding as T import GHC.Generics import GHC.TypeLits +import Network.HTTP.Client.MultipartFormData +import Network.HTTP.Types.Header (hContentType) +import Network.Mime +import Servant.Client.MultipartFormData (ToMultipartFormData (..)) import Web.Telegram.API.Bot.JsonExt import Web.Telegram.API.Bot.Data +-- | This object represents data (image, video, ...) to upload. +data FileUploadContent = + FileUploadFile FilePath + | FileUploadBS BS.ByteString + | FileUploadLBS LBS.ByteString + +-- | This object represents data (image, video, ...) with mime type to upload. +data FileUpload = FileUpload + { + fileUpload_type :: MimeType -- ^ Mime type of the upload. + , fileUpload_content :: FileUploadContent -- ^ The payload/source to upload. + } + +fileUploadToPart :: Text -> FileUpload -> Part +fileUploadToPart inputName fileUpload = + let part = + case fileUpload_content fileUpload of + FileUploadFile path -> partFileSource inputName path + FileUploadBS bs -> partBS inputName bs + FileUploadLBS lbs -> partLBS inputName lbs + in part { partContentType = Just (fileUpload_type fileUpload) } + +utf8Part :: Text -> Text -> Part +utf8Part inputName = partBS inputName . T.encodeUtf8 + -- | This object represents request for 'sendMessage' data SendMessageRequest = SendMessageRequest { @@ -67,21 +102,31 @@ parseJSON = parseJsonDrop 8 -- | This object represents request for 'sendPhoto' -data SendPhotoRequest = SendPhotoRequest +data SendPhotoRequest payload = SendPhotoRequest { photo_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) - , photo_photo :: Text -- ^ Photo to send. Pass a file_id as String to resend a photo that is already on the Telegram servers + , photo_photo :: payload -- ^ Photo to send. Pass a file_id as String to resend a photo that is already on the Telegram servers , photo_caption :: Maybe Text -- ^ Photo caption (may also be used when resending photos by file_id), 0-200 characters. , photo_reply_to_message_id :: Maybe Int -- ^ If the message is a reply, ID of the original message , photo_reply_markup :: Maybe ReplyKeyboard -- ^ Additional interface options. A JSON-serialized object for a custom reply keyboard, instructions to hide keyboard or to force a reply from the user. } deriving (Show, Generic) -instance ToJSON SendPhotoRequest where +instance ToJSON (SendPhotoRequest Text) where toJSON = toJsonDrop 6 -instance FromJSON SendPhotoRequest where +instance FromJSON (SendPhotoRequest Text) where parseJSON = parseJsonDrop 6 +instance ToMultipartFormData (SendPhotoRequest FileUpload) where + toMultipartFormData sendPhotoReq = + [ utf8Part "chat_id" (photo_chat_id sendPhotoReq) ] ++ + catMaybes + [ utf8Part "caption" <$> photo_caption sendPhotoReq + , utf8Part "reply_to_message_id" . T.pack . show <$> photo_reply_to_message_id sendPhotoReq + , partLBS "reply_markup" . encode <$> photo_reply_markup sendPhotoReq + ] ++ + [ fileUploadToPart "photo" (photo_photo sendPhotoReq) ] + -- | This object represents request for 'sendAudio' data SendAudioRequest = SendAudioRequest { @@ -208,6 +253,7 @@ parseJSON "upload_audio" = pure UploadAudio parseJSON "upload_document" = pure UploadDocument parseJSON "find_location" = pure FindLocation + parseJSON _ = fail "Failed to parse ChatAction" -- | This object represents request for 'sendChatAction' data SendChatActionRequest = SendChatActionRequest
telegram-api.cabal view
@@ -1,5 +1,5 @@ name: telegram-api-version: 0.3.0.0+version: 0.3.1.0 synopsis: Telegram Bot API bindings description: High-level bindings to the Telegram Bot API homepage: http://github.com/klappvisor/haskell-telegram-api#readme@@ -12,6 +12,7 @@ build-type: Simple -- extra-source-files: cabal-version: >=1.10+data-files: test-data/klappvisor.jpg extra-source-files: README.md@@ -23,13 +24,21 @@ , Web.Telegram.API.Bot.Data , Web.Telegram.API.Bot.Responses , Web.Telegram.API.Bot.Requests+ , Servant.Client.MultipartFormData other-modules: Web.Telegram.API.Bot.JsonExt build-depends: base >= 4.7 && < 5 , aeson- , servant- , servant-client+ , servant == 0.4.*+ , servant-client == 0.4.* , text , either+ , http-client+ , http-media+ , http-types+ , mime-types+ , transformers+ , bytestring+ , string-conversions default-language: Haskell2010 test-suite telegram-api-test@@ -45,6 +54,7 @@ , servant-client , telegram-api , http-types+ , filepath ghc-options: -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010
+ test-data/klappvisor.jpg view
binary file changed (absent → 40274 bytes)
test/MainSpec.hs view
@@ -17,7 +17,10 @@ import Servant.API import Network.HTTP.Types.Status import System.Environment+import System.FilePath +import Paths_telegram_api+ -- to print out remote response if response success not match success, nosuccess :: (Show a, Show b) =>Either a b ->Expectation success e = e `shouldSatisfy` isRight@@ -78,22 +81,28 @@ 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)+ sendPhotoById token (SendPhotoRequest "" "photo_id" (Just "photo caption") Nothing Nothing) msg `shouldBe` "Bad Request"- it "should send photo" $ do+ it "should send photo with file_id" $ do Right MessageResponse { message_result = Message { caption = Just cpt } } <-- sendPhoto token (SendPhotoRequest chatId "AgADBAADv6cxGybVMgABtZ_EOpBSdxYD5xwZAAQ4ElUVMAsbbBqFAAIC" (Just "photo caption") Nothing Nothing)+ sendPhotoById token (SendPhotoRequest chatId "AgADBAADv6cxGybVMgABtZ_EOpBSdxYD5xwZAAS0kQ9gsy1eDh2FAAIC" (Just "photo caption") Nothing Nothing) cpt `shouldBe` "photo caption"+ it "should send uploaded photo" $ do+ dataDir <- getDataDir+ let fileUpload = FileUpload "image/jpeg" (FileUploadFile (dataDir </> "test-data/klappvisor.jpg"))+ Right MessageResponse { message_result = Message { caption = Just cpt } } <-+ sendPhoto token (SendPhotoRequest chatId fileUpload (Just "photo caption 2") Nothing Nothing)+ cpt `shouldBe` "photo caption 2" 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"+ it "should send audio" $ do+ Right MessageResponse { message_result = Message { audio = Just Audio { audio_title = Just title } } } <-+ sendAudio token (SendAudioRequest chatId "BQADBAADAQQAAiBOnQHThzc4cz1-IwI" Nothing Nothing Nothing Nothing Nothing)+ title `shouldBe` "The Nutcracker Suite - Act II, No.12. Pas de Deux variations" describe "/sendSticker" $ do it "should send sticker" $ do
test/Spec.hs view
@@ -8,6 +8,7 @@ module Main (main) where import Control.Monad+import Data.Monoid import Web.Telegram.API.Bot import Test.Hspec import Data.Text (Text)@@ -32,7 +33,7 @@ pending runSpec [tkn,cId,bNm] = do- let token = Token (T.pack tkn)+ let token = Token ("bot" <> T.pack tkn) let chatId = T.pack cId let botName = T.pack bNm runSpec' token chatId botName