diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +0.3.1 +--- + +- Implement sendDocument function support. (see [#31]( https://github.com/fizruk/telegram-bot-simple/pull/31 )); +- Add Travis CI (see [#32]( https://github.com/fizruk/telegram-bot-simple/pull/32 )); +- Add MonadFail instance for UpdateParser (see [#27]( https://github.com/fizruk/telegram-bot-simple/pull/27 )); 0.3.0 --- diff --git a/src/Telegram/Bot/API/Methods.hs b/src/Telegram/Bot/API/Methods.hs --- a/src/Telegram/Bot/API/Methods.hs +++ b/src/Telegram/Bot/API/Methods.hs @@ -1,15 +1,25 @@ +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeOperators #-} module Telegram.Bot.API.Methods where +import Control.Monad.IO.Class import Data.Aeson +import Data.Aeson.Text +import Data.Bool import Data.Proxy import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL import GHC.Generics (Generic) import Servant.API import Servant.Client hiding (Response) +import Servant.Multipart +import System.FilePath import Telegram.Bot.API.Internal.Utils import Telegram.Bot.API.MakingRequests @@ -94,3 +104,89 @@ instance ToJSON SendMessageRequest where toJSON = gtoJSON instance FromJSON SendMessageRequest where parseJSON = gparseJSON + +-- ** 'sendMessage' + +type SendDocumentContent + = "sendDocument" + :> MultipartForm Tmp SendDocumentRequest + :> Post '[JSON] (Response Message) + +type SendDocumentLink + = "sendDocument" + :> ReqBody '[JSON] SendDocumentRequest + :> Post '[JSON] (Response Message) + +-- | Use this method to send text messages. +-- On success, the sent 'Message' is returned. +-- +-- +sendDocument :: SendDocumentRequest -> ClientM (Response Message) +sendDocument r = do + case sendDocumentDocument r of + DocumentFile{} -> do + boundary <- liftIO genBoundary + client (Proxy @SendDocumentContent) (boundary, r) + _ -> client (Proxy @SendDocumentLink) r + +-- | Request parameters for 'sendDocument' +data SendDocumentRequest = SendDocumentRequest + { sendDocumentChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @\@channelusername@). + , sendDocumentDocument :: DocumentFile -- ^ Pass a file_id as String to send a file that exists on the Telegram servers (recommended), pass an HTTP URL as a String for Telegram to get a file from the Internet, or upload a new one using multipart/form-data + , sendDocumentThumb :: Maybe FilePath -- ^ Thumbnail of the file sent; can be ignored if thumbnail generation for the file is supported server-side. The thumbnail should be in JPEG format and less than 200 kB in size. A thumbnail's width and height should not exceed 320. Ignored if the file is not uploaded using multipart/form-data. Thumbnails can't be reused and can be only uploaded as a new file, so you can pass “attach://” if the thumbnail was uploaded using multipart/form-data under + , sendDocumentCaption :: Maybe Text -- ^ Document caption (may also be used when resending documents by file_id), 0-1024 characters after entities parsing + , sendDocumentParseMode :: Maybe ParseMode -- ^ Mode for parsing entities in the document caption. + , sendDocumentDisableNotification :: Maybe Bool -- ^ Sends the message silently. Users will receive a notification with no sound. + , sendDocumentReplyToMessageId :: Maybe MessageId + , sendDocumentReplyMarkup :: Maybe SomeReplyMarkup -- ^ Additional interface options. A JSON-serialized object for an inline keyboard, custom reply keyboard, instructions to remove reply keyboard or to force a reply from the user. + } + deriving Generic + +data DocumentFile + = DocumentFileId Int + | DocumentUrl Text + | DocumentFile FilePath ContentType + +instance ToJSON DocumentFile where + toJSON (DocumentFileId i) = toJSON (show i) + toJSON (DocumentUrl t) = toJSON t + toJSON (DocumentFile f _) = toJSON ("attach://" <> T.pack (takeFileName f)) + +type ContentType = Text + +instance ToMultipart Tmp SendDocumentRequest where + toMultipart SendDocumentRequest{..} = MultipartData fields files where + fields = + [ Input "document" $ T.pack $ "attach://file" + , Input "chat_id" $ case sendDocumentChatId of + SomeChatId (ChatId chat_id) -> T.pack $ show chat_id + SomeChatUsername txt -> txt + ] <> + ( (maybe id (\_ -> ((Input "thumb" "attach://thumb"):)) sendDocumentThumb) + $ (maybe id (\t -> ((Input "caption" t):)) sendDocumentCaption) + $ (maybe id (\t -> ((Input "parse_mode" (TL.toStrict $ encodeToLazyText t)):)) sendDocumentParseMode) + $ (maybe id (\t -> ((Input "disable_notifications" (bool "false" "true" t)):)) sendDocumentDisableNotification) + $ (maybe id (\t -> ((Input "reply_to_message_id" (TL.toStrict $ encodeToLazyText t)):)) sendDocumentReplyToMessageId) + $ (maybe id (\t -> ((Input "reply_markup" (TL.toStrict $ encodeToLazyText t)):)) sendDocumentReplyMarkup) + []) + files + = (FileData "file" (T.pack $ takeFileName path) ct path) + : maybe [] (\t -> [FileData "thumb" (T.pack $ takeFileName t) "image/jpeg" t]) sendDocumentThumb + + DocumentFile path ct = sendDocumentDocument + + +instance ToJSON SendDocumentRequest where toJSON = gtoJSON + +-- | Generate send document structure. +toSendDocument :: SomeChatId -> DocumentFile -> SendDocumentRequest +toSendDocument ch df = SendDocumentRequest + { sendDocumentChatId = ch + , sendDocumentDocument = df + , sendDocumentThumb = Nothing + , sendDocumentCaption = Nothing + , sendDocumentParseMode = Nothing + , sendDocumentDisableNotification = Nothing + , sendDocumentReplyToMessageId = Nothing + , sendDocumentReplyMarkup = Nothing + } diff --git a/src/Telegram/Bot/Simple/UpdateParser.hs b/src/Telegram/Bot/Simple/UpdateParser.hs --- a/src/Telegram/Bot/Simple/UpdateParser.hs +++ b/src/Telegram/Bot/Simple/UpdateParser.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} module Telegram.Bot.Simple.UpdateParser where import Control.Applicative @@ -26,6 +27,11 @@ instance Monad UpdateParser where return = pure UpdateParser x >>= f = UpdateParser (\u -> x u >>= flip runUpdateParser u . f) + +#if MIN_VERSION_base(4,13,0) +instance MonadFail UpdateParser where + fail _ = empty +#endif mkParser :: (Update -> Maybe a) -> UpdateParser a mkParser = UpdateParser diff --git a/telegram-bot-simple.cabal b/telegram-bot-simple.cabal --- a/telegram-bot-simple.cabal +++ b/telegram-bot-simple.cabal @@ -7,7 +7,7 @@ -- hash: 815631caa1274f24031eaa1ec3c4ea08c75d46b660a0b266eeea28b0f123c325 name: telegram-bot-simple -version: 0.3.0 +version: 0.3.1 synopsis: Easy to use library for building Telegram bots. description: Please see the README on Github at category: Web @@ -19,6 +19,7 @@ license: BSD3 license-file: LICENSE build-type: Simple +Tested-with: GHC ==8.4.4 || ==8.6.5 || ==8.8.3 || ==8.10.1 extra-source-files: README.md CHANGELOG.md @@ -61,6 +62,7 @@ , base >=4.9 && <5 , bytestring , cron + , filepath , hashable , http-api-data , http-client @@ -71,6 +73,7 @@ , profunctors , servant , servant-client + , servant-multipart , split , stm , template-haskell