diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,13 @@ +## 0.4.1.0 + +Features: + +* Implemented file uploading for audio, voice, sticker, video and documents + +Bugfixes: + +* Exposed constrictors for inline edit requests + ## 0.4.0.1 Bugfixes: diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -139,11 +139,11 @@ ## TODO * ~~`sendPhoto` - upload photo~~ done -* `sendAudio` - upload audio -* `sendDocument` - upload documents -* `sendSticker` - upload stickers -* `sendVideo` - upload video -* `sendVoice` - upload voice +* ~~`sendAudio` - upload audio~~ done +* ~~`sendDocument` - upload documents~~ done +* ~~`sendSticker` - upload stickers~~ done +* ~~`sendVideo` - upload video~~ done +* ~~`sendVoice` - upload voice~~ done * `setWebhook` - upload certificate [telegram-bot-api]: https://core.telegram.org/bots/api diff --git a/src/Web/Telegram/API/Bot/API.hs b/src/Web/Telegram/API/Bot/API.hs --- a/src/Web/Telegram/API/Bot/API.hs +++ b/src/Web/Telegram/API/Bot/API.hs @@ -11,10 +11,15 @@ , forwardMessage , uploadPhoto , sendPhoto + , uploadAudio , sendAudio + , uploadDocument , sendDocument + , uploadSticker , sendSticker + , uploadVideo , sendVideo + , uploadVoice , sendVoice , sendLocation , sendVenue @@ -85,20 +90,35 @@ :> ReqBody '[JSON] (SendPhotoRequest Text) :> Post '[JSON] MessageResponse :<|> TelegramToken :> "sendAudio" - :> ReqBody '[JSON] SendAudioRequest + :> MultipartFormDataReqBody (SendAudioRequest FileUpload) :> Post '[JSON] MessageResponse + :<|> TelegramToken :> "sendAudio" + :> ReqBody '[JSON] (SendAudioRequest Text) + :> Post '[JSON] MessageResponse :<|> TelegramToken :> "sendDocument" - :> ReqBody '[JSON] SendDocumentRequest + :> MultipartFormDataReqBody (SendDocumentRequest FileUpload) :> Post '[JSON] MessageResponse + :<|> TelegramToken :> "sendDocument" + :> ReqBody '[JSON] (SendDocumentRequest Text) + :> Post '[JSON] MessageResponse :<|> TelegramToken :> "sendSticker" - :> ReqBody '[JSON] SendStickerRequest + :> MultipartFormDataReqBody (SendStickerRequest FileUpload) :> Post '[JSON] MessageResponse + :<|> TelegramToken :> "sendSticker" + :> ReqBody '[JSON] (SendStickerRequest Text) + :> Post '[JSON] MessageResponse :<|> TelegramToken :> "sendVideo" - :> ReqBody '[JSON] SendVideoRequest + :> MultipartFormDataReqBody (SendVideoRequest FileUpload) :> Post '[JSON] MessageResponse + :<|> TelegramToken :> "sendVideo" + :> ReqBody '[JSON] (SendVideoRequest Text) + :> Post '[JSON] MessageResponse :<|> TelegramToken :> "sendVoice" - :> ReqBody '[JSON] SendVoiceRequest + :> MultipartFormDataReqBody (SendVoiceRequest FileUpload) :> Post '[JSON] MessageResponse + :<|> TelegramToken :> "sendVoice" + :> ReqBody '[JSON] (SendVoiceRequest Text) + :> Post '[JSON] MessageResponse :<|> TelegramToken :> "sendLocation" :> ReqBody '[JSON] SendLocationRequest :> Post '[JSON] MessageResponse @@ -162,11 +182,16 @@ forwardMessage_ :: Token -> ForwardMessageRequest -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse uploadPhoto_ :: Token -> SendPhotoRequest FileUpload -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse sendPhoto_ :: Token -> SendPhotoRequest Text -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse -sendAudio_ :: Token -> SendAudioRequest -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse -sendDocument_ :: Token -> SendDocumentRequest -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse -sendSticker_ :: Token -> SendStickerRequest -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse -sendVideo_ :: Token -> SendVideoRequest -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse -sendVoice_ :: Token -> SendVoiceRequest -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse +uploadAudio_ :: Token -> SendAudioRequest FileUpload -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse +sendAudio_ :: Token -> SendAudioRequest Text -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse +uploadDocument_ :: Token -> SendDocumentRequest FileUpload -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse +sendDocument_ :: Token -> SendDocumentRequest Text -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse +uploadSticker_ :: Token -> SendStickerRequest FileUpload -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse +sendSticker_ :: Token -> SendStickerRequest Text -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse +uploadVideo_ :: Token -> SendVideoRequest FileUpload -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse +sendVideo_ :: Token -> SendVideoRequest Text -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse +uploadVoice_ :: Token -> SendVoiceRequest FileUpload -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse +sendVoice_ :: Token -> SendVoiceRequest Text -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse sendLocation_ :: Token -> SendLocationRequest -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse sendVenue_ :: Token -> SendVenueRequest-> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse sendContact_ :: Token -> SendContactRequest -> Manager -> BaseUrl -> ExceptT ServantError IO MessageResponse @@ -187,10 +212,15 @@ :<|> forwardMessage_ :<|> uploadPhoto_ :<|> sendPhoto_ + :<|> uploadAudio_ :<|> sendAudio_ + :<|> uploadDocument_ :<|> sendDocument_ + :<|> uploadSticker_ :<|> sendSticker_ + :<|> uploadVideo_ :<|> sendVideo_ + :<|> uploadVoice_ :<|> sendVoice_ :<|> sendLocation_ :<|> sendVenue_ @@ -230,26 +260,48 @@ sendPhoto :: Token -> SendPhotoRequest Text -> Manager -> IO (Either ServantError MessageResponse) sendPhoto = run telegramBaseUrl sendPhoto_ --- | 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. +-- | Use this method to upload and 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 -> Manager -> IO (Either ServantError MessageResponse) +uploadAudio :: Token -> SendAudioRequest FileUpload -> Manager -> IO (Either ServantError MessageResponse) +uploadAudio = run telegramBaseUrl uploadAudio_ + +-- | Use this method to send audio files that are already on the Telegram servers, 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 Text -> Manager -> IO (Either ServantError MessageResponse) sendAudio = run telegramBaseUrl sendAudio_ --- | 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 -> Manager -> IO (Either ServantError MessageResponse) +-- | Use this method to upload and 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. +uploadDocument :: Token -> SendDocumentRequest FileUpload -> Manager -> IO (Either ServantError MessageResponse) +uploadDocument = run telegramBaseUrl uploadDocument_ + +-- | Use this method to send general files that have already been uploaded. 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 Text -> Manager -> IO (Either ServantError MessageResponse) sendDocument = run telegramBaseUrl sendDocument_ --- | Use this method to send .webp stickers. On success, the sent 'Message' is returned. -sendSticker :: Token -> SendStickerRequest -> Manager -> IO (Either ServantError MessageResponse) +-- | Use this method to upload and send .webp stickers. On success, the sent 'Message' is returned. +uploadSticker :: Token -> SendStickerRequest FileUpload -> Manager -> IO (Either ServantError MessageResponse) +uploadSticker = run telegramBaseUrl uploadSticker_ + +-- | Use this method to send .webp stickers that are already on the Telegram servers. On success, the sent 'Message' is returned. +sendSticker :: Token -> SendStickerRequest Text -> Manager -> IO (Either ServantError MessageResponse) sendSticker = run telegramBaseUrl sendSticker_ --- | 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 -> Manager -> IO (Either ServantError MessageResponse) +-- | Use this method to upload and 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. +uploadVideo :: Token -> SendVideoRequest FileUpload -> Manager -> IO (Either ServantError MessageResponse) +uploadVideo = run telegramBaseUrl uploadVideo_ + +-- | Use this method to send video files that are already on the Telegram servers. 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 Text -> Manager -> IO (Either ServantError MessageResponse) sendVideo = run telegramBaseUrl sendVideo_ --- | 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 -> Manager -> IO (Either ServantError MessageResponse) +-- | Use this method to upload and 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. +uploadVoice :: Token -> SendVoiceRequest FileUpload -> Manager -> IO (Either ServantError MessageResponse) +uploadVoice = run telegramBaseUrl uploadVoice_ + +-- | Use this method to send audio files that are already on the telegram server, 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 Text -> Manager -> IO (Either ServantError MessageResponse) sendVoice = run telegramBaseUrl sendVoice_ -- | Use this method to send point on the map. On success, the sent 'Message' is returned. 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 @@ -32,15 +32,21 @@ , EditMessageCaptionRequest (..) , EditMessageReplyMarkupRequest (..) -- * Functions + , localFileUpload , sendMessageRequest , forwardMessageRequest , sendPhotoRequest , uploadPhotoRequest , sendAudioRequest + , uploadAudioRequest , sendDocumentRequest + , uploadDocumentRequest , sendStickerRequest + , uploadStickerRequest , sendVideoRequest + , uploadVideoRequest , sendVoiceRequest + , uploadVoiceRequest , sendLocationRequest , sendVenueRequest , sendContactRequest @@ -51,8 +57,11 @@ , replyKeyboardHide , forceReply , editMessageTextRequest + , editInlineMessageTextRequest , editMessageCaptionRequest + , editInlineMessageCaptionRequest , editMessageReplyMarkupRequest + , editInlineMessageReplyMarkupRequest ) where import Data.Aeson @@ -83,10 +92,17 @@ -- | This object represents data (image, video, ...) with mime type to upload. data FileUpload = FileUpload { - fileUpload_type :: MimeType -- ^ Mime type of the upload. + fileUpload_type :: Maybe MimeType -- ^ Mime type of the upload. , fileUpload_content :: FileUploadContent -- ^ The payload/source to upload. } +localFileUpload :: FilePath -> FileUpload +localFileUpload path = + FileUpload + { fileUpload_type = Nothing + , fileUpload_content = FileUploadFile path + } + fileUploadToPart :: Text -> FileUpload -> Part fileUploadToPart inputName fileUpload = let part = @@ -94,7 +110,7 @@ FileUploadFile path -> partFileSource inputName path FileUploadBS bs -> partBS inputName bs FileUploadLBS lbs -> partLBS inputName lbs - in part { partContentType = Just (fileUpload_type fileUpload) } + in part { partContentType = fileUpload_type fileUpload } utf8Part :: Text -> Text -> Part utf8Part inputName = partBS inputName . T.encodeUtf8 @@ -162,20 +178,21 @@ uploadPhotoRequest chatId photo = SendPhotoRequest chatId photo Nothing Nothing Nothing Nothing instance ToMultipartFormData (SendPhotoRequest FileUpload) where - toMultipartFormData sendPhotoReq = - [ utf8Part "chat_id" (photo_chat_id sendPhotoReq) ] ++ + toMultipartFormData req = + [ utf8Part "chat_id" (photo_chat_id req) ] ++ 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 + [ 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 + , partLBS "reply_markup" . encode <$> photo_reply_markup req ] ++ - [ fileUploadToPart "photo" (photo_photo sendPhotoReq) ] + [ fileUploadToPart "photo" (photo_photo req) ] -- | This object represents request for 'sendAudio' -data SendAudioRequest = SendAudioRequest +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_audio :: Text -- ^ Audio file to send. Pass a file_id as String to resend an audio that is already on the Telegram servers. + , _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_duration :: Maybe Int -- ^ Duration of the audio in seconds , _audio_performer :: Maybe Text -- ^ Performer , _audio_title :: Maybe Text -- ^ Track name @@ -184,59 +201,102 @@ , _audio_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 SendAudioRequest where +instance ToJSON (SendAudioRequest Text) where toJSON = toJsonDrop 7 -instance FromJSON SendAudioRequest where +instance FromJSON (SendAudioRequest Text) where parseJSON = parseJsonDrop 7 -sendAudioRequest :: Text -> Text -> SendAudioRequest +instance ToMultipartFormData (SendAudioRequest FileUpload) where + toMultipartFormData req = + [ utf8Part "chat_id" (_audio_chat_id req) ] ++ + catMaybes + [ utf8Part "duration" . T.pack . show <$> _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 + , partLBS "reply_markup" . encode <$> _audio_reply_markup req + ] ++ + [ fileUploadToPart "audio" (_audio_audio req) ] + +sendAudioRequest :: Text -> Text -> SendAudioRequest Text sendAudioRequest chatId audio = SendAudioRequest chatId audio Nothing Nothing Nothing Nothing Nothing Nothing +uploadAudioRequest :: Text -> FileUpload -> SendAudioRequest FileUpload +uploadAudioRequest chatId audio = SendAudioRequest chatId audio Nothing Nothing Nothing Nothing Nothing Nothing + -- | This object represents request for 'sendSticker' -data SendStickerRequest = SendStickerRequest +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_sticker :: Text -- ^ Sticker to send. A file_id as String to resend a sticker that is already on the Telegram servers + , 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 , sticker_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 SendStickerRequest where +instance ToJSON (SendStickerRequest Text) where toJSON = toJsonDrop 8 -instance FromJSON SendStickerRequest where +instance FromJSON (SendStickerRequest Text) where parseJSON = parseJsonDrop 8 -sendStickerRequest :: Text -> Text -> SendStickerRequest +instance ToMultipartFormData (SendStickerRequest FileUpload) where + toMultipartFormData req = + [ utf8Part "chat_id" (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 + , partLBS "reply_markup" . encode <$> sticker_reply_markup req + ] ++ + [ fileUploadToPart "sticker" (sticker_sticker req) ] + +sendStickerRequest :: Text -> Text -> SendStickerRequest Text sendStickerRequest chatId sticker = SendStickerRequest chatId sticker Nothing Nothing Nothing +uploadStickerRequest :: Text -> FileUpload -> SendStickerRequest FileUpload +uploadStickerRequest chatId sticker = SendStickerRequest chatId sticker Nothing Nothing Nothing + -- | This object represents request for 'sendDocument' -data SendDocumentRequest = SendDocumentRequest +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_document :: Text -- ^ File to send. A file_id as String to resend a file that is already on the Telegram servers + , 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. , document_reply_to_message_id :: Maybe Int -- ^ If the message is a reply, ID of the original message , document_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 SendDocumentRequest where +instance ToJSON (SendDocumentRequest Text) where toJSON = toJsonDrop 9 -instance FromJSON SendDocumentRequest where +instance FromJSON (SendDocumentRequest Text) where parseJSON = parseJsonDrop 9 -sendDocumentRequest :: Text -> Text -> SendDocumentRequest +instance ToMultipartFormData (SendDocumentRequest FileUpload) where + toMultipartFormData req = + [ utf8Part "chat_id" (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 + , partLBS "reply_markup" . encode <$> document_reply_markup req + ] ++ + [ fileUploadToPart "document" (document_document req) ] + +sendDocumentRequest :: Text -> Text -> SendDocumentRequest Text sendDocumentRequest chatId document = SendDocumentRequest chatId document Nothing Nothing Nothing Nothing +uploadDocumentRequest :: Text -> FileUpload -> SendDocumentRequest FileUpload +uploadDocumentRequest chatId document = SendDocumentRequest chatId document Nothing Nothing Nothing Nothing + -- | This object represents request for 'sendVideo' -data SendVideoRequest = SendVideoRequest +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_video :: Text -- ^ Video to send. A file_id as String to resend a video that is already on the Telegram servers + , _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. , _video_disable_notification :: Maybe Bool -- ^ Sends the message silently. iOS users will not receive a notification, Android users will receive a notification with no sound. @@ -244,34 +304,63 @@ , _video_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 SendVideoRequest where +instance ToJSON (SendVideoRequest Text) where toJSON = toJsonDrop 7 -instance FromJSON SendVideoRequest where +instance FromJSON (SendVideoRequest Text) where parseJSON = parseJsonDrop 7 -sendVideoRequest :: Text -> Text -> SendVideoRequest +instance ToMultipartFormData (SendVideoRequest FileUpload) where + toMultipartFormData req = + [ utf8Part "chat_id" (_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 + , partLBS "reply_markup" . encode <$> _video_reply_markup req + ] ++ + [ fileUploadToPart "video" (_video_video req) ] + +sendVideoRequest :: Text -> Text -> SendVideoRequest Text sendVideoRequest chatId video = SendVideoRequest chatId video Nothing Nothing Nothing Nothing Nothing +uploadVideoRequest :: Text -> FileUpload -> SendVideoRequest FileUpload +uploadVideoRequest chatId video = SendVideoRequest chatId video Nothing Nothing Nothing Nothing Nothing + -- | This object represents request for 'sendVoice' -data SendVoiceRequest = SendVoiceRequest +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_voice :: Text -- ^ Audio file to send. A file_id as String to resend an audio that is already on the Telegram servers + , _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_duration :: Maybe Int -- ^ Duration of sent audio in seconds , _voice_disable_notification :: Maybe Bool -- ^ Sends the message silently. iOS users will not receive a notification, Android users will receive a notification with no sound. , _voice_reply_to_message_id :: Maybe Int -- ^ If the message is a reply, ID of the original message , _voice_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 SendVoiceRequest where +instance ToJSON (SendVoiceRequest Text) where toJSON = toJsonDrop 7 -instance FromJSON SendVoiceRequest where +instance FromJSON (SendVoiceRequest Text) where parseJSON = parseJsonDrop 7 -sendVoiceRequest :: Text -> Text -> SendVoiceRequest +instance ToMultipartFormData (SendVoiceRequest FileUpload) where + toMultipartFormData req = + [ utf8Part "chat_id" (_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 + , partLBS "reply_markup" . encode <$> _voice_reply_markup req + ] ++ + [ fileUploadToPart "voice" (_voice_voice req) ] + +sendVoiceRequest :: Text -> Text -> SendVoiceRequest Text sendVoiceRequest chatId voice = SendVoiceRequest chatId voice Nothing Nothing Nothing Nothing + +uploadVoiceRequest :: Text -> FileUpload -> SendVoiceRequest FileUpload +uploadVoiceRequest chatId voice = SendVoiceRequest chatId voice Nothing Nothing Nothing Nothing -- | This object represents request for 'sendLocation' data SendLocationRequest = SendLocationRequest diff --git a/telegram-api.cabal b/telegram-api.cabal --- a/telegram-api.cabal +++ b/telegram-api.cabal @@ -1,5 +1,5 @@ name: telegram-api -version: 0.4.0.1 +version: 0.4.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 @@ -13,6 +13,11 @@ -- extra-source-files: cabal-version: >=1.10 data-files: test-data/christmas-cat.jpg + , test-data/haskell-logo.webp + , test-data/lego-video.mp4 + , test-data/Possible_PDM_signal_labeled_as_Sputnik_by_NASA.ogg + , test-data/concerto-for-2-trumpets-in-c-major.mp3 + , test-data/wikipedia-telegram.txt extra-source-files: README.md diff --git a/test-data/Possible_PDM_signal_labeled_as_Sputnik_by_NASA.ogg b/test-data/Possible_PDM_signal_labeled_as_Sputnik_by_NASA.ogg new file mode 100644 Binary files /dev/null and b/test-data/Possible_PDM_signal_labeled_as_Sputnik_by_NASA.ogg differ diff --git a/test-data/concerto-for-2-trumpets-in-c-major.mp3 b/test-data/concerto-for-2-trumpets-in-c-major.mp3 new file mode 100644 Binary files /dev/null and b/test-data/concerto-for-2-trumpets-in-c-major.mp3 differ diff --git a/test-data/haskell-logo.webp b/test-data/haskell-logo.webp new file mode 100644 Binary files /dev/null and b/test-data/haskell-logo.webp differ diff --git a/test-data/lego-video.mp4 b/test-data/lego-video.mp4 new file mode 100644 Binary files /dev/null and b/test-data/lego-video.mp4 differ diff --git a/test-data/wikipedia-telegram.txt b/test-data/wikipedia-telegram.txt new file mode 100644 --- /dev/null +++ b/test-data/wikipedia-telegram.txt @@ -0,0 +1,7 @@ +From the English Wikipedia about Telegram, +https://en.wikipedia.org/wiki/Telegram_(software) + +Telegram is a cloud-based instant messaging service. Telegram clients exist for both mobile (Android, iOS, Windows Phone, Ubuntu Touch) and desktop systems (Windows, OS X, Linux). Users can send messages and exchange photos, videos, stickers and files of any type. Telegram also provides optional end-to-end encrypted messaging with self-destruct timers, but Telegram's implementation of these features has been contested by security researchers and cryptography experts. + +Telegram is supported by the Russian-born entrepreneur Pavel Durov, who is now a citizen of Saint Kitts and Nevis, travelling the world in self-imposed exile. Its client-side code is open-source software, whereas its server-side code is closed-sourced and proprietary. The service also provides APIs to independent developers. + diff --git a/test/MainSpec.hs b/test/MainSpec.hs --- a/test/MainSpec.hs +++ b/test/MainSpec.hs @@ -28,6 +28,8 @@ spec :: Token -> Text -> Text -> Spec spec token chatId botName = do manager <- runIO $ newManager tlsManagerSettings + dataDir <- runIO getDataDir + let testFile name = dataDir "test-data" name describe "/getMe" $ do it "responds with correct bot's name" $ do Right GetMeResponse { user_result = u } <- @@ -101,8 +103,7 @@ Left FailureResponse { responseStatus = Status { statusMessage = msg } } <- sendPhoto token photo manager msg `shouldBe` "Bad Request" it "should upload photo and resend it by id" $ do - dataDir <- getDataDir - let fileUpload = FileUpload "image/jpeg" (FileUploadFile (dataDir "test-data/christmas-cat.jpg")) + let fileUpload = localFileUpload (testFile "christmas-cat.jpg") let upload = (uploadPhotoRequest chatId fileUpload) { photo_caption = Just "uploaded photo" } @@ -128,10 +129,20 @@ sendAudio token audio manager msg `shouldBe` "Bad Request" it "should send audio" $ do + -- audio source: https://musopen.org/music/2698/antonio-vivaldi/concerto-for-2-trumpets-in-c-major-rv-537-trumpet-and-organ-arr/ let audio = sendAudioRequest chatId "BQADBAADAQQAAiBOnQHThzc4cz1-IwI" Right MessageResponse { message_result = Message { audio = Just Audio { audio_title = Just title } } } <- sendAudio token audio manager title `shouldBe` "The Nutcracker Suite - Act II, No.12. Pas de Deux variations" + it "should upload audio" $ do + let fileUpload = localFileUpload (testFile "concerto-for-2-trumpets-in-c-major.mp3") + audioTitle = "Concerto for 2 Trumpets in C major, RV. 537 (Rondeau arr.) All." + audioPerformer = "Michel Rondeau" + audio = (uploadAudioRequest chatId fileUpload) { _audio_performer = Just audioPerformer, _audio_title = Just audioTitle } + Right MessageResponse { message_result = Message { audio = Just Audio { audio_title = Just title, audio_performer = Just performer } } } <- + uploadAudio token audio manager + title `shouldBe` audioTitle + performer `shouldBe` audioPerformer describe "/sendSticker" $ do it "should send sticker" $ do @@ -139,7 +150,40 @@ Right MessageResponse { message_result = Message { sticker = Just sticker } } <- sendSticker token sticker manager (sticker_file_id sticker) `shouldBe` "BQADAgADGgADkWgMAAGXlYGBiM_d2wI" + it "should upload sticker" $ do + let fileUpload = localFileUpload (testFile "haskell-logo.webp") + stickerReq = uploadStickerRequest chatId fileUpload + Right MessageResponse { message_result = Message { sticker = Just sticker } } <- + uploadSticker token stickerReq manager + (sticker_height sticker) `shouldBe` 128 + + describe "/sendVoice" $ do + it "should upload voice" $ do + -- audio source: https://commons.wikimedia.org/wiki/File:Possible_PDM_signal_labeled_as_Sputnik_by_NASA.ogg + let fileUpload = localFileUpload (testFile "Possible_PDM_signal_labeled_as_Sputnik_by_NASA.ogg") + voiceReq = (uploadVoiceRequest chatId fileUpload) { _voice_duration = Just 10 } + Right MessageResponse { message_result = Message { voice = Just voice } } <- + uploadVoice token voiceReq manager + voice_duration voice `shouldBe` 10 + describe "/sendVideo" $ do + it "should upload video" $ do + -- video source: http://techslides.com/sample-webm-ogg-and-mp4-video-files-for-html5 + let fileUpload = localFileUpload (testFile "lego-video.mp4") + videoReq = uploadVideoRequest chatId fileUpload + Right MessageResponse { message_result = Message { video = Just video } } <- + uploadVideo token videoReq manager + video_width video `shouldBe` 560 + + describe "/sendDocument" $ do + it "should upload document" $ do + let fileUpload = localFileUpload (testFile "wikipedia-telegram.txt") + documentReq = uploadDocumentRequest chatId fileUpload + Right MessageResponse { message_result = Message { document = Just document } } <- + uploadDocument token documentReq manager + doc_mime_type document `shouldBe` Just "text/plain" + doc_file_name document `shouldBe` Just "wikipedia-telegram.txt" + describe "/sendLocation" $ do it "should send location" $ do let location = sendLocationRequest chatId 52.38 4.9 @@ -225,7 +269,7 @@ it "should edit caption" $ do dataDir <- getDataDir - let fileUpload = FileUpload "image/jpeg" (FileUploadFile (dataDir "test-data/christmas-cat.jpg")) + let fileUpload = localFileUpload (testFile "christmas-cat.jpg") let originalMessage = (uploadPhotoRequest chatId fileUpload) { photo_caption = Just "cat picture" }