{-# 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] -> Value
[PhotoFile] -> Encoding
PhotoFile -> Bool
PhotoFile -> Value
PhotoFile -> Encoding
(PhotoFile -> Value)
-> (PhotoFile -> Encoding)
-> ([PhotoFile] -> Value)
-> ([PhotoFile] -> Encoding)
-> (PhotoFile -> Bool)
-> ToJSON PhotoFile
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: PhotoFile -> Value
toJSON :: PhotoFile -> Value
$ctoEncoding :: PhotoFile -> Encoding
toEncoding :: PhotoFile -> Encoding
$ctoJSONList :: [PhotoFile] -> Value
toJSONList :: [PhotoFile] -> Value
$ctoEncodingList :: [PhotoFile] -> Encoding
toEncodingList :: [PhotoFile] -> Encoding
$comitField :: PhotoFile -> Bool
omitField :: PhotoFile -> Bool
ToJSON
pattern PhotoFileId :: FileId -> PhotoFile
pattern $mPhotoFileId :: forall {r}. PhotoFile -> (FileId -> r) -> ((# #) -> r) -> r
$bPhotoFileId :: FileId -> PhotoFile
PhotoFileId x = MakePhotoFile (InputFileId x)
pattern PhotoUrl :: Text -> PhotoFile
pattern $mPhotoUrl :: forall {r}. PhotoFile -> (Text -> r) -> ((# #) -> r) -> r
$bPhotoUrl :: Text -> PhotoFile
PhotoUrl x = MakePhotoFile (FileUrl x)
pattern PhotoFile :: FilePath -> ContentType -> PhotoFile
pattern $mPhotoFile :: forall {r}.
PhotoFile -> (FilePath -> Text -> r) -> ((# #) -> r) -> r
$bPhotoFile :: FilePath -> Text -> PhotoFile
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 ReplyParameters
sendPhotoReplyParameters :: Maybe ReplyParameters
, 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
$cfrom :: forall x. SendPhotoRequest -> Rep SendPhotoRequest x
from :: forall x. SendPhotoRequest -> Rep SendPhotoRequest x
$cto :: forall x. Rep SendPhotoRequest x -> SendPhotoRequest
to :: forall x. Rep SendPhotoRequest x -> SendPhotoRequest
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
Maybe ReplyParameters
SomeChatId
PhotoFile
sendPhotoChatId :: SendPhotoRequest -> SomeChatId
sendPhotoMessageThreadId :: SendPhotoRequest -> Maybe MessageThreadId
sendPhotoPhoto :: SendPhotoRequest -> PhotoFile
sendPhotoThumb :: SendPhotoRequest -> Maybe FilePath
sendPhotoCaption :: SendPhotoRequest -> Maybe Text
sendPhotoParseMode :: SendPhotoRequest -> Maybe ParseMode
sendPhotoCaptionEntities :: SendPhotoRequest -> Maybe [MessageEntity]
sendPhotoHasSpoiler :: SendPhotoRequest -> Maybe Bool
sendPhotoDisableNotification :: SendPhotoRequest -> Maybe Bool
sendPhotoProtectContent :: SendPhotoRequest -> Maybe Bool
sendPhotoReplyToMessageId :: SendPhotoRequest -> Maybe MessageId
sendPhotoReplyParameters :: SendPhotoRequest -> Maybe ReplyParameters
sendPhotoReplyMarkup :: SendPhotoRequest -> Maybe SomeReplyMarkup
sendPhotoChatId :: SomeChatId
sendPhotoMessageThreadId :: Maybe MessageThreadId
sendPhotoPhoto :: PhotoFile
sendPhotoThumb :: Maybe FilePath
sendPhotoCaption :: Maybe Text
sendPhotoParseMode :: Maybe ParseMode
sendPhotoCaptionEntities :: Maybe [MessageEntity]
sendPhotoHasSpoiler :: Maybe Bool
sendPhotoDisableNotification :: Maybe Bool
sendPhotoProtectContent :: Maybe Bool
sendPhotoReplyToMessageId :: Maybe MessageId
sendPhotoReplyParameters :: Maybe ReplyParameters
sendPhotoReplyMarkup :: 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
"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
. HasCallStack => Text -> Text -> Text -> Text
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])
-> (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
sendPhotoReplyParameters)
([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 a. IO a -> ClientM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ByteString
genBoundary
Proxy SendPhotoContent -> Client ClientM SendPhotoContent
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SendPhotoContent) (ByteString
boundary, SendPhotoRequest
r)
PhotoFile
_ -> Proxy SendPhotoLink -> Client ClientM SendPhotoLink
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SendPhotoLink) SendPhotoRequest
r
makeDefault ''SendPhotoRequest