{-# 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.SendPhoto 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

-- * Available methods

-- ** 'sendPhoto'
type SendPhotoContent
  = "sendPhoto"
  :> MultipartForm Tmp SendPhotoRequest
  :> Post '[JSON] (Response Message)

type SendPhotoLink
  = "sendPhoto"
  :> ReqBody '[JSON] SendPhotoRequest
  :> Post '[JSON] (Response Message)

newtype PhotoFile = MakePhotoFile InputFile
  deriving newtype [PhotoFile] -> Encoding
[PhotoFile] -> Value
PhotoFile -> Encoding
PhotoFile -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PhotoFile] -> Encoding
$ctoEncodingList :: [PhotoFile] -> Encoding
toJSONList :: [PhotoFile] -> Value
$ctoJSONList :: [PhotoFile] -> Value
toEncoding :: PhotoFile -> Encoding
$ctoEncoding :: PhotoFile -> Encoding
toJSON :: PhotoFile -> Value
$ctoJSON :: PhotoFile -> Value
ToJSON

pattern PhotoFileId :: FileId -> PhotoFile
pattern $bPhotoFileId :: FileId -> PhotoFile
$mPhotoFileId :: forall {r}. PhotoFile -> (FileId -> r) -> ((# #) -> r) -> r
PhotoFileId x = MakePhotoFile (InputFileId x)

pattern PhotoUrl :: Text -> PhotoFile
pattern $bPhotoUrl :: Text -> PhotoFile
$mPhotoUrl :: forall {r}. PhotoFile -> (Text -> r) -> ((# #) -> r) -> r
PhotoUrl x = MakePhotoFile (FileUrl x)

pattern PhotoFile :: FilePath -> ContentType -> PhotoFile
pattern $bPhotoFile :: FilePath -> Text -> PhotoFile
$mPhotoFile :: forall {r}.
PhotoFile -> (FilePath -> Text -> r) -> ((# #) -> r) -> r
PhotoFile x y = MakePhotoFile (InputFile x y)


-- | Request parameters for 'sendPhoto'
data SendPhotoRequest = SendPhotoRequest
  { SendPhotoRequest -> SomeChatId
sendPhotoChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @\@channelusername@).
  , SendPhotoRequest -> Maybe MessageThreadId
sendPhotoMessageThreadId :: Maybe MessageThreadId -- ^ Unique identifier for the target message thread (topic) of the forum; for forum supergroups only.
  , SendPhotoRequest -> PhotoFile
sendPhotoPhoto :: PhotoFile -- ^ 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
  , SendPhotoRequest -> Maybe FilePath
sendPhotoThumb :: 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>
  , SendPhotoRequest -> Maybe Text
sendPhotoCaption :: Maybe Text -- ^ Photo caption (may also be used when resending Photos by file_id), 0-1024 characters after entities parsing
  , SendPhotoRequest -> Maybe ParseMode
sendPhotoParseMode :: 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.
  , SendPhotoRequest -> Maybe [MessageEntity]
sendPhotoCaptionEntities :: Maybe [MessageEntity] -- ^ A JSON-serialized list of special entities that appear in the caption, which can be specified instead of /parse_mode/.
  , SendPhotoRequest -> Maybe Bool
sendPhotoHasSpoiler :: Maybe Bool -- ^ Pass 'True' if the photo needs to be covered with a spoiler animation.
  , SendPhotoRequest -> Maybe Bool
sendPhotoDisableNotification :: Maybe Bool -- ^ Sends the message silently. Users will receive a notification with no sound.
  , SendPhotoRequest -> Maybe Bool
sendPhotoProtectContent      :: Maybe Bool -- ^ Protects the contents of the sent message from forwarding and saving.  
  , SendPhotoRequest -> Maybe MessageId
sendPhotoReplyToMessageId :: Maybe MessageId -- ^ If the message is a reply, ID of the original message.
  , SendPhotoRequest -> Maybe Bool
sendPhotoAllowSendingWithoutReply :: Maybe Bool -- ^ Pass 'True', if the message should be sent even if the specified replied-to message is not found.
  , SendPhotoRequest -> Maybe SomeReplyMarkup
sendPhotoReplyMarkup :: 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. Rep SendPhotoRequest x -> SendPhotoRequest
forall x. SendPhotoRequest -> Rep SendPhotoRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SendPhotoRequest x -> SendPhotoRequest
$cfrom :: forall x. SendPhotoRequest -> Rep SendPhotoRequest x
Generic

instance ToMultipart Tmp SendPhotoRequest where
  toMultipart :: SendPhotoRequest -> MultipartData Tmp
toMultipart SendPhotoRequest{Maybe Bool
Maybe FilePath
Maybe [MessageEntity]
Maybe Text
Maybe MessageThreadId
Maybe MessageId
Maybe ParseMode
Maybe SomeReplyMarkup
SomeChatId
PhotoFile
sendPhotoReplyMarkup :: Maybe SomeReplyMarkup
sendPhotoAllowSendingWithoutReply :: Maybe Bool
sendPhotoReplyToMessageId :: Maybe MessageId
sendPhotoProtectContent :: Maybe Bool
sendPhotoDisableNotification :: Maybe Bool
sendPhotoHasSpoiler :: Maybe Bool
sendPhotoCaptionEntities :: Maybe [MessageEntity]
sendPhotoParseMode :: Maybe ParseMode
sendPhotoCaption :: Maybe Text
sendPhotoThumb :: Maybe FilePath
sendPhotoPhoto :: PhotoFile
sendPhotoMessageThreadId :: Maybe MessageThreadId
sendPhotoChatId :: SomeChatId
sendPhotoReplyMarkup :: SendPhotoRequest -> Maybe SomeReplyMarkup
sendPhotoAllowSendingWithoutReply :: SendPhotoRequest -> Maybe Bool
sendPhotoReplyToMessageId :: SendPhotoRequest -> Maybe MessageId
sendPhotoProtectContent :: SendPhotoRequest -> Maybe Bool
sendPhotoDisableNotification :: SendPhotoRequest -> Maybe Bool
sendPhotoHasSpoiler :: SendPhotoRequest -> Maybe Bool
sendPhotoCaptionEntities :: SendPhotoRequest -> Maybe [MessageEntity]
sendPhotoParseMode :: SendPhotoRequest -> Maybe ParseMode
sendPhotoCaption :: SendPhotoRequest -> Maybe Text
sendPhotoThumb :: SendPhotoRequest -> Maybe FilePath
sendPhotoPhoto :: SendPhotoRequest -> PhotoFile
sendPhotoMessageThreadId :: SendPhotoRequest -> Maybe MessageThreadId
sendPhotoChatId :: SendPhotoRequest -> SomeChatId
..} = forall tag. [Input] -> [FileData tag] -> MultipartData tag
MultipartData [Input]
fields [FileData Tmp]
files where
    fields :: [Input]
fields =
      [ Text -> Text -> Input
Input Text
"photo" forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ FilePath
"attach://file"
      , Text -> Text -> Input
Input Text
"chat_id" forall a b. (a -> b) -> a -> b
$ case SomeChatId
sendPhotoChatId of
          SomeChatId (ChatId Integer
chat_id) -> FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show Integer
chat_id
          SomeChatUsername Text
txt -> Text
txt
      ] forall a. Semigroup a => a -> a -> a
<>
      (   (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\MessageThreadId
t -> ((Text -> Text -> Input
Input Text
"message_thread_id" (FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show MessageThreadId
t))forall a. a -> [a] -> [a]
:)) Maybe MessageThreadId
sendPhotoMessageThreadId)
        forall a b. (a -> b) -> a -> b
$ (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\FilePath
_ -> ((Text -> Text -> Input
Input Text
"thumb" Text
"attach://thumb")forall a. a -> [a] -> [a]
:)) Maybe FilePath
sendPhotoThumb)
        forall a b. (a -> b) -> a -> b
$ (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\Text
t -> ((Text -> Text -> Input
Input Text
"caption" Text
t)forall a. a -> [a] -> [a]
:)) Maybe Text
sendPhotoCaption)
        forall a b. (a -> b) -> a -> b
$ (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\ParseMode
t -> ((Text -> Text -> Input
Input Text
"parse_mode" (Text -> Text
TL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
TL.replace Text
"\"" Text
"" forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Text
encodeToLazyText ParseMode
t))forall a. a -> [a] -> [a]
:)) Maybe ParseMode
sendPhotoParseMode)
        forall a b. (a -> b) -> a -> b
$ (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\[MessageEntity]
t -> ((Text -> Text -> Input
Input Text
"caption_entities" (Text -> Text
TL.toStrict forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Text
encodeToLazyText [MessageEntity]
t))forall a. a -> [a] -> [a]
:)) Maybe [MessageEntity]
sendPhotoCaptionEntities)
        forall a b. (a -> b) -> a -> b
$ (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\Bool
t -> ((Text -> Text -> Input
Input Text
"has_spoiler" (forall a. a -> a -> Bool -> a
bool Text
"false" Text
"true" Bool
t))forall a. a -> [a] -> [a]
:)) Maybe Bool
sendPhotoHasSpoiler)
        forall a b. (a -> b) -> a -> b
$ (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\Bool
t -> ((Text -> Text -> Input
Input Text
"disable_notification" (forall a. a -> a -> Bool -> a
bool Text
"false" Text
"true" Bool
t))forall a. a -> [a] -> [a]
:)) Maybe Bool
sendPhotoDisableNotification)
        forall a b. (a -> b) -> a -> b
$ (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\Bool
t -> ((Text -> Text -> Input
Input Text
"protect_content" (forall a. a -> a -> Bool -> a
bool Text
"false" Text
"true" Bool
t))forall a. a -> [a] -> [a]
:)) Maybe Bool
sendPhotoProtectContent)
        forall a b. (a -> b) -> a -> b
$ (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\MessageId
t -> ((Text -> Text -> Input
Input Text
"reply_to_message_id" (Text -> Text
TL.toStrict forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Text
encodeToLazyText MessageId
t))forall a. a -> [a] -> [a]
:)) Maybe MessageId
sendPhotoReplyToMessageId)
        forall a b. (a -> b) -> a -> b
$ (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\Bool
t -> ((Text -> Text -> Input
Input Text
"allow_sending_without_reply" (forall a. a -> a -> Bool -> a
bool Text
"false" Text
"true" Bool
t))forall a. a -> [a] -> [a]
:)) Maybe Bool
sendPhotoAllowSendingWithoutReply)
        forall a b. (a -> b) -> a -> b
$ (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (\SomeReplyMarkup
t -> ((Text -> Text -> Input
Input Text
"reply_markup" (Text -> Text
TL.toStrict forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Text
encodeToLazyText SomeReplyMarkup
t))forall a. a -> [a] -> [a]
:)) Maybe SomeReplyMarkup
sendPhotoReplyMarkup)
        [])
    files :: [FileData Tmp]
files
      = (forall tag.
Text -> Text -> Text -> MultipartResult tag -> FileData tag
FileData Text
"file" (FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeFileName FilePath
path) Text
ct FilePath
path)
      forall a. a -> [a] -> [a]
: forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\FilePath
t -> [forall tag.
Text -> Text -> Text -> MultipartResult tag -> FileData tag
FileData Text
"thumb" (FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeFileName FilePath
t) Text
"image/jpeg" FilePath
t]) Maybe FilePath
sendPhotoThumb

    PhotoFile FilePath
path Text
ct = PhotoFile
sendPhotoPhoto

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

-- | Use this method to send photos.
-- On success, the sent 'Message' is returned.
--
-- <https:\/\/core.telegram.org\/bots\/api#sendphoto>
sendPhoto :: SendPhotoRequest -> ClientM (Response Message)
sendPhoto :: SendPhotoRequest -> ClientM (Response Message)
sendPhoto SendPhotoRequest
r = do
  case SendPhotoRequest -> PhotoFile
sendPhotoPhoto SendPhotoRequest
r of
    PhotoFile{} -> do
      ByteString
boundary <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ByteString
genBoundary
      forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall {k} (t :: k). Proxy t
Proxy @SendPhotoContent) (ByteString
boundary, SendPhotoRequest
r)
    PhotoFile
_ -> forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall {k} (t :: k). Proxy t
Proxy @SendPhotoLink) SendPhotoRequest
r