{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Telegram.Bot.API.Methods.SendDocument where

import Control.Monad.IO.Class (liftIO)
import Data.Aeson (ToJSON (..))
import Data.Aeson.Text (encodeToLazyText)
import Data.Bool
import Data.Proxy
import Data.Text
import GHC.Generics (Generic)
import Servant.API
import Servant.Multipart.API
import Servant.Multipart.Client
import System.FilePath
import Servant.Client hiding (Response)

import qualified Data.Text as T
import qualified Data.Text.Lazy as TL

import Telegram.Bot.API.Internal.Utils
import Telegram.Bot.API.MakingRequests
import Telegram.Bot.API.Types
import Telegram.Bot.API.Types.ParseMode
import Telegram.Bot.API.Types.SomeReplyMarkup
import Telegram.Bot.API.Internal.TH

-- ** 'sendDocument'

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.
--
-- <https:\/\/core.telegram.org\/bots\/api#senddocument>
sendDocument :: SendDocumentRequest -> ClientM (Response Message)
sendDocument :: SendDocumentRequest -> ClientM (Response Message)
sendDocument SendDocumentRequest
r = do
  case SendDocumentRequest -> DocumentFile
sendDocumentDocument SendDocumentRequest
r of
    DocumentFile{} -> do
      ByteString
boundary <- IO ByteString -> ClientM ByteString
forall a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ByteString
genBoundary
      Proxy SendDocumentContent -> Client ClientM SendDocumentContent
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SendDocumentContent) (ByteString
boundary, SendDocumentRequest
r)
    DocumentFile
_ -> Proxy SendDocumentLink -> Client ClientM SendDocumentLink
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SendDocumentLink) SendDocumentRequest
r

-- | Request parameters for 'sendDocument'
data SendDocumentRequest = SendDocumentRequest
  { SendDocumentRequest -> SomeChatId
sendDocumentChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @\@channelusername@).
  , SendDocumentRequest -> Maybe MessageThreadId
sendDocumentMessageThreadId :: Maybe MessageThreadId -- ^ Unique identifier for the target message thread (topic) of the forum; for forum supergroups only.
  , SendDocumentRequest -> DocumentFile
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
  , SendDocumentRequest -> Maybe FilePath
sendDocumentThumbnail :: 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://<file_attach_name>” if the thumbnail was uploaded using multipart/form-data under <file_attach_name>
  , SendDocumentRequest -> Maybe Text
sendDocumentCaption :: Maybe Text -- ^ Document caption (may also be used when resending documents by file_id), 0-1024 characters after entities parsing
  , SendDocumentRequest -> Maybe ParseMode
sendDocumentParseMode :: Maybe ParseMode  -- ^ Send 'MarkdownV2', 'HTML' or 'Markdown' (legacy), if you want Telegram apps to show bold, italic, fixed-width text or inline URLs in your bot's message.
  , SendDocumentRequest -> Maybe [MessageEntity]
sendDocumentCaptionEntities :: Maybe [MessageEntity] -- ^ A JSON-serialized list of special entities that appear in the caption, which can be specified instead of /parse_mode/.
  , SendDocumentRequest -> Maybe Bool
sendDocumentDisableContentTypeDetection :: Maybe Bool -- ^ Disables automatic server-side content type detection for files uploaded using @multipart/form-data@.
  , SendDocumentRequest -> Maybe Bool
sendDocumentDisableNotification :: Maybe Bool -- ^ Sends the message silently. Users will receive a notification with no sound.
  , SendDocumentRequest -> Maybe Bool
sendDocumentProtectContent      :: Maybe Bool -- ^ Protects the contents of the sent message from forwarding and saving.
  , SendDocumentRequest -> Maybe MessageId
sendDocumentReplyToMessageId :: Maybe MessageId -- ^ If the message is a reply, ID of the original message.
  , SendDocumentRequest -> Maybe ReplyParameters
sendDocumentReplyParameters :: Maybe ReplyParameters -- ^ Description of the message to reply to.
  , SendDocumentRequest -> Maybe SomeReplyMarkup
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 (forall x. SendDocumentRequest -> Rep SendDocumentRequest x)
-> (forall x. Rep SendDocumentRequest x -> SendDocumentRequest)
-> Generic SendDocumentRequest
forall x. Rep SendDocumentRequest x -> SendDocumentRequest
forall x. SendDocumentRequest -> Rep SendDocumentRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SendDocumentRequest -> Rep SendDocumentRequest x
from :: forall x. SendDocumentRequest -> Rep SendDocumentRequest x
$cto :: forall x. Rep SendDocumentRequest x -> SendDocumentRequest
to :: forall x. Rep SendDocumentRequest x -> SendDocumentRequest
Generic


newtype DocumentFile = MakeDocumentFile InputFile
  deriving newtype [DocumentFile] -> Value
[DocumentFile] -> Encoding
DocumentFile -> Bool
DocumentFile -> Value
DocumentFile -> Encoding
(DocumentFile -> Value)
-> (DocumentFile -> Encoding)
-> ([DocumentFile] -> Value)
-> ([DocumentFile] -> Encoding)
-> (DocumentFile -> Bool)
-> ToJSON DocumentFile
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: DocumentFile -> Value
toJSON :: DocumentFile -> Value
$ctoEncoding :: DocumentFile -> Encoding
toEncoding :: DocumentFile -> Encoding
$ctoJSONList :: [DocumentFile] -> Value
toJSONList :: [DocumentFile] -> Value
$ctoEncodingList :: [DocumentFile] -> Encoding
toEncodingList :: [DocumentFile] -> Encoding
$comitField :: DocumentFile -> Bool
omitField :: DocumentFile -> Bool
ToJSON

pattern DocumentFileId :: FileId -> DocumentFile
pattern $mDocumentFileId :: forall {r}. DocumentFile -> (FileId -> r) -> ((# #) -> r) -> r
$bDocumentFileId :: FileId -> DocumentFile
DocumentFileId x = MakeDocumentFile (InputFileId x)

pattern DocumentUrl :: Text -> DocumentFile
pattern $mDocumentUrl :: forall {r}. DocumentFile -> (Text -> r) -> ((# #) -> r) -> r
$bDocumentUrl :: Text -> DocumentFile
DocumentUrl x = MakeDocumentFile (FileUrl x)

pattern DocumentFile :: FilePath -> ContentType -> DocumentFile
pattern $mDocumentFile :: forall {r}.
DocumentFile -> (FilePath -> Text -> r) -> ((# #) -> r) -> r
$bDocumentFile :: FilePath -> Text -> DocumentFile
DocumentFile x y = MakeDocumentFile (InputFile x y)


instance ToMultipart Tmp SendDocumentRequest where
  toMultipart :: SendDocumentRequest -> MultipartData Tmp
toMultipart SendDocumentRequest{Maybe Bool
Maybe FilePath
Maybe [MessageEntity]
Maybe Text
Maybe MessageThreadId
Maybe MessageId
Maybe ParseMode
Maybe SomeReplyMarkup
Maybe ReplyParameters
SomeChatId
DocumentFile
sendDocumentDocument :: SendDocumentRequest -> DocumentFile
sendDocumentChatId :: SendDocumentRequest -> SomeChatId
sendDocumentMessageThreadId :: SendDocumentRequest -> Maybe MessageThreadId
sendDocumentThumbnail :: SendDocumentRequest -> Maybe FilePath
sendDocumentCaption :: SendDocumentRequest -> Maybe Text
sendDocumentParseMode :: SendDocumentRequest -> Maybe ParseMode
sendDocumentCaptionEntities :: SendDocumentRequest -> Maybe [MessageEntity]
sendDocumentDisableContentTypeDetection :: SendDocumentRequest -> Maybe Bool
sendDocumentDisableNotification :: SendDocumentRequest -> Maybe Bool
sendDocumentProtectContent :: SendDocumentRequest -> Maybe Bool
sendDocumentReplyToMessageId :: SendDocumentRequest -> Maybe MessageId
sendDocumentReplyParameters :: SendDocumentRequest -> Maybe ReplyParameters
sendDocumentReplyMarkup :: SendDocumentRequest -> Maybe SomeReplyMarkup
sendDocumentChatId :: SomeChatId
sendDocumentMessageThreadId :: Maybe MessageThreadId
sendDocumentDocument :: DocumentFile
sendDocumentThumbnail :: Maybe FilePath
sendDocumentCaption :: Maybe Text
sendDocumentParseMode :: Maybe ParseMode
sendDocumentCaptionEntities :: Maybe [MessageEntity]
sendDocumentDisableContentTypeDetection :: Maybe Bool
sendDocumentDisableNotification :: Maybe Bool
sendDocumentProtectContent :: Maybe Bool
sendDocumentReplyToMessageId :: Maybe MessageId
sendDocumentReplyParameters :: Maybe ReplyParameters
sendDocumentReplyMarkup :: Maybe SomeReplyMarkup
..} = [Input] -> [FileData Tmp] -> MultipartData Tmp
forall tag. [Input] -> [FileData tag] -> MultipartData tag
MultipartData [Input]
fields [FileData Tmp]
files where
    fields :: [Input]
fields =
      [ Text -> Text -> Input
Input Text
"document" (Text -> Input) -> Text -> Input
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
"attach://file"
      , Text -> Text -> Input
Input Text
"chat_id" (Text -> Input) -> Text -> Input
forall a b. (a -> b) -> a -> b
$ case SomeChatId
sendDocumentChatId of
          SomeChatId (ChatId Integer
chat_id) -> FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
chat_id
          SomeChatUsername Text
txt -> Text
txt
      ] [Input] -> [Input] -> [Input]
forall a. Semigroup a => a -> a -> a
<>
      (   (([Input] -> [Input])
-> (MessageThreadId -> [Input] -> [Input])
-> Maybe MessageThreadId
-> [Input]
-> [Input]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Input] -> [Input]
forall a. a -> a
id (\MessageThreadId
t -> ((Text -> Text -> Input
Input Text
"message_thread_id") (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ MessageThreadId -> FilePath
forall a. Show a => a -> FilePath
show MessageThreadId
t)Input -> [Input] -> [Input]
forall a. a -> [a] -> [a]
:)) Maybe MessageThreadId
sendDocumentMessageThreadId)
        ([Input] -> [Input]) -> [Input] -> [Input]
forall a b. (a -> b) -> a -> b
$ (([Input] -> [Input])
-> (FilePath -> [Input] -> [Input])
-> Maybe FilePath
-> [Input]
-> [Input]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Input] -> [Input]
forall a. a -> a
id (\FilePath
_ -> ((Text -> Text -> Input
Input Text
"thumbnail" Text
"attach://thumbnail")Input -> [Input] -> [Input]
forall a. a -> [a] -> [a]
:)) Maybe FilePath
sendDocumentThumbnail)
        ([Input] -> [Input]) -> [Input] -> [Input]
forall a b. (a -> b) -> a -> b
$ (([Input] -> [Input])
-> (Text -> [Input] -> [Input]) -> Maybe Text -> [Input] -> [Input]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Input] -> [Input]
forall a. a -> a
id (\Text
t -> ((Text -> Text -> Input
Input Text
"caption" Text
t)Input -> [Input] -> [Input]
forall a. a -> [a] -> [a]
:)) Maybe Text
sendDocumentCaption)
        ([Input] -> [Input]) -> [Input] -> [Input]
forall a b. (a -> b) -> a -> b
$ (([Input] -> [Input])
-> (ParseMode -> [Input] -> [Input])
-> Maybe ParseMode
-> [Input]
-> [Input]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Input] -> [Input]
forall a. a -> a
id (\ParseMode
t -> ((Text -> Text -> Input
Input Text
"parse_mode" (Text -> Text
TL.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ParseMode -> Text
forall a. ToJSON a => a -> Text
encodeToLazyText ParseMode
t))Input -> [Input] -> [Input]
forall a. a -> [a] -> [a]
:)) Maybe ParseMode
sendDocumentParseMode)
        ([Input] -> [Input]) -> [Input] -> [Input]
forall a b. (a -> b) -> a -> b
$ (([Input] -> [Input])
-> ([MessageEntity] -> [Input] -> [Input])
-> Maybe [MessageEntity]
-> [Input]
-> [Input]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Input] -> [Input]
forall a. a -> a
id (\[MessageEntity]
t -> ((Text -> Text -> Input
Input Text
"caption_entities" (Text -> Text
TL.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [MessageEntity] -> Text
forall a. ToJSON a => a -> Text
encodeToLazyText [MessageEntity]
t))Input -> [Input] -> [Input]
forall a. a -> [a] -> [a]
:)) Maybe [MessageEntity]
sendDocumentCaptionEntities)
        ([Input] -> [Input]) -> [Input] -> [Input]
forall a b. (a -> b) -> a -> b
$ (([Input] -> [Input])
-> (Bool -> [Input] -> [Input]) -> Maybe Bool -> [Input] -> [Input]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Input] -> [Input]
forall a. a -> a
id (\Bool
t -> ((Text -> Text -> Input
Input Text
"disable_notification" (Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"false" Text
"true" Bool
t))Input -> [Input] -> [Input]
forall a. a -> [a] -> [a]
:)) Maybe Bool
sendDocumentDisableNotification)
        ([Input] -> [Input]) -> [Input] -> [Input]
forall a b. (a -> b) -> a -> b
$ (([Input] -> [Input])
-> (Bool -> [Input] -> [Input]) -> Maybe Bool -> [Input] -> [Input]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Input] -> [Input]
forall a. a -> a
id (\Bool
t -> ((Text -> Text -> Input
Input Text
"disable_content_type_detection" (Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"false" Text
"true" Bool
t))Input -> [Input] -> [Input]
forall a. a -> [a] -> [a]
:)) Maybe Bool
sendDocumentDisableContentTypeDetection)
        ([Input] -> [Input]) -> [Input] -> [Input]
forall a b. (a -> b) -> a -> b
$ (([Input] -> [Input])
-> (Bool -> [Input] -> [Input]) -> Maybe Bool -> [Input] -> [Input]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Input] -> [Input]
forall a. a -> a
id (\Bool
t -> ((Text -> Text -> Input
Input Text
"protect_content" (Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"false" Text
"true" Bool
t))Input -> [Input] -> [Input]
forall a. a -> [a] -> [a]
:)) Maybe Bool
sendDocumentProtectContent)
        ([Input] -> [Input]) -> [Input] -> [Input]
forall a b. (a -> b) -> a -> b
$ (([Input] -> [Input])
-> (MessageId -> [Input] -> [Input])
-> Maybe MessageId
-> [Input]
-> [Input]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Input] -> [Input]
forall a. a -> a
id (\MessageId
t -> ((Text -> Text -> Input
Input Text
"reply_to_message_id" (Text -> Text
TL.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ MessageId -> Text
forall a. ToJSON a => a -> Text
encodeToLazyText MessageId
t))Input -> [Input] -> [Input]
forall a. a -> [a] -> [a]
:)) Maybe MessageId
sendDocumentReplyToMessageId)
        ([Input] -> [Input]) -> [Input] -> [Input]
forall a b. (a -> b) -> a -> b
$ (([Input] -> [Input])
-> (ReplyParameters -> [Input] -> [Input])
-> Maybe ReplyParameters
-> [Input]
-> [Input]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Input] -> [Input]
forall a. a -> a
id (\ReplyParameters
t -> ((Text -> Text -> Input
Input Text
"reply_parameters" (Text -> Text
TL.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ReplyParameters -> Text
forall a. ToJSON a => a -> Text
encodeToLazyText ReplyParameters
t))Input -> [Input] -> [Input]
forall a. a -> [a] -> [a]
:)) Maybe ReplyParameters
sendDocumentReplyParameters)
        ([Input] -> [Input]) -> [Input] -> [Input]
forall a b. (a -> b) -> a -> b
$ (([Input] -> [Input])
-> (SomeReplyMarkup -> [Input] -> [Input])
-> Maybe SomeReplyMarkup
-> [Input]
-> [Input]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Input] -> [Input]
forall a. a -> a
id (\SomeReplyMarkup
t -> ((Text -> Text -> Input
Input Text
"reply_markup" (Text -> Text
TL.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ SomeReplyMarkup -> Text
forall a. ToJSON a => a -> Text
encodeToLazyText SomeReplyMarkup
t))Input -> [Input] -> [Input]
forall a. a -> [a] -> [a]
:)) Maybe SomeReplyMarkup
sendDocumentReplyMarkup)
        [])
    files :: [FileData Tmp]
files
      = (Text -> Text -> Text -> MultipartResult Tmp -> FileData Tmp
forall tag.
Text -> Text -> Text -> MultipartResult tag -> FileData tag
FileData Text
"file" (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeFileName FilePath
path) Text
ct FilePath
MultipartResult Tmp
path)
      FileData Tmp -> [FileData Tmp] -> [FileData Tmp]
forall a. a -> [a] -> [a]
: [FileData Tmp]
-> (FilePath -> [FileData Tmp]) -> Maybe FilePath -> [FileData Tmp]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\FilePath
t -> [Text -> Text -> Text -> MultipartResult Tmp -> FileData Tmp
forall tag.
Text -> Text -> Text -> MultipartResult tag -> FileData tag
FileData Text
"thumbnail" (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeFileName FilePath
t) Text
"image/jpeg" FilePath
MultipartResult Tmp
t]) Maybe FilePath
sendDocumentThumbnail

    DocumentFile FilePath
path Text
ct = DocumentFile
sendDocumentDocument


instance ToJSON   SendDocumentRequest where toJSON :: SendDocumentRequest -> Value
toJSON = SendDocumentRequest -> Value
forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON

makeDefault ''SendDocumentRequest

-- | Generate send document structure.
toSendDocument :: SomeChatId -> DocumentFile -> SendDocumentRequest
toSendDocument :: SomeChatId -> DocumentFile -> SendDocumentRequest
toSendDocument = SomeChatId -> DocumentFile -> SendDocumentRequest
defSendDocument