telegram-api (empty) → 0.1.0.0
raw patch · 9 files changed
+1011/−0 lines, 9 filesdep +aesondep +basedep +eithersetup-changed
Dependencies added: aeson, base, either, hspec, http-types, servant, servant-client, telegram-api, text
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- src/Web/Telegram/API/Bot.hs +20/−0
- src/Web/Telegram/API/Bot/API.hs +200/−0
- src/Web/Telegram/API/Bot/Data.hs +264/−0
- src/Web/Telegram/API/Bot/Requests.hs +223/−0
- src/Web/Telegram/API/Bot/Responses.hs +101/−0
- telegram-api.cabal +47/−0
- test/Spec.hs +124/−0
+ LICENSE view
@@ -0,0 +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+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Web/Telegram/API/Bot.hs view
@@ -0,0 +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+import Web.Telegram.API.Bot.Requests
+ src/Web/Telegram/API/Bot/API.hs view
@@ -0,0 +1,200 @@+{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TemplateHaskell #-} + +module Web.Telegram.API.Bot.API + ( -- * Functions + getMe + , sendMessage + , forwardMessage + , sendPhoto + , sendAudio + , sendDocument + , sendSticker + , sendVideo + , sendVoice + , sendLocation + , sendChatAction + , getUpdates + , getFile + , getUserProfilePhotos + -- * API + , TelegramBotAPI + , api + -- * Types + , Token (..) + ) where + +import Control.Applicative +import Control.Monad.Trans.Either +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 Servant.API +import Servant.Client +import Web.Telegram.API.Bot.Data +import Web.Telegram.API.Bot.Responses +import Web.Telegram.API.Bot.Requests + +-- | Telegram Bot's Token +newtype Token = Token Text + deriving (Show, Eq, Ord) + +instance ToText Token where + toText (Token x) = x + +instance FromText Token where + fromText x = Just (Token (x)) + +-- | Type for token +type TelegramToken = Capture ":token" Token + +-- | Telegram Bot API +type TelegramBotAPI = + TelegramToken :> "getMe" + :> Get '[JSON] GetMeResponse + :<|> TelegramToken :> "sendMessage" + :> ReqBody '[JSON] SendMessageRequest + :> Post '[JSON] MessageResponse + :<|> TelegramToken :> "forwardMessage" + :> ReqBody '[JSON] ForwardMessageRequest + :> Post '[JSON] MessageResponse + :<|> TelegramToken :> "sendPhoto" + :> ReqBody '[JSON] SendPhotoRequest + :> Post '[JSON] MessageResponse + :<|> TelegramToken :> "sendAudio" + :> ReqBody '[JSON] SendAudioRequest + :> Post '[JSON] MessageResponse + :<|> TelegramToken :> "sendDocument" + :> ReqBody '[JSON] SendDocumentRequest + :> Post '[JSON] MessageResponse + :<|> TelegramToken :> "sendSticker" + :> ReqBody '[JSON] SendStickerRequest + :> Post '[JSON] MessageResponse + :<|> TelegramToken :> "sendVideo" + :> ReqBody '[JSON] SendVideoRequest + :> Post '[JSON] MessageResponse + :<|> TelegramToken :> "sendVoice" + :> ReqBody '[JSON] SendVoiceRequest + :> Post '[JSON] MessageResponse + :<|> TelegramToken :> "sendLocation" + :> ReqBody '[JSON] SendLocationRequest + :> Post '[JSON] MessageResponse + :<|> TelegramToken :> "sendChatAction" + :> ReqBody '[JSON] SendChatActionRequest + :> Post '[JSON] ChatActionResponse + :<|> TelegramToken :> "getUpdates" + :> QueryParam "offset" Int + :> QueryParam "limit" Int + :> QueryParam "timeout" Int + :> Get '[JSON] UpdatesResponse + :<|> TelegramToken :> "getFile" + :> QueryParam "file_id" Text + :> Get '[JSON] FileResponse + :<|> TelegramToken :> "getUserProfilePhotos" + :> QueryParam "user_id" Int + :> QueryParam "offset" Int + :> QueryParam "limit" Int + :> Get '[JSON] UserProfilePhotosResponse + +-- | Proxy for Thelegram Bot API +api :: Proxy TelegramBotAPI +api = Proxy + +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 +sendAudio_ :: Token -> SendAudioRequest -> EitherT ServantError IO MessageResponse +sendDocument_ :: Token -> SendDocumentRequest -> EitherT ServantError IO MessageResponse +sendSticker_ :: Token -> SendStickerRequest -> EitherT ServantError IO MessageResponse +sendVideo_ :: Token -> SendVideoRequest -> EitherT ServantError IO MessageResponse +sendVoice_ :: Token -> SendVoiceRequest -> EitherT ServantError IO MessageResponse +sendLocation_ :: Token -> SendLocationRequest -> EitherT ServantError IO MessageResponse +sendChatAction_ :: Token -> SendChatActionRequest -> EitherT ServantError IO ChatActionResponse +getUpdates_ :: Token -> Maybe Int -> Maybe Int -> Maybe Int -> EitherT ServantError IO UpdatesResponse +getFile_ :: Token -> Maybe Text -> EitherT ServantError IO FileResponse +getUserProfilePhotos_ :: Token -> Maybe Int -> Maybe Int -> Maybe Int -> EitherT ServantError IO UserProfilePhotosResponse +getMe_ + :<|> sendMessage_ + :<|> forwardMessage_ + :<|> sendPhoto_ + :<|> sendAudio_ + :<|> sendDocument_ + :<|> sendSticker_ + :<|> sendVideo_ + :<|> sendVoice_ + :<|> sendLocation_ + :<|> sendChatAction_ + :<|> getUpdates_ + :<|> getFile_ + :<|> getUserProfilePhotos_ = + client api + (BaseUrl Https "api.telegram.org" 443) +-- | A simple method for testing your bot's auth token. Requires no parameters. +-- Returns basic information about the bot in form of a 'User' object. +getMe :: Token -> IO (Either ServantError GetMeResponse) +getMe token = runEitherT $ getMe_ token + +-- | Use this method to send text messages. On success, the sent 'Message' is returned. +sendMessage :: Token -> SendMessageRequest -> IO (Either ServantError MessageResponse) +sendMessage token request = runEitherT $ sendMessage_ token request + +-- | Use this method to forward messages of any kind. On success, the sent 'Message' is returned. +forwardMessage :: Token -> ForwardMessageRequest -> IO (Either ServantError MessageResponse) +forwardMessage token request = runEitherT $ forwardMessage_ token request + +-- | Use this method to send photos. On success, the sent 'Message' is returned. +sendPhoto :: Token -> SendPhotoRequest -> IO (Either ServantError MessageResponse) +sendPhoto token request = runEitherT $ sendPhoto_ token request + +-- | 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. +-- +-- For backward compatibility, when the fields __title__ and __performer__ are both empty and the mime-type of the file to be sent is not _audio/mpeg_, the file will be sent as a playable voice message. For this to work, the audio must be in an .ogg file encoded with OPUS. This behavior will be phased out in the future. For sending voice messages, use the 'sendVoice' method instead. +sendAudio :: Token -> SendAudioRequest -> IO (Either ServantError MessageResponse) +sendAudio token request = runEitherT $ sendAudio_ token request + +-- | Use this method to send general files. On success, the sent 'Message' is returned. Bots can currently send files of any type of up to 50 MB in size, this limit may be changed in the future. +sendDocument :: Token -> SendDocumentRequest -> IO (Either ServantError MessageResponse) +sendDocument token request = runEitherT $ sendDocument_ token request + +-- | Use this method to send .webp stickers. On success, the sent 'Message' is returned. +sendSticker :: Token -> SendStickerRequest -> IO (Either ServantError MessageResponse) +sendSticker token request = runEitherT $ sendSticker_ token request + +-- | Use this method to send video files, Telegram clients support mp4 videos (other formats may be sent as 'Document'). On success, the sent 'Message' is returned. Bots can currently send video files of up to 50 MB in size, this limit may be changed in the future. +sendVideo :: Token -> SendVideoRequest -> IO (Either ServantError MessageResponse) +sendVideo token request = runEitherT $ sendVideo_ token request + +-- | Use this method to send audio files, if you want Telegram clients to display the file as a playable voice message. For this to work, your audio must be in an .ogg file encoded with OPUS (other formats may be sent as 'Audio' or 'Document'). On success, the sent 'Message' is returned. Bots can currently send voice messages of up to 50 MB in size, this limit may be changed in the future. +sendVoice :: Token -> SendVoiceRequest -> IO (Either ServantError MessageResponse) +sendVoice token request = runEitherT $ sendVoice_ token request + +-- | Use this method to send point on the map. On success, the sent 'Message' is returned. +sendLocation :: Token -> SendLocationRequest -> IO (Either ServantError MessageResponse) +sendLocation token request = runEitherT $ sendLocation_ token request + +-- | Use this method when you need to tell the user that something is happening on the bot's side. +-- The status is set for 5 seconds or less (when a message arrives from your bot, +-- Telegram clients clear its typing status). +sendChatAction :: Token -> SendChatActionRequest -> IO (Either ServantError ChatActionResponse) +sendChatAction token request = runEitherT $ sendChatAction_ token request + +-- | Use this method to receive incoming updates using long polling. An Array of 'Update' objects is returned. +getUpdates :: Token -> Maybe Int -> Maybe Int -> Maybe Int -> IO (Either ServantError UpdatesResponse) +getUpdates token offset limit timeout = runEitherT $ getUpdates_ token offset limit timeout + +getFile :: Token -> Text -> IO (Either ServantError FileResponse) +getFile token file_id = runEitherT $ getFile_ token (Just file_id) + +-- | Use this method to get a list of profile pictures for a user. Returns a 'UserProfilePhotos' object. +getUserProfilePhotos :: Token -> Int -> Maybe Int -> Maybe Int -> IO (Either ServantError UserProfilePhotosResponse) +getUserProfilePhotos token user_id offset limit = runEitherT $ getUserProfilePhotos_ token (Just user_id) offset limit
+ src/Web/Telegram/API/Bot/Data.hs view
@@ -0,0 +1,264 @@+{-# 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 (..) + , Chat (..) + , Message (..) + , PhotoSize (..) + , Audio (..) + , Document (..) + , Sticker (..) + , Video (..) + , Voice (..) + , Contact (..) + , Location (..) + , Update (..) + , File (..) + , UserProfilePhotos (..) + , ChatType (..) + ) 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.JsonExt + +-- | This object represents a Telegram user or bot. +data User = User + { + user_id :: Int -- ^ Unique identifier for this user or bot + , user_first_name :: Text -- ^ User‘s or bot’s first name + , user_last_name :: Maybe Text -- ^ User‘s or bot’s last name + , user_username :: Maybe Text -- ^ User‘s or bot’s username + } deriving (Show, Generic) + +instance ToJSON User where + toJSON = toJsonDrop 5 + +instance FromJSON User where + parseJSON = parseJsonDrop 5 + +-- | This object represents a phone contact. +data Contact = Contact + { + contact_phone_number :: Text -- ^ Contact's phone number + , contact_first_name :: Text -- ^ Contact's first name + , contact_last_name :: Maybe Text -- ^ Contact's last name + , contact_user_id :: Maybe Int -- ^ Contact's user identifier in Telegram + } deriving (Show, Generic) + +instance ToJSON Contact where + toJSON = toJsonDrop 8 + +instance FromJSON Contact where + parseJSON = parseJsonDrop 8 + +-- | This object represents a chat. +data Chat = Chat + { + chat_id :: Int -- ^ Unique identifier for this chat, not exceeding 1e13 by absolute value + , chat_type :: ChatType -- ^ Type of chat, can be either 'Private', 'Group', 'Supergroup' or 'Channel' + , chat_title :: Maybe Text -- ^ Title, for channels and group chats + , chat_username :: Maybe Text -- ^ Username, for private chats and channels if available + , chat_first_name :: Maybe Text -- ^ First name of the other party in a private chat + , chat_last_name :: Maybe Text -- ^ Last name of the other party in a private chat + } deriving (Show, Generic) + +instance ToJSON Chat where + toJSON = toJsonDrop 5 + +instance FromJSON Chat where + parseJSON = parseJsonDrop 5 + +-- | Type of chat. +data ChatType = Private + | Group + | Supergroup + | Channel deriving (Show, Generic) + +instance ToJSON ChatType where + toJSON Private = "private" + toJSON Group = "group" + toJSON Supergroup = "supergroup" + toJSON Channel = "channel" + +instance FromJSON ChatType where + parseJSON "private" = pure Private + parseJSON "group" = pure Group + parseJSON "supergroup" = pure Supergroup + parseJSON "channel" = pure Channel + +-- | This object represents one size of a photo or a 'File' / 'Sticker' thumbnail. +data PhotoSize = PhotoSize + { + photo_file_id :: Text -- ^ Unique identifier for this file + , photo_width :: Int -- ^ Photo width + , photo_height :: Int -- ^ Photo height + , photo_file_size :: Maybe Int -- ^ File size + } deriving (Show, Generic) + +instance ToJSON PhotoSize where + toJSON = toJsonDrop 6 + +instance FromJSON PhotoSize where + parseJSON = parseJsonDrop 6 + +-- | This object represents an audio file to be treated as music by the Telegram clients. +data Audio = Audio + { + audio_file_id :: Text -- ^ Unique identifier for this file + , audio_duration :: Int -- ^ Duration of the audio in seconds as defined by sender + , audio_performer :: Maybe Text -- ^ Performer of the audio as defined by sender or by audio tags + , audio_title :: Maybe Text -- ^ Title of the audio as defined by sender or by audio tags + , audio_mime_type :: Maybe Text -- ^ MIME type of the file as defined by sender + , audio_file_size :: Maybe Int -- ^ File size + } deriving (Show, Generic) + +instance ToJSON Audio where + toJSON = toJsonDrop 6 + +instance FromJSON Audio where + parseJSON = parseJsonDrop 6 + +-- | This object represents a general file (as opposed to 'PhotoSize', 'Voice' messages and 'Audio' files). +data Document = Document + { + doc_file_id :: Text -- ^ Unique file identifier + , doc_thumb :: Maybe PhotoSize -- ^ Document thumbnail as defined by sender + , doc_file_name :: Maybe Text -- ^ Original filename as defined by sender + , doc_mime_type :: Maybe Text -- ^ MIME type of the file as defined by sender + , doc_file_size :: Maybe Int -- ^ File size + } deriving (Show, Generic) + +instance ToJSON Document where + toJSON = toJsonDrop 4 + +instance FromJSON Document where + parseJSON = parseJsonDrop 4 + +-- | This object represents a sticker. +data Sticker = Sticker + { + sticker_file_id :: Text -- ^ Unique identifier for this file + , sticker_width :: Int -- ^ Sticker width + , sticker_height :: Int -- ^ Sticker height + , sticker_thumb :: Maybe PhotoSize -- ^ Sticker thumbnail in .webp or .jpg format + , sticker_file_size :: Maybe Int -- ^ File size + } deriving (Show, Generic) + +instance ToJSON Sticker where + toJSON = toJsonDrop 8 + +instance FromJSON Sticker where + parseJSON = parseJsonDrop 8 + +-- | This object represents a video file. +data Video = Video + { + video_file_id :: Text -- ^ Unique identifier for this file + , video_width :: Int -- ^ Video width as defined by sender + , video_height :: Int -- ^ Video height as defined by sender + , video_duration :: Int -- ^ Duration of the video in seconds as defined by sender + , video_thumb :: Maybe PhotoSize -- ^ Video thumbnail + , video_mime_type :: Maybe Text -- ^ MIME type of a file as defined by sender + , video_file_size :: Maybe Int -- ^ File size + } deriving (Show, Generic) + +instance ToJSON Video where + toJSON = toJsonDrop 6 + +instance FromJSON Video where + parseJSON = parseJsonDrop 6 + +-- | This object represents a voice note. +data Voice = Voice + { + voice_file_id :: Text -- ^ Unique identifier for this file + , voice_duration :: Int -- ^ Duration of the audio in seconds as defined by sender + , voice_mime_type :: Maybe Text -- ^ MIME type of the file as defined by sender + , voice_file_size :: Maybe Int -- ^ File size + } deriving (Show, Generic) + +instance ToJSON Voice where + toJSON = toJsonDrop 6 + +instance FromJSON Voice where + parseJSON = parseJsonDrop 6 + +-- | This object represents an incoming update. +-- Only one of the optional parameters can be present in any given update. +data Update = Update + { + update_id :: Int -- ^ The update's unique identifier. Update identifiers start from a certain positive number and increase sequentially. This ID becomes especially handy if you’re using 'setWebhooks', since it allows you to ignore repeated updates or to restore the correct update sequence, should they get out of order. + , message :: Message -- ^ New incoming message of any kind — text, photo, sticker, etc. + } deriving (FromJSON, ToJSON, Show, Generic) + +-- | This object represents a point on the map. +data Location = Location + { + longitude :: Float -- ^ Longitude as defined by sender + , latitude :: Float -- ^ Latitude as defined by sender + } deriving (FromJSON, ToJSON, Show, Generic) + +-- | This object represents a file ready to be downloaded. The file can be downloaded via the link +-- @https://api.telegram.org/file/bot<token>/<file_path>@. It is guaranteed that the link will be valid +-- for at least 1 hour. When the link expires, a new one can be requested by calling 'getFile'. +-- +-- Maximum file size to download is 20 MB +data File = File + { + file_id :: Text -- ^ Unique identifier for this file + , file_size :: Maybe Int -- ^ File size, if known + , file_path :: Maybe Text -- ^ File path. Use @https://api.telegram.org/file/bot<token>/<file_path>@ to get the file. + } deriving (FromJSON, ToJSON, Show, Generic) + +-- | This object represent a user's profile pictures. +data UserProfilePhotos = UserProfilePhotos + { + total_count :: Int -- ^ Total number of profile pictures the target user has + , photos :: [[PhotoSize]] -- ^ Requested profile pictures (in up to 4 sizes each) + } deriving (FromJSON, ToJSON, Show, Generic) + +-- | This object represents a message. +data Message = Message + { + message_id :: Int -- ^ Unique message identifier + , from :: User -- ^ Sender, can be empty for messages sent to channels + , date :: Int -- ^ Date the message was sent in Unix time + , chat :: Chat -- ^ Conversation the message belongs to + , forward_from :: Maybe User -- ^ For forwarded messages, sender of the original message + , forward_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. + , text :: Maybe Text -- ^ For text messages, the actual UTF-8 text of the message + , audio :: Maybe Audio -- ^ Message is an audio file, information about the file + , document :: Maybe Document -- ^ Message is a general file, information about the file + , photo :: Maybe [PhotoSize] -- ^ Message is a photo, available sizes of the photo + , sticker :: Maybe Sticker -- ^ Message is a sticker, information about the sticker + , video :: Maybe Video -- ^ Message is a video, information about the video + , voice :: Maybe Voice -- ^ Message is a voice message, information about the file + , caption :: Maybe Text -- ^ Caption for the photo or video + , contact :: Maybe Contact -- ^ Message is a shared contact, information about the contact + , location :: Maybe Location -- ^ Message is a shared location, information about the location + , new_chat_participant :: Maybe User -- ^ A new member was added to the group, information about them (this member may be the bot itself) + , left_chat_participant :: Maybe User -- ^ A member was removed from the group, information about them (this member may be the bot itself) + , new_chat_title :: Maybe Text -- ^ A chat title was changed to this value + , new_chat_photo :: Maybe [PhotoSize] -- ^ A chat photo was change to this value + , delete_chat_photo :: Maybe Bool -- ^ Service message: the chat photo was deleted + , group_chat_created :: Maybe Bool -- ^ Service message: the group has been created + , supergroup_chat_created :: Maybe Bool -- ^ Service message: the supergroup has been created + , channel_chat_created :: Maybe Bool -- ^ Service message: the channel has been created + , migrate_to_chat_id :: Maybe Int -- ^ The group has been migrated to a supergroup with the specified identifier, not exceeding 1e13 by absolute value + , migrate_from_chat_id :: Maybe Int -- ^ The supergroup has been migrated from a group with the specified identifier, not exceeding 1e13 by absolute value + } deriving (FromJSON, ToJSON, Show, Generic)
+ src/Web/Telegram/API/Bot/Requests.hs view
@@ -0,0 +1,223 @@+{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE FlexibleContexts #-} + +-- | This module contains data objects which represents requests to Telegram Bot API +module Web.Telegram.API.Bot.Requests + ( -- * Types + SendMessageRequest (..) + , ForwardMessageRequest (..) + , SendPhotoRequest (..) + , SendAudioRequest (..) + , SendDocumentRequest (..) + , SendStickerRequest (..) + , SendVideoRequest (..) + , SendVoiceRequest (..) + , SendLocationRequest (..) + , SendChatActionRequest (..) + , ParseMode (..) + , ChatAction (..) + ) 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.JsonExt + +-- | Parse mode for text message +data ParseMode = Markdown deriving (Show, Generic) + +instance ToJSON ParseMode where + toJSON Markdown = "Markdown" + +instance FromJSON ParseMode where + parseJSON "Markdown" = pure $ Markdown + parseJSON _ = fail "Failed to parse ParseMode" + +-- | This object represents request for 'sendMessage' +data SendMessageRequest = SendMessageRequest + { + message_chat_id :: Text + , message_text :: Text + , message_parse_mode :: Maybe ParseMode + , message_disable_web_page_preview :: Maybe Bool + , message_reply_to_message_id :: Maybe Int + } deriving (Show, Generic) + +instance ToJSON SendMessageRequest where + toJSON = toJsonDrop 8 + +instance FromJSON SendMessageRequest where + parseJSON = parseJsonDrop 8 + +-- | This object represents request for 'forwardMessage' +data ForwardMessageRequest = ForwardMessageRequest + { + forward_chat_id :: Text + , forward_from_chat_id :: Text + , forward_mesage_id :: Int + } deriving (Show, Generic) + +instance ToJSON ForwardMessageRequest where + toJSON = toJsonDrop 8 + +instance FromJSON ForwardMessageRequest where + parseJSON = parseJsonDrop 8 + +-- | This object represents request for 'sendPhoto' +data SendPhotoRequest = SendPhotoRequest + { + photo_chat_id :: Text + , photo_photo :: Text + , photo_caption :: Maybe Text + , photo_reply_to_message_id :: Maybe Int + } deriving (Show, Generic) + +instance ToJSON SendPhotoRequest where + toJSON = toJsonDrop 6 + +instance FromJSON SendPhotoRequest where + parseJSON = parseJsonDrop 6 + +-- | This object represents request for 'sendAudio' +data SendAudioRequest = SendAudioRequest + { + _audio_chat_id :: Text + , _audio_audio :: Text + , _audio_duration :: Maybe Int + , _audio_performer :: Maybe Text + , _audio_title :: Maybe Text + , _audio_reply_to_message_id :: Maybe Int + } deriving (Show, Generic) + +instance ToJSON SendAudioRequest where + toJSON = toJsonDrop 7 + +instance FromJSON SendAudioRequest where + parseJSON = parseJsonDrop 7 + +-- | This object represents request for 'sendSticker' +data SendStickerRequest = SendStickerRequest + { + sticker_chat_id :: Text + , sticker_sticker :: Text + , sticker_reply_to_message_id :: Maybe Int + } deriving (Show, Generic) + +instance ToJSON SendStickerRequest where + toJSON = toJsonDrop 8 + +instance FromJSON SendStickerRequest where + parseJSON = parseJsonDrop 8 + +-- | This object represents request for 'sendDocument' +data SendDocumentRequest = SendDocumentRequest + { + document_chat_id :: Text + , document_document :: Text + , document_reply_to_message_id :: Maybe Int + } deriving (Show, Generic) + +instance ToJSON SendDocumentRequest where + toJSON = toJsonDrop 9 + +instance FromJSON SendDocumentRequest where + parseJSON = parseJsonDrop 9 + +-- | This object represents request for 'sendVideo' +data SendVideoRequest = SendVideoRequest + { + _video_chat_id :: Text + , _video_video :: Text + , _video_duration :: Maybe Int + , _video_caption :: Maybe Text + , _video_reply_to_message_id :: Maybe Int + } deriving (Show, Generic) + +instance ToJSON SendVideoRequest where + toJSON = toJsonDrop 7 + +instance FromJSON SendVideoRequest where + parseJSON = parseJsonDrop 7 + +-- | This object represents request for 'sendVoice' +data SendVoiceRequest = SendVoiceRequest + { + _voice_chat_id :: Text + , _voice_voice :: Text + , _voice_duration :: Maybe Int + , _voice_reply_to_message_id :: Maybe Int + } deriving (Show, Generic) + +instance ToJSON SendVoiceRequest where + toJSON = toJsonDrop 7 + +instance FromJSON SendVoiceRequest where + parseJSON = parseJsonDrop 7 + +-- | This object represents request for 'sendLocation' +data SendLocationRequest = SendLocationRequest + { + location_chat_id :: Text + , location_latitude :: Float + , location_longitude :: Float + , location_reply_to_message_id :: Maybe Int + } deriving (Show, Generic) + +instance ToJSON SendLocationRequest where + toJSON = toJsonDrop 9 + +instance FromJSON SendLocationRequest where + parseJSON = parseJsonDrop 9 + +-- | Type of action to broadcast. +data ChatAction = Typing + | UploadPhoto + | RecordVideo + | UploadVideo + | RecordAudio + | UploadAudio + | UploadDocument + | FindLocation deriving (Show, Generic) + +instance ToJSON ChatAction where + toJSON Typing = "typing" + toJSON UploadPhoto = "upload_photo" + toJSON RecordVideo = "record_video" + toJSON UploadVideo = "upload_video" + toJSON RecordAudio = "record_audio" + toJSON UploadAudio = "upload_audio" + toJSON UploadDocument = "upload_cocument" + toJSON FindLocation = "find_location" + +instance FromJSON ChatAction where + parseJSON "typing" = pure Typing + parseJSON "upload_photo" = pure UploadPhoto + parseJSON "record_video" = pure RecordVideo + parseJSON "upload_video" = pure UploadVideo + parseJSON "record_audio" = pure RecordAudio + parseJSON "upload_audio" = pure UploadAudio + parseJSON "upload_cocument" = pure UploadDocument + parseJSON "find_location" = pure FindLocation + +-- | This object represents request for 'sendChatAction' +data SendChatActionRequest = SendChatActionRequest + { + action_chat_id :: Text + , action_action :: ChatAction + } deriving (Show, Generic) + +instance ToJSON SendChatActionRequest where + toJSON = toJsonDrop 7 + +instance FromJSON SendChatActionRequest where + parseJSON = parseJsonDrop 7
+ src/Web/Telegram/API/Bot/Responses.hs view
@@ -0,0 +1,101 @@+{-# 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 (..) + ) 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 + +-- | This object represents 'getMe' response +data GetMeResponse = GetMeResponse + { + user_result :: User + } deriving (Show, Generic) + +instance ToJSON GetMeResponse where + toJSON = toJsonDrop 5 + +instance FromJSON GetMeResponse where + parseJSON = parseJsonDrop 5 + +-- | 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 + +-- | 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 + +-- | 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 + +-- | 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 + +-- | 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
+ telegram-api.cabal view
@@ -0,0 +1,47 @@+name: telegram-api+version: 0.1.0.0+synopsis: Telegram Bot API bindings+description: High-level bindings to the Telegram Bots API+homepage: http://github.com/klappvisor/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++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+ 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+ 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/telegram-api
+ test/Spec.hs view
@@ -0,0 +1,124 @@+{-# 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++main :: IO ()+main = do+ [token, chatId] <- getArgs+ withArgs [] $ hspec (spec (Token (T.pack token)) (T.pack chatId))++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)+ (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)+ 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)+ (text m) `shouldBe` (Just "text bold italic github")++ 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)+ 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)+ 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)+ 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)+ (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)+ (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)+ ((message_id . message) (head updates)) `shouldSatisfy` (> 0)++ describe "/getFile" $ do+ it "should get file" $ do+ Right FileResponse { file_result = file } <-+ getFile token "AAQEABMXDZEwAARC0Kj3twkzNcMkAAIC"+ (file_path file) `shouldBe` (Just "thumb/file_2")++ 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)