{-# 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
import Telegram.Bot.API.Internal.TH
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
(PhotoFile -> Value)
-> (PhotoFile -> Encoding)
-> ([PhotoFile] -> Value)
-> ([PhotoFile] -> Encoding)
-> ToJSON PhotoFile
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) -> (Void# -> r) -> r
PhotoFileId x = MakePhotoFile (InputFileId x)
pattern PhotoUrl :: Text -> PhotoFile
pattern $bPhotoUrl :: Text -> PhotoFile
$mPhotoUrl :: forall r. PhotoFile -> (Text -> r) -> (Void# -> r) -> r
PhotoUrl x = MakePhotoFile (FileUrl x)
pattern PhotoFile :: FilePath -> ContentType -> PhotoFile
pattern $bPhotoFile :: FilePath -> Text -> PhotoFile
$mPhotoFile :: forall r. PhotoFile -> (FilePath -> Text -> r) -> (Void# -> r) -> r
PhotoFile x y = MakePhotoFile (InputFile x y)
data SendPhotoRequest = SendPhotoRequest
{ SendPhotoRequest -> SomeChatId
sendPhotoChatId :: SomeChatId
, SendPhotoRequest -> Maybe MessageThreadId
sendPhotoMessageThreadId :: Maybe MessageThreadId
, SendPhotoRequest -> PhotoFile
sendPhotoPhoto :: PhotoFile
, SendPhotoRequest -> Maybe FilePath
sendPhotoThumb :: Maybe FilePath
, SendPhotoRequest -> Maybe Text
sendPhotoCaption :: Maybe Text
, SendPhotoRequest -> Maybe ParseMode
sendPhotoParseMode :: Maybe ParseMode
, SendPhotoRequest -> Maybe [MessageEntity]
sendPhotoCaptionEntities :: Maybe [MessageEntity]
, SendPhotoRequest -> Maybe Bool
sendPhotoHasSpoiler :: Maybe Bool
, SendPhotoRequest -> Maybe Bool
sendPhotoDisableNotification :: Maybe Bool
, SendPhotoRequest -> Maybe Bool
sendPhotoProtectContent :: Maybe Bool
, SendPhotoRequest -> Maybe MessageId
sendPhotoReplyToMessageId :: Maybe MessageId
, SendPhotoRequest -> Maybe Bool
sendPhotoAllowSendingWithoutReply :: Maybe Bool
, SendPhotoRequest -> Maybe SomeReplyMarkup
sendPhotoReplyMarkup :: Maybe SomeReplyMarkup
}
deriving (forall x. SendPhotoRequest -> Rep SendPhotoRequest x)
-> (forall x. Rep SendPhotoRequest x -> SendPhotoRequest)
-> Generic SendPhotoRequest
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
..} = [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
"photo" (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
sendPhotoChatId 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
sendPhotoMessageThreadId)
([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
"thumb" Text
"attach://thumb")Input -> [Input] -> [Input]
forall a. a -> [a] -> [a]
:)) Maybe FilePath
sendPhotoThumb)
([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
sendPhotoCaption)
([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) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
TL.replace Text
"\"" Text
"" (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
sendPhotoParseMode)
([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]
sendPhotoCaptionEntities)
([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
"has_spoiler" (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
sendPhotoHasSpoiler)
([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
sendPhotoDisableNotification)
([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
sendPhotoProtectContent)
([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
sendPhotoReplyToMessageId)
([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
"allow_sending_without_reply" (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
sendPhotoAllowSendingWithoutReply)
([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
sendPhotoReplyMarkup)
[])
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
"thumb" (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
sendPhotoThumb
PhotoFile FilePath
path Text
ct = PhotoFile
sendPhotoPhoto
instance ToJSON SendPhotoRequest where toJSON :: SendPhotoRequest -> Value
toJSON = SendPhotoRequest -> Value
forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON
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 <- IO ByteString -> ClientM ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ByteString
genBoundary
Proxy SendPhotoContent
-> (ByteString, SendPhotoRequest) -> ClientM (Response Message)
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy SendPhotoContent
forall k (t :: k). Proxy t
Proxy @SendPhotoContent) (ByteString
boundary, SendPhotoRequest
r)
PhotoFile
_ -> Proxy SendPhotoLink
-> SendPhotoRequest -> ClientM (Response Message)
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy SendPhotoLink
forall k (t :: k). Proxy t
Proxy @SendPhotoLink) SendPhotoRequest
r
makeDefault ''SendPhotoRequest