diff --git a/src/Web/Telegram/API/Bot/API/Get.hs b/src/Web/Telegram/API/Bot/API/Get.hs --- a/src/Web/Telegram/API/Bot/API/Get.hs +++ b/src/Web/Telegram/API/Bot/API/Get.hs @@ -17,8 +17,8 @@ ) where import Data.Proxy -import Data.Text (Text) -import Network.HTTP.Client (Manager) +import Data.Text (Text) +import Network.HTTP.Client (Manager) import Servant.API import Servant.Client import Web.Telegram.API.Bot.API.Core @@ -32,7 +32,7 @@ :> QueryParam "file_id" Text :> Get '[JSON] FileResponse :<|> TelegramToken :> "getUserProfilePhotos" - :> QueryParam "user_id" Int + :> QueryParam "user_id" Integer :> QueryParam "offset" Int :> QueryParam "limit" Int :> Get '[JSON] UserProfilePhotosResponse @@ -43,7 +43,7 @@ getMe_ :: Token -> ClientM GetMeResponse getFile_ :: Token -> Maybe Text -> ClientM FileResponse -getUserProfilePhotos_ :: Token -> Maybe Int -> Maybe Int -> Maybe Int -> ClientM UserProfilePhotosResponse +getUserProfilePhotos_ :: Token -> Maybe Integer -> Maybe Int -> Maybe Int -> ClientM UserProfilePhotosResponse getMe_ :<|> getFile_ :<|> getUserProfilePhotos_ @@ -67,9 +67,9 @@ getFileM fileId = run_ getFile_ (Just fileId) -- | Use this method to get a list of profile pictures for a user. Returns a 'UserProfilePhotos' object. -getUserProfilePhotos :: Token -> Int -> Maybe Int -> Maybe Int -> Manager -> IO (Either ServantError UserProfilePhotosResponse) +getUserProfilePhotos :: Token -> Integer -> Maybe Int -> Maybe Int -> Manager -> IO (Either ServantError UserProfilePhotosResponse) getUserProfilePhotos token userId offset limit = runClient (getUserProfilePhotosM userId offset limit) token -- | See 'getUserProfilePhotos' -getUserProfilePhotosM :: Int -> Maybe Int -> Maybe Int -> TelegramClient UserProfilePhotosResponse +getUserProfilePhotosM :: Integer -> Maybe Int -> Maybe Int -> TelegramClient UserProfilePhotosResponse getUserProfilePhotosM userId offset limit = asking $ \t -> getUserProfilePhotos_ t (Just userId) offset limit diff --git a/src/Web/Telegram/API/Bot/API/Updates.hs b/src/Web/Telegram/API/Bot/API/Updates.hs --- a/src/Web/Telegram/API/Bot/API/Updates.hs +++ b/src/Web/Telegram/API/Bot/API/Updates.hs @@ -6,6 +6,7 @@ ( -- * Functions getUpdates , getUpdatesM + , getUpdatesM' , setWebhook , setWebhookM , setWebhookWithCertificate @@ -19,8 +20,8 @@ , updatesApi ) where -import Data.Proxy import Data.Maybe +import Data.Proxy import Data.Text (Text, empty) import Network.HTTP.Client (Manager) import Servant.API @@ -61,7 +62,7 @@ :<|> deleteWebhook_ :<|> getWebhookInfo_ = client updatesApi --- | Use this method to receive incoming updates using long polling. An Array of 'Update' objects is returned. Use `getUpdateM` for more features +-- | Use this method to receive incoming updates using long polling. A list of 'Update' objects is returned. Use `getUpdatesM` for more features getUpdates :: Token -> Maybe Int -- ^ offset @@ -69,16 +70,16 @@ -> Maybe Int -- ^ timeout -> Manager -> IO (Either ServantError UpdatesResponse) -getUpdates token offset limit timeout = runClient (getUpdatesM' request) token +getUpdates token offset limit timeout = runClient (getUpdatesM request) token where request = GetUpdatesRequest offset limit timeout Nothing --- | Get update with default parameters See 'getUpdate' for details. -getUpdatesM :: TelegramClient UpdatesResponse -getUpdatesM = getUpdatesM' getUpdatesRequest +-- | Get update with default parameters See 'getUpdates' for details. +getUpdatesM' :: TelegramClient UpdatesResponse +getUpdatesM' = getUpdatesM getUpdatesRequest -- | See 'getUpdates' -getUpdatesM' :: GetUpdatesRequest -> TelegramClient UpdatesResponse -getUpdatesM' = run_ getUpdates_ +getUpdatesM :: GetUpdatesRequest -> TelegramClient UpdatesResponse +getUpdatesM = run_ getUpdates_ -- | Use this method to specify a url and receive incoming updates via an outgoing webhook. Whenever there is an update for the bot, we will send an HTTPS POST request to the specified url, containing a JSON-serialized 'Update'. In case of an unsuccessful request, we will give up after a reasonable amount of attempts. -- @@ -104,7 +105,7 @@ setWebhookWithCertificateM :: SetWebhookRequest -> TelegramClient SetWebhookResponse setWebhookWithCertificateM = run_ setWebhookWithCert_ --- | Use this method to remove webhook integration if you decide to switch back to getUpdates. Returns True on success. +-- | Use this method to remove webhook integration if you decide to switch back to 'getUpdates'. Returns True on success. deleteWebhook :: Token -> Manager -> IO (Either ServantError (Response Bool)) deleteWebhook = runClient deleteWebhookM 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 @@ -5,7 +5,8 @@ -- | This module contains data objects which represents requests to Telegram Bot API module Web.Telegram.API.Bot.Requests ( -- * Types - SendMessageRequest (..) + ChatId (..) + , SendMessageRequest (..) , ForwardMessageRequest (..) , FileUpload (..) , FileUploadContent (..) @@ -68,6 +69,7 @@ ) where import Data.Aeson +import Data.Aeson.Types (typeMismatch) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import Data.Maybe @@ -120,14 +122,14 @@ -- | This object represents request for 'setWebhookWithCertificate' data SetWebhookRequest = SetWebhookRequest { - webhook_url :: Text -- ^ HTTPS url to send updates to. Use `setWebhook` function and an empty string to remove webhook integration - , webhook_certificate :: FileUpload -- ^ Upload your public key certificate so that the root certificate in use can be checked. + webhook_url :: Text -- ^ HTTPS url to send updates to. Use `setWebhook` function and an empty string to remove webhook integration + , webhook_certificate :: FileUpload -- ^ Upload your public key certificate so that the root certificate in use can be checked. , webhook_max_connections :: Maybe Int -- TODO: implement , webhook_allowed_updates :: Maybe [Text] } | SetWebhookWithoutCertRequest { - webhook_url :: Text + webhook_url :: Text , webhook_max_connections :: Maybe Int , webhook_allowed_updates :: Maybe [Text] } deriving (Generic) @@ -144,7 +146,7 @@ [ utf8Part "url" $ webhook_url req , fileUploadToPart "certificate" $ webhook_certificate req ] ++ catMaybes - [ utf8Part "max_connections" . T.pack . show <$> webhook_max_connections req + [ utf8Part "max_connections" . tshow <$> webhook_max_connections req -- TODO: , ??? "allowed_updates" ??? <$> webhook_allowed_updates req ] @@ -156,9 +158,9 @@ data GetUpdatesRequest = GetUpdatesRequest { - updates_offset :: Maybe Int -- ^ Identifier of the first update to be returned. Must be greater by one than the highest among the identifiers of previously received updates. By default, updates starting with the earliest unconfirmed update are returned. An update is considered confirmed as soon as 'getUpdates' is called with an offset higher than its update_id. The negative offset can be specified to retrieve updates starting from -offset update from the end of the updates queue. All previous updates will forgotten. - , updates_limit :: Maybe Int -- ^ Limits the number of updates to be retrieved. Values between 1—100 are accepted. Defaults to 100. - , updates_timeout :: Maybe Int -- ^ Timeout in seconds for long polling. Defaults to 0, i.e. usual short polling. Should be positive, short polling should be used for testing purposes only. + updates_offset :: Maybe Int -- ^ Identifier of the first update to be returned. Must be greater by one than the highest among the identifiers of previously received updates. By default, updates starting with the earliest unconfirmed update are returned. An update is considered confirmed as soon as 'getUpdates' is called with an offset higher than its update_id. The negative offset can be specified to retrieve updates starting from -offset update from the end of the updates queue. All previous updates will forgotten. + , updates_limit :: Maybe Int -- ^ Limits the number of updates to be retrieved. Values between 1—100 are accepted. Defaults to 100. + , updates_timeout :: Maybe Int -- ^ Timeout in seconds for long polling. Defaults to 0, i.e. usual short polling. Should be positive, short polling should be used for testing purposes only. , updates_allowed_updates :: Maybe [Text] -- ^ List the types of updates you want your bot to receive. For example, specify [“message”, “edited_channel_post”, “callback_query”] to only receive updates of these types. See 'Update' for a complete list of available update types. Specify an empty list to receive all updates regardless of type (default). If not specified, the previous setting will be used. } deriving (Show, Generic) @@ -171,10 +173,27 @@ getUpdatesRequest :: GetUpdatesRequest getUpdatesRequest = GetUpdatesRequest Nothing Nothing Nothing Nothing +-- | Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) +data ChatId = ChatId Integer | ChatChannel Text + deriving (Show) + +instance ToJSON ChatId where + toJSON (ChatId integer) = toJSON integer + toJSON (ChatChannel text) = String text + +instance FromJSON ChatId where + parseJSON value@Number{} = ChatId <$> parseJSON value + parseJSON (String text) = pure $ ChatChannel text + parseJSON wat = typeMismatch "Integer or String" wat + +chatIdToPart :: ChatId -> Text +chatIdToPart (ChatId integer) = tshow integer +chatIdToPart (ChatChannel text) = text + -- | This object represents request for 'sendMessage' data SendMessageRequest = SendMessageRequest { - message_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) + message_chat_id :: ChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) , message_text :: Text -- ^ Text of the message to be sent , message_parse_mode :: Maybe ParseMode -- ^ Send 'Markdown', if you want Telegram apps to show bold, italic and inline URLs in your bot's message , message_disable_web_page_preview :: Maybe Bool -- ^ Disables link previews for links in this message @@ -189,14 +208,14 @@ instance FromJSON SendMessageRequest where parseJSON = parseJsonDrop 8 -sendMessageRequest :: Text -> Text -> SendMessageRequest +sendMessageRequest :: ChatId -> Text -> SendMessageRequest sendMessageRequest chatId text = SendMessageRequest chatId text Nothing Nothing Nothing Nothing Nothing -- | This object represents request for 'forwardMessage' data ForwardMessageRequest = ForwardMessageRequest { - forward_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) - , forward_from_chat_id :: Text -- ^ Unique identifier for the chat where the original message was sent (or channel username in the format @@channelusername@) + forward_chat_id :: ChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) + , forward_from_chat_id :: ChatId -- ^ Unique identifier for the chat where the original message was sent (or channel username in the format @@channelusername@) , forward_disable_notification :: Maybe Bool -- ^ Sends the message silently. iOS users will not receive a notification, Android users will receive a notification with no sound. , forward_message_id :: Int -- ^ Unique message identifier } deriving (Show, Generic) @@ -207,13 +226,13 @@ instance FromJSON ForwardMessageRequest where parseJSON = parseJsonDrop 8 -forwardMessageRequest :: Text -> Text -> Int -> ForwardMessageRequest +forwardMessageRequest :: ChatId -> ChatId -> Int -> ForwardMessageRequest forwardMessageRequest chatId fromChatId forwardMessageId = ForwardMessageRequest chatId fromChatId Nothing forwardMessageId -- | This object represents request for 'sendPhoto' 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_chat_id :: ChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) , photo_photo :: payload -- ^ Photo to send. You can either pass a file_id as String to resend a photo that is already on the Telegram servers, or upload a new photo. , photo_caption :: Maybe Text -- ^ Photo caption (may also be used when resending photos by file_id), 0-200 characters. , photo_disable_notification :: Maybe Bool -- ^ Sends the message silently. iOS users will not receive a notification, Android users will receive a notification with no sound. @@ -227,19 +246,19 @@ instance FromJSON (SendPhotoRequest Text) where parseJSON = parseJsonDrop 6 -sendPhotoRequest :: Text -> Text -> SendPhotoRequest Text +sendPhotoRequest :: ChatId -> Text -> SendPhotoRequest Text sendPhotoRequest chatId photo = SendPhotoRequest chatId photo Nothing Nothing Nothing Nothing -uploadPhotoRequest :: Text -> FileUpload -> SendPhotoRequest FileUpload +uploadPhotoRequest :: ChatId -> FileUpload -> SendPhotoRequest FileUpload uploadPhotoRequest chatId photo = SendPhotoRequest chatId photo Nothing Nothing Nothing Nothing instance ToMultipartFormData (SendPhotoRequest FileUpload) where toMultipartFormData req = - [ utf8Part "chat_id" (photo_chat_id req) ] ++ + [ utf8Part "chat_id" (chatIdToPart $ photo_chat_id req) ] ++ catMaybes [ utf8Part "caption" <$> photo_caption req , partLBS "disable_notification" . encode <$> photo_disable_notification req - , utf8Part "reply_to_message_id" . T.pack . show <$> photo_reply_to_message_id req + , utf8Part "reply_to_message_id" . tshow <$> photo_reply_to_message_id req , partLBS "reply_markup" . encode <$> photo_reply_markup req ] ++ [ fileUploadToPart "photo" (photo_photo req) ] @@ -247,7 +266,7 @@ -- | This object represents request for 'sendAudio' data SendAudioRequest payload = SendAudioRequest { - _audio_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) + _audio_chat_id :: ChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) , _audio_audio :: payload -- ^ Audio to send. You can either pass a file_id as String to resend an audio that is already on the Telegram servers, or upload a new audio file. , _audio_caption :: Maybe Text -- ^ Audio caption, 0-200 characters , _audio_duration :: Maybe Int -- ^ Duration of the audio in seconds @@ -266,27 +285,27 @@ instance ToMultipartFormData (SendAudioRequest FileUpload) where toMultipartFormData req = - [ utf8Part "chat_id" (_audio_chat_id req) ] ++ + [ utf8Part "chat_id" (chatIdToPart $ _audio_chat_id req) ] ++ catMaybes - [ utf8Part "duration" . T.pack . show <$> _audio_duration req + [ utf8Part "duration" . tshow <$> _audio_duration req , utf8Part "performer" <$> _audio_performer req , utf8Part "title" <$> _audio_title req , partLBS "disable_notification" . encode <$> _audio_disable_notification req - , utf8Part "reply_to_message_id" . T.pack . show <$> _audio_reply_to_message_id req + , utf8Part "reply_to_message_id" . tshow <$> _audio_reply_to_message_id req , partLBS "reply_markup" . encode <$> _audio_reply_markup req ] ++ [ fileUploadToPart "audio" (_audio_audio req) ] -sendAudioRequest :: Text -> Text -> SendAudioRequest Text +sendAudioRequest :: ChatId -> Text -> SendAudioRequest Text sendAudioRequest chatId audio = SendAudioRequest chatId audio Nothing Nothing Nothing Nothing Nothing Nothing Nothing -uploadAudioRequest :: Text -> FileUpload -> SendAudioRequest FileUpload +uploadAudioRequest :: ChatId -> FileUpload -> SendAudioRequest FileUpload uploadAudioRequest chatId audio = SendAudioRequest chatId audio Nothing Nothing Nothing Nothing Nothing Nothing Nothing -- | This object represents request for 'sendSticker' data SendStickerRequest payload = SendStickerRequest { - sticker_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) + sticker_chat_id :: ChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) , sticker_sticker :: payload -- ^ Sticker to send. You can either pass a file_id as String to resend a sticker that is already on the Telegram servers, or upload a new sticker. , sticker_disable_notification :: Maybe Bool -- ^ Sends the message silently. iOS users will not receive a notification, Android users will receive a notification with no sound. , sticker_reply_to_message_id :: Maybe Int -- ^ If the message is a reply, ID of the original message @@ -301,24 +320,24 @@ instance ToMultipartFormData (SendStickerRequest FileUpload) where toMultipartFormData req = - [ utf8Part "chat_id" (sticker_chat_id req) ] ++ + [ utf8Part "chat_id" (chatIdToPart $ sticker_chat_id req) ] ++ catMaybes [ partLBS "disable_notification" . encode <$> sticker_disable_notification req - , utf8Part "reply_to_message_id" . T.pack . show <$> sticker_reply_to_message_id req + , utf8Part "reply_to_message_id" . tshow <$> sticker_reply_to_message_id req , partLBS "reply_markup" . encode <$> sticker_reply_markup req ] ++ [ fileUploadToPart "sticker" (sticker_sticker req) ] -sendStickerRequest :: Text -> Text -> SendStickerRequest Text +sendStickerRequest :: ChatId -> Text -> SendStickerRequest Text sendStickerRequest chatId sticker = SendStickerRequest chatId sticker Nothing Nothing Nothing -uploadStickerRequest :: Text -> FileUpload -> SendStickerRequest FileUpload +uploadStickerRequest :: ChatId -> FileUpload -> SendStickerRequest FileUpload uploadStickerRequest chatId sticker = SendStickerRequest chatId sticker Nothing Nothing Nothing -- | This object represents request for 'sendDocument' data SendDocumentRequest payload = SendDocumentRequest { - document_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) + document_chat_id :: ChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) , document_document :: payload -- ^ File to send. You can either pass a file_id as String to resend a file that is already on the Telegram servers, or upload a new file. , document_caption :: Maybe Text -- ^ Document caption (may also be used when resending documents by file_id), 0-200 characters , document_disable_notification :: Maybe Bool -- ^ Sends the message silently. iOS users will not receive a notification, Android users will receive a notification with no sound. @@ -334,25 +353,25 @@ instance ToMultipartFormData (SendDocumentRequest FileUpload) where toMultipartFormData req = - [ utf8Part "chat_id" (document_chat_id req) ] ++ + [ utf8Part "chat_id" (chatIdToPart $ document_chat_id req) ] ++ catMaybes [ utf8Part "caption" <$> document_caption req , partLBS "disable_notification" . encode <$> document_disable_notification req - , utf8Part "reply_to_message_id" . T.pack . show <$> document_reply_to_message_id req + , utf8Part "reply_to_message_id" . tshow <$> document_reply_to_message_id req , partLBS "reply_markup" . encode <$> document_reply_markup req ] ++ [ fileUploadToPart "document" (document_document req) ] -sendDocumentRequest :: Text -> Text -> SendDocumentRequest Text +sendDocumentRequest :: ChatId -> Text -> SendDocumentRequest Text sendDocumentRequest chatId document = SendDocumentRequest chatId document Nothing Nothing Nothing Nothing -uploadDocumentRequest :: Text -> FileUpload -> SendDocumentRequest FileUpload +uploadDocumentRequest :: ChatId -> FileUpload -> SendDocumentRequest FileUpload uploadDocumentRequest chatId document = SendDocumentRequest chatId document Nothing Nothing Nothing Nothing -- | This object represents request for 'sendVideo' data SendVideoRequest payload = SendVideoRequest { - _video_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) + _video_chat_id :: ChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) , _video_video :: payload -- ^ Video to send. You can either pass a file_id as String to resend a video that is already on the Telegram servers, or upload a new video. , _video_duration :: Maybe Int -- ^ Duration of sent video in seconds , _video_caption :: Maybe Text -- ^ Video caption, 0-200 characters. @@ -369,26 +388,26 @@ instance ToMultipartFormData (SendVideoRequest FileUpload) where toMultipartFormData req = - [ utf8Part "chat_id" (_video_chat_id req) ] ++ + [ utf8Part "chat_id" (chatIdToPart $ _video_chat_id req) ] ++ catMaybes [ partLBS "duration" . encode <$> _video_duration req , utf8Part "caption" <$> _video_caption req , partLBS "disable_notification" . encode <$> _video_disable_notification req - , utf8Part "reply_to_message_id" . T.pack . show <$> _video_reply_to_message_id req + , utf8Part "reply_to_message_id" . tshow <$> _video_reply_to_message_id req , partLBS "reply_markup" . encode <$> _video_reply_markup req ] ++ [ fileUploadToPart "video" (_video_video req) ] -sendVideoRequest :: Text -> Text -> SendVideoRequest Text +sendVideoRequest :: ChatId -> Text -> SendVideoRequest Text sendVideoRequest chatId video = SendVideoRequest chatId video Nothing Nothing Nothing Nothing Nothing -uploadVideoRequest :: Text -> FileUpload -> SendVideoRequest FileUpload +uploadVideoRequest :: ChatId -> FileUpload -> SendVideoRequest FileUpload uploadVideoRequest chatId video = SendVideoRequest chatId video Nothing Nothing Nothing Nothing Nothing -- | This object represents request for 'sendVoice' data SendVoiceRequest payload = SendVoiceRequest { - _voice_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) + _voice_chat_id :: ChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) , _voice_voice :: payload -- ^ Audio file to send. You can either pass a file_id as String to resend an audio that is already on the Telegram servers, or upload a new audio file. , _voice_caption :: Maybe Text -- ^ Voice message caption, 0-200 characters , _voice_duration :: Maybe Int -- ^ Duration of sent audio in seconds @@ -405,25 +424,25 @@ instance ToMultipartFormData (SendVoiceRequest FileUpload) where toMultipartFormData req = - [ utf8Part "chat_id" (_voice_chat_id req) ] ++ + [ utf8Part "chat_id" (chatIdToPart $ _voice_chat_id req) ] ++ catMaybes [ partLBS "duration" . encode <$> _voice_duration req , partLBS "disable_notification" . encode <$> _voice_disable_notification req - , utf8Part "reply_to_message_id" . T.pack . show <$> _voice_reply_to_message_id req + , utf8Part "reply_to_message_id" . tshow <$> _voice_reply_to_message_id req , partLBS "reply_markup" . encode <$> _voice_reply_markup req ] ++ [ fileUploadToPart "voice" (_voice_voice req) ] -sendVoiceRequest :: Text -> Text -> SendVoiceRequest Text +sendVoiceRequest :: ChatId -> Text -> SendVoiceRequest Text sendVoiceRequest chatId voice = SendVoiceRequest chatId voice Nothing Nothing Nothing Nothing Nothing -uploadVoiceRequest :: Text -> FileUpload -> SendVoiceRequest FileUpload +uploadVoiceRequest :: ChatId -> FileUpload -> SendVoiceRequest FileUpload uploadVoiceRequest chatId voice = SendVoiceRequest chatId voice Nothing Nothing Nothing Nothing Nothing -- | This object represents request for 'sendLocation' data SendLocationRequest = SendLocationRequest { - location_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) + location_chat_id :: ChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) , location_latitude :: Float -- ^ Latitude of location , location_longitude :: Float -- ^ Longitude of location , location_disable_notification :: Maybe Bool -- ^ Sends the message silently. iOS users will not receive a notification, Android users will receive a notification with no sound. @@ -437,13 +456,13 @@ instance FromJSON SendLocationRequest where parseJSON = parseJsonDrop 9 -sendLocationRequest :: Text -> Float -> Float -> SendLocationRequest +sendLocationRequest :: ChatId -> Float -> Float -> SendLocationRequest sendLocationRequest chatId latitude longitude = SendLocationRequest chatId latitude longitude Nothing Nothing Nothing -- | This object represents request for 'sendVenue' data SendVenueRequest = SendVenueRequest { - _venue_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) + _venue_chat_id :: ChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) , _venue_latitude :: Float -- ^ Latitude of the venue , _venue_longitude :: Float -- ^ Longitude of the venue , _venue_title :: Text -- ^ Name of the venue @@ -460,13 +479,13 @@ instance FromJSON SendVenueRequest where parseJSON = parseJsonDrop 7 -sendVenueRequest :: Text -> Float -> Float -> Text -> Text -> SendVenueRequest +sendVenueRequest :: ChatId -> Float -> Float -> Text -> Text -> SendVenueRequest sendVenueRequest chatId latitude longitude title address = SendVenueRequest chatId latitude longitude title address Nothing Nothing Nothing Nothing -- | This object represents request for 'sendContact' data SendContactRequest = SendContactRequest { - _contact_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) + _contact_chat_id :: ChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @@channelusername@) , _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 @@ -481,7 +500,7 @@ instance FromJSON SendContactRequest where parseJSON = parseJsonDrop 9 -sendContactRequest :: Text -> Text -> Text -> SendContactRequest +sendContactRequest :: ChatId -> Text -> Text -> SendContactRequest sendContactRequest chatId phoneNumber firstName = SendContactRequest chatId phoneNumber firstName Nothing Nothing Nothing Nothing -- | Type of action to broadcast. @@ -518,7 +537,7 @@ -- | This object represents request for 'sendChatAction' data SendChatActionRequest = SendChatActionRequest { - action_chat_id :: Text -- ^ Unique identifier for the target chat or username of the target channel (in the format `@channelusername`) + action_chat_id :: ChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format `@channelusername`) , action_action :: ChatAction -- ^ Type of action to broadcast. } deriving (Show, Generic) @@ -528,13 +547,13 @@ instance FromJSON SendChatActionRequest where parseJSON = parseJsonDrop 7 -sendChatActionRequest :: Text -> ChatAction -> SendChatActionRequest +sendChatActionRequest :: ChatId -> ChatAction -> SendChatActionRequest sendChatActionRequest = SendChatActionRequest -- | This object represents request for 'sendGame' data SendGameRequest = SendGameRequest { - game_chat_id :: Text -- ^ Unique identifier for the target chat + game_chat_id :: Integer -- ^ Unique identifier for the target chat , game_game_short_name :: Text -- ^ Short name of the game, serves as the unique identifier for the game. Set up your games via Botfather. , game_disable_notification :: Maybe Bool -- ^ Sends the message silently. iOS users will not receive a notification, Android users will receive a notification with no sound. , game_reply_to_message_id :: Maybe Int -- ^ If the message is a reply, ID of the original message @@ -547,7 +566,7 @@ instance FromJSON SendGameRequest where parseJSON = parseJsonDrop 5 -sendGameRequest :: Text -> Text -> SendGameRequest +sendGameRequest :: Integer -> Text -> SendGameRequest sendGameRequest chatId shortName = SendGameRequest chatId shortName Nothing Nothing Nothing data AnswerInlineQueryRequest = AnswerInlineQueryRequest @@ -646,7 +665,7 @@ data EditMessageTextRequest = EditMessageTextRequest { - emt_chat_id :: Maybe Text -- ^ Required if `inline_message_id` is not specified. Unique identifier for the target chat or username of the target channel (in the format `@channelusername`) + emt_chat_id :: Maybe ChatId -- ^ Required if `inline_message_id` is not specified. Unique identifier for the target chat or username of the target channel (in the format `@channelusername`) , emt_message_id :: Maybe Int -- ^ if `inline_message_id` is not specified. Unique identifier of the sent message , emt_inline_message_id :: Maybe Text -- ^ Required if chat_id and message_id are not specified. Identifier of the inline message , emt_text :: Text -- ^ New text of the message @@ -661,7 +680,7 @@ instance FromJSON EditMessageTextRequest where parseJSON = parseJsonDrop 4 -editMessageTextRequest :: Text -> Int -> Text -> EditMessageTextRequest +editMessageTextRequest :: ChatId -> Int -> Text -> EditMessageTextRequest editMessageTextRequest chatId messageId text = EditMessageTextRequest (Just chatId) (Just messageId) Nothing text Nothing Nothing Nothing editInlineMessageTextRequest :: Text -> Text -> EditMessageTextRequest @@ -669,7 +688,7 @@ data EditMessageCaptionRequest = EditMessageCaptionRequest { - emc_chat_id :: Maybe Text -- ^ Required if `inline_message_id` is not specified. Unique identifier for the target chat or username of the target channel (in the format `@channelusername`) + emc_chat_id :: Maybe ChatId -- ^ Required if `inline_message_id` is not specified. Unique identifier for the target chat or username of the target channel (in the format `@channelusername`) , emc_message_id :: Maybe Int -- ^ Required if `inline_message_id` is not specified. Unique identifier of the sent message , emc_inline_message_id :: Maybe Text -- ^ Required if `chat_id` and `message_id` are not specified. Identifier of the inline message , emc_caption :: Maybe Text -- ^ New caption of the message @@ -682,7 +701,7 @@ instance FromJSON EditMessageCaptionRequest where parseJSON = parseJsonDrop 4 -editMessageCaptionRequest :: Text -> Int -> Maybe Text -> EditMessageCaptionRequest +editMessageCaptionRequest :: ChatId -> Int -> Maybe Text -> EditMessageCaptionRequest editMessageCaptionRequest chatId messageId caption = EditMessageCaptionRequest (Just chatId) (Just messageId) Nothing caption Nothing editInlineMessageCaptionRequest :: Text -> Maybe Text -> EditMessageCaptionRequest @@ -690,7 +709,7 @@ data EditMessageReplyMarkupRequest = EditMessageReplyMarkupRequest { - emrm_chat_id :: Maybe Text -- ^ Required if `inline_message_id` is not specified. Unique identifier for the target chat or username of the target channel (in the format `@channelusername`) + emrm_chat_id :: Maybe ChatId -- ^ Required if `inline_message_id` is not specified. Unique identifier for the target chat or username of the target channel (in the format `@channelusername`) , emrm_message_id :: Maybe Int -- ^ Required if `inline_message_id` is not specified. Unique identifier of the sent message , emrm_inline_message_id :: Maybe Text -- ^ Required if `chat_id` and `message_id` are not specified. Identifier of the inline message , emrm_reply_markup :: Maybe InlineKeyboardMarkup -- ^ A JSON-serialized object for an inline keyboard. @@ -702,8 +721,11 @@ instance FromJSON EditMessageReplyMarkupRequest where parseJSON = parseJsonDrop 5 -editMessageReplyMarkupRequest :: Text -> Int -> Maybe InlineKeyboardMarkup -> EditMessageReplyMarkupRequest +editMessageReplyMarkupRequest :: ChatId -> Int -> Maybe InlineKeyboardMarkup -> EditMessageReplyMarkupRequest editMessageReplyMarkupRequest chatId messageId keyboard = EditMessageReplyMarkupRequest (Just chatId) (Just messageId) Nothing keyboard editInlineMessageReplyMarkupRequest :: Text -> Maybe InlineKeyboardMarkup -> EditMessageReplyMarkupRequest editInlineMessageReplyMarkupRequest inlineMessageId keyboard = EditMessageReplyMarkupRequest Nothing Nothing (Just inlineMessageId) keyboard + +tshow :: Show a => a -> Text +tshow = T.pack . show 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.6.0.2 +version: 0.6.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 diff --git a/test/MainSpec.hs b/test/MainSpec.hs --- a/test/MainSpec.hs +++ b/test/MainSpec.hs @@ -26,7 +26,7 @@ success e = e `shouldSatisfy` isRight nosuccess e = e `shouldSatisfy` isLeft -spec :: Token -> Text -> Text -> Spec +spec :: Token -> ChatId -> Text -> Spec spec token chatId botName = do manager <- runIO $ newManager tlsManagerSettings dataDir <- runIO getDataDir @@ -45,7 +45,7 @@ text m `shouldBe` Just "test message" it "should return error message" $ do - res <- sendMessage token (sendMessageRequest "" "test message") manager + res <- sendMessage token (sendMessageRequest (ChatChannel "") "test message") manager nosuccess res let Left FailureResponse { responseStatus = Status { statusMessage = msg } } = res msg `shouldBe` "Bad Request" @@ -110,7 +110,7 @@ describe "/sendPhoto" $ do it "should return error message" $ do - let photo = (sendPhotoRequest "" "photo_id") { + let photo = (sendPhotoRequest (ChatChannel "") "photo_id") { photo_caption = Just "photo caption" } Left FailureResponse { responseStatus = Status { statusMessage = msg } } <- sendPhoto token photo manager @@ -134,7 +134,7 @@ describe "/sendAudio" $ do it "should return error message" $ do - let audio = (sendAudioRequest "" "audio_id") { + let audio = (sendAudioRequest (ChatChannel "") "audio_id") { _audio_performer = Just "performer" , _audio_title = Just "title" } @@ -262,8 +262,9 @@ describe "/getUserProfilePhotos" $ it "should get user profile photos" $ do - Right Response { result = photos } <- - getUserProfilePhotos token (read (T.unpack chatId)) Nothing Nothing manager + Right Response { result = photos } <- do + let ChatId userId = chatId + getUserProfilePhotos token userId Nothing Nothing manager total_count photos `shouldSatisfy` (>= 0) describe "/setWebhook and /getWebhookInfo" $ do diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -3,6 +3,7 @@ module Main (main) where +import Data.Char (isDigit) import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import Data.Text (Text) @@ -10,10 +11,10 @@ import qualified JsonSpec import qualified MainSpec import Options.Applicative -import qualified UpdatesSpec import System.Environment (withArgs) import Test.Hspec import qualified Text.PrettyPrint.ANSI.Leijen as PP +import qualified UpdatesSpec import Web.Telegram.API.Bot -- | Command line options for test suite @@ -55,28 +56,28 @@ Options{..} <- execParser opts let integration = opt_integration token = fmap (\x -> Token ("bot" <> T.pack x)) opt_token - chatId = T.pack <$> opt_chatId + chatId = readChatId <$> opt_chatId botName = T.pack <$> opt_botName hspecArgs = fromMaybe [] opt_hSpecOpts withArgs hspecArgs $ hspec (runSpec' integration token chatId botName) where opts = info (helper <*> options) ( fullDesc <> progDescDoc description) -runSpec' :: Bool -> Maybe Token -> Maybe Text -> Maybe Text -> SpecWith () +runSpec' :: Bool -> Maybe Token -> Maybe ChatId -> Maybe Text -> SpecWith () runSpec' integration token chatId botName = do - describe "Unit tests" $ do + describe "Unit tests" $ describe "Json tests" JsonSpec.spec if integration then runIntegrationSpec token chatId botName else describe "Integration tests" $ it "skipping..." $ pendingWith "Use --integration switch to run integration tests" -runIntegrationSpec :: Maybe Token -> Maybe Text -> Maybe Text -> SpecWith () +runIntegrationSpec :: Maybe Token -> Maybe ChatId -> Maybe Text -> SpecWith () runIntegrationSpec (Just token) (Just chatId) (Just botName) = do describe "Main integration tests" $ MainSpec.spec token chatId botName describe "Updates API spec" $ UpdatesSpec.spec token botName --describe "Inline integration tests" $ InlineSpec.spec token chatId botName -runIntegrationSpec _ _ _ = describe "Integration tests" $ do +runIntegrationSpec _ _ _ = describe "Integration tests" $ fail "Missing required arguments for integration tests. Run stack test --test-arguments \"--help\" for more info" description :: Maybe PP.Doc @@ -84,3 +85,8 @@ (PP.text "Run the haskell-telegram-api tests") PP.<$> ((PP.text "Running with stack: ") PP.<> (PP.text "stack test --test-arguments=\"--integration -t asd128903uiasbfì1023u -c 1235122 -b MyTeleBot -- -m send\"")) PP.<$> ((PP.red . PP.text $ "WARNING: ") PP.<> (PP.text "the HSPEC_ARGS are optional but if present MUST be at the end and seperated from the other options with a -- ")) + +readChatId :: String -> ChatId +readChatId s@('@':_) = ChatChannel $ T.pack s +readChatId s | all isDigit s = ChatId (read s) +readChatId _ = error "ChatId must be either Integer or String in form '@channel'"