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