{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE LambdaCase #-}
module Telegram.Bot.API.Stickers where
import Control.Monad.IO.Class
import Data.Aeson
import Data.Aeson.Text
import Data.Bool
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Proxy
import GHC.Generics (Generic)
import Servant.API
import Servant.Client hiding (Response)
import Servant.Multipart.API
import Servant.Multipart.Client
import Telegram.Bot.API.Internal.Utils
import Telegram.Bot.API.MakingRequests (Response)
import Telegram.Bot.API.Types
import Data.Maybe (catMaybes)
import Data.Functor
import Telegram.Bot.API.Internal.TH (makeDefault)
data StickerType
= PngSticker
| TgsSticker
| WebmSticker
data StickerFile = StickerFile {StickerFile -> InputFile
stickerFileSticker :: InputFile, StickerFile -> StickerType
stickerFileLabel :: StickerType}
data SendStickerRequest = SendStickerRequest
{ SendStickerRequest -> SomeChatId
sendStickerChatId :: SomeChatId
, SendStickerRequest -> Maybe MessageThreadId
sendStickerMessageThreadId :: Maybe MessageThreadId
, SendStickerRequest -> Maybe Text
sendStickerEmoji :: Maybe Text
, SendStickerRequest -> InputFile
sendStickerSticker :: InputFile
, SendStickerRequest -> Maybe Bool
sendStickerDisableNotification :: Maybe Bool
, SendStickerRequest -> Maybe Bool
sendStickerProtectContent :: Maybe Bool
, SendStickerRequest -> Maybe MessageId
sendStickerReplyToMessageId :: Maybe MessageId
, SendStickerRequest -> Maybe Bool
sendStickerAllowSendingWithoutReply :: Maybe Bool
, SendStickerRequest -> Maybe InlineKeyboardMarkup
sendStickerReplyMarkup :: Maybe InlineKeyboardMarkup
}
deriving forall x. Rep SendStickerRequest x -> SendStickerRequest
forall x. SendStickerRequest -> Rep SendStickerRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SendStickerRequest x -> SendStickerRequest
$cfrom :: forall x. SendStickerRequest -> Rep SendStickerRequest x
Generic
instance ToJSON SendStickerRequest where toJSON :: SendStickerRequest -> Value
toJSON = forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON
instance ToMultipart Tmp SendStickerRequest where
toMultipart :: SendStickerRequest -> MultipartData Tmp
toMultipart SendStickerRequest{Maybe Bool
Maybe Text
Maybe MessageThreadId
Maybe MessageId
Maybe InlineKeyboardMarkup
SomeChatId
InputFile
sendStickerReplyMarkup :: Maybe InlineKeyboardMarkup
sendStickerAllowSendingWithoutReply :: Maybe Bool
sendStickerReplyToMessageId :: Maybe MessageId
sendStickerProtectContent :: Maybe Bool
sendStickerDisableNotification :: Maybe Bool
sendStickerSticker :: InputFile
sendStickerEmoji :: Maybe Text
sendStickerMessageThreadId :: Maybe MessageThreadId
sendStickerChatId :: SomeChatId
sendStickerReplyMarkup :: SendStickerRequest -> Maybe InlineKeyboardMarkup
sendStickerAllowSendingWithoutReply :: SendStickerRequest -> Maybe Bool
sendStickerReplyToMessageId :: SendStickerRequest -> Maybe MessageId
sendStickerProtectContent :: SendStickerRequest -> Maybe Bool
sendStickerDisableNotification :: SendStickerRequest -> Maybe Bool
sendStickerSticker :: SendStickerRequest -> InputFile
sendStickerEmoji :: SendStickerRequest -> Maybe Text
sendStickerMessageThreadId :: SendStickerRequest -> Maybe MessageThreadId
sendStickerChatId :: SendStickerRequest -> SomeChatId
..} =
Text -> InputFile -> MultipartData Tmp -> MultipartData Tmp
makeFile Text
"sticker" InputFile
sendStickerSticker (forall tag. [Input] -> [FileData tag] -> MultipartData tag
MultipartData [Input]
fields []) where
fields :: [Input]
fields =
[ Text -> Text -> Input
Input Text
"chat_id" forall a b. (a -> b) -> a -> b
$ case SomeChatId
sendStickerChatId of
SomeChatId (ChatId Integer
chat_id) -> String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Integer
chat_id
SomeChatUsername Text
txt -> Text
txt
] forall a. Semigroup a => a -> a -> a
<> forall a. [Maybe a] -> [a]
catMaybes
[ Maybe MessageThreadId
sendStickerMessageThreadId forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
\MessageThreadId
t -> Text -> Text -> Input
Input Text
"message_thread_id" (String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show MessageThreadId
t)
, Maybe Bool
sendStickerDisableNotification forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
\Bool
t -> Text -> Text -> Input
Input Text
"disable_notification" (forall a. a -> a -> Bool -> a
bool Text
"false" Text
"true" Bool
t)
, Maybe Bool
sendStickerProtectContent forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
\Bool
t -> Text -> Text -> Input
Input Text
"protect_content" (forall a. a -> a -> Bool -> a
bool Text
"false" Text
"true" Bool
t)
, Maybe MessageId
sendStickerReplyToMessageId forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
\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)
, Maybe Bool
sendStickerAllowSendingWithoutReply forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
\Bool
t -> Text -> Text -> Input
Input Text
"allow_sending_without_reply" (forall a. a -> a -> Bool -> a
bool Text
"false" Text
"true" Bool
t)
, Maybe InlineKeyboardMarkup
sendStickerReplyMarkup forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
\InlineKeyboardMarkup
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 InlineKeyboardMarkup
t)
]
type SendStickerContent
= "sendSticker"
:> MultipartForm Tmp SendStickerRequest
:> Post '[JSON] (Response Message)
type SendStickerLink
= "sendSticker"
:> ReqBody '[JSON] SendStickerRequest
:> Post '[JSON] (Response Message)
sendSticker :: SendStickerRequest -> ClientM (Response Message)
sendSticker :: SendStickerRequest -> ClientM (Response Message)
sendSticker SendStickerRequest
r =
case SendStickerRequest -> InputFile
sendStickerSticker SendStickerRequest
r of
InputFile{} -> 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 @SendStickerContent) (ByteString
boundary, SendStickerRequest
r)
InputFile
_ -> forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall {k} (t :: k). Proxy t
Proxy @SendStickerLink) SendStickerRequest
r
data GetCustomEmojiStickersRequest = GetCustomEmojiStickersRequest
{ GetCustomEmojiStickersRequest -> [Text]
getCustomEmojiStickersRequestCustomEmojiIds :: [Text]
}
deriving forall x.
Rep GetCustomEmojiStickersRequest x
-> GetCustomEmojiStickersRequest
forall x.
GetCustomEmojiStickersRequest
-> Rep GetCustomEmojiStickersRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetCustomEmojiStickersRequest x
-> GetCustomEmojiStickersRequest
$cfrom :: forall x.
GetCustomEmojiStickersRequest
-> Rep GetCustomEmojiStickersRequest x
Generic
instance ToJSON GetCustomEmojiStickersRequest where toJSON :: GetCustomEmojiStickersRequest -> Value
toJSON = forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON
type GetCustomEmojiStickers
= "getCustomEmojiStickers"
:> ReqBody '[JSON] GetCustomEmojiStickersRequest
:> Post '[JSON] (Response [Sticker])
getCustomEmojiStickers :: GetCustomEmojiStickersRequest -> ClientM (Response [Sticker])
getCustomEmojiStickers :: GetCustomEmojiStickersRequest -> ClientM (Response [Sticker])
getCustomEmojiStickers = forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall {k} (t :: k). Proxy t
Proxy @GetCustomEmojiStickers)
data UploadStickerFileRequest = UploadStickerFileRequest
{ UploadStickerFileRequest -> UserId
uploadStickerFileUserId :: UserId
, UploadStickerFileRequest -> InputFile
uploadStickerFileSticker :: InputFile
, UploadStickerFileRequest -> Text
uploadStickerFileStickerFormat :: Text
} deriving forall x.
Rep UploadStickerFileRequest x -> UploadStickerFileRequest
forall x.
UploadStickerFileRequest -> Rep UploadStickerFileRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UploadStickerFileRequest x -> UploadStickerFileRequest
$cfrom :: forall x.
UploadStickerFileRequest -> Rep UploadStickerFileRequest x
Generic
instance ToJSON UploadStickerFileRequest where toJSON :: UploadStickerFileRequest -> Value
toJSON = forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON
instance ToMultipart Tmp UploadStickerFileRequest where
toMultipart :: UploadStickerFileRequest -> MultipartData Tmp
toMultipart UploadStickerFileRequest{Text
UserId
InputFile
uploadStickerFileStickerFormat :: Text
uploadStickerFileSticker :: InputFile
uploadStickerFileUserId :: UserId
uploadStickerFileStickerFormat :: UploadStickerFileRequest -> Text
uploadStickerFileSticker :: UploadStickerFileRequest -> InputFile
uploadStickerFileUserId :: UploadStickerFileRequest -> UserId
..} =
Text -> InputFile -> MultipartData Tmp -> MultipartData Tmp
makeFile Text
"sticker" InputFile
uploadStickerFileSticker (forall tag. [Input] -> [FileData tag] -> MultipartData tag
MultipartData [Input]
fields []) where
fields :: [Input]
fields = [ Text -> Text -> Input
Input Text
"user_id" forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ UserId
uploadStickerFileUserId
, Text -> Text -> Input
Input Text
"sticker_format" forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Text
uploadStickerFileStickerFormat
]
type UploadStickerFileContent
= "uploadStickerFile"
:> MultipartForm Tmp UploadStickerFileRequest
:> Post '[JSON] (Response File)
type UploadStickerFileLink
= "uploadStickerFile"
:> ReqBody '[JSON] UploadStickerFileRequest
:> Post '[JSON] (Response File)
uploadStickerFile :: UploadStickerFileRequest -> ClientM (Response File)
uploadStickerFile :: UploadStickerFileRequest -> ClientM (Response File)
uploadStickerFile UploadStickerFileRequest
r =
case UploadStickerFileRequest -> InputFile
uploadStickerFileSticker UploadStickerFileRequest
r of
InputFile{} -> 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 @UploadStickerFileContent) (ByteString
boundary, UploadStickerFileRequest
r)
InputFile
_ -> forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall {k} (t :: k). Proxy t
Proxy @UploadStickerFileLink) UploadStickerFileRequest
r
data CreateNewStickerSetRequest = CreateNewStickerSetRequest
{ CreateNewStickerSetRequest -> UserId
createNewStickerSetUserId :: UserId
, CreateNewStickerSetRequest -> Text
createNewStickerSetName :: T.Text
, CreateNewStickerSetRequest -> Text
createNewStickerSetTitle :: T.Text
, CreateNewStickerSetRequest -> [InputSticker]
createNewStickerSetStickers :: [InputSticker]
, CreateNewStickerSetRequest -> Text
createNewStickerFormat :: Text
, CreateNewStickerSetRequest -> Maybe StickerSetType
createNewStickerSetType :: Maybe StickerSetType
, CreateNewStickerSetRequest -> Maybe Bool
createNewStickerSetNeedsRepainting :: Maybe Bool
} deriving forall x.
Rep CreateNewStickerSetRequest x -> CreateNewStickerSetRequest
forall x.
CreateNewStickerSetRequest -> Rep CreateNewStickerSetRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateNewStickerSetRequest x -> CreateNewStickerSetRequest
$cfrom :: forall x.
CreateNewStickerSetRequest -> Rep CreateNewStickerSetRequest x
Generic
instance ToJSON CreateNewStickerSetRequest where toJSON :: CreateNewStickerSetRequest -> Value
toJSON = forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON
type CreateNewStickerSet
= "createNewStickerSet"
:> ReqBody '[JSON] CreateNewStickerSetRequest
:> Post '[JSON] (Response Bool)
createNewStickerSet :: CreateNewStickerSetRequest -> ClientM (Response Bool)
createNewStickerSet :: CreateNewStickerSetRequest -> ClientM (Response Bool)
createNewStickerSet = forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall {k} (t :: k). Proxy t
Proxy @CreateNewStickerSet)
data AddStickerToSetRequest = AddStickerToSetRequest
{ AddStickerToSetRequest -> UserId
addStickerToSetUserId :: UserId
, AddStickerToSetRequest -> Text
addStickerToSetName :: T.Text
, AddStickerToSetRequest -> InputSticker
addStickerToSetStickers :: InputSticker
} deriving forall x. Rep AddStickerToSetRequest x -> AddStickerToSetRequest
forall x. AddStickerToSetRequest -> Rep AddStickerToSetRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddStickerToSetRequest x -> AddStickerToSetRequest
$cfrom :: forall x. AddStickerToSetRequest -> Rep AddStickerToSetRequest x
Generic
instance ToJSON AddStickerToSetRequest where toJSON :: AddStickerToSetRequest -> Value
toJSON = forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON
type AddStickerToSet
= "addStickerToSet"
:> ReqBody '[JSON] AddStickerToSetRequest
:> Post '[JSON] (Response Bool)
addStickerToSet :: AddStickerToSetRequest -> ClientM (Response Bool)
addStickerToSet :: AddStickerToSetRequest -> ClientM (Response Bool)
addStickerToSet = forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall {k} (t :: k). Proxy t
Proxy @AddStickerToSet)
type GetStickerSet
= "getStickerSet"
:> RequiredQueryParam "name" T.Text
:> Get '[JSON] (Response StickerSet)
getStickerSet :: T.Text
-> ClientM (Response StickerSet)
getStickerSet :: Text -> ClientM (Response StickerSet)
getStickerSet = forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall {k} (t :: k). Proxy t
Proxy @GetStickerSet)
type SetStickerPositionInSet
= "setStickerPositionInSet"
:> RequiredQueryParam "sticker" T.Text
:> RequiredQueryParam "position" Integer
:> Post '[JSON] (Response Bool)
setStickerPositionInSet :: T.Text
-> Integer
-> ClientM (Response Bool)
setStickerPositionInSet :: Text -> Integer -> ClientM (Response Bool)
setStickerPositionInSet = forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall {k} (t :: k). Proxy t
Proxy @SetStickerPositionInSet)
type DeleteStickerFromSet
= "deleteStickerFromSet"
:> RequiredQueryParam "sticker" T.Text
:> Post '[JSON] (Response Bool)
deleteStickerFromSet :: T.Text
-> ClientM (Response Bool)
deleteStickerFromSet :: Text -> ClientM (Response Bool)
deleteStickerFromSet = forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall {k} (t :: k). Proxy t
Proxy @DeleteStickerFromSet)
data SetStickerSetThumbnailRequest = SetStickerSetThumbnailRequest
{ SetStickerSetThumbnailRequest -> Text
setStickerSetThumbnailName :: T.Text
, SetStickerSetThumbnailRequest -> UserId
setStickerSetThumbnailUserId :: UserId
, SetStickerSetThumbnailRequest -> InputFile
setStickerSetThumbnailThumbnail :: InputFile
} deriving forall x.
Rep SetStickerSetThumbnailRequest x
-> SetStickerSetThumbnailRequest
forall x.
SetStickerSetThumbnailRequest
-> Rep SetStickerSetThumbnailRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SetStickerSetThumbnailRequest x
-> SetStickerSetThumbnailRequest
$cfrom :: forall x.
SetStickerSetThumbnailRequest
-> Rep SetStickerSetThumbnailRequest x
Generic
instance ToJSON SetStickerSetThumbnailRequest where toJSON :: SetStickerSetThumbnailRequest -> Value
toJSON = forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON
instance ToMultipart Tmp SetStickerSetThumbnailRequest where
toMultipart :: SetStickerSetThumbnailRequest -> MultipartData Tmp
toMultipart SetStickerSetThumbnailRequest{Text
UserId
InputFile
setStickerSetThumbnailThumbnail :: InputFile
setStickerSetThumbnailUserId :: UserId
setStickerSetThumbnailName :: Text
setStickerSetThumbnailThumbnail :: SetStickerSetThumbnailRequest -> InputFile
setStickerSetThumbnailUserId :: SetStickerSetThumbnailRequest -> UserId
setStickerSetThumbnailName :: SetStickerSetThumbnailRequest -> Text
..} =
Text -> InputFile -> MultipartData Tmp -> MultipartData Tmp
makeFile Text
"png_sticker" InputFile
setStickerSetThumbnailThumbnail (forall tag. [Input] -> [FileData tag] -> MultipartData tag
MultipartData [Input]
fields []) where
fields :: [Input]
fields =
[ Text -> Text -> Input
Input Text
"user_id" forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ UserId
setStickerSetThumbnailUserId
, Text -> Text -> Input
Input Text
"name" Text
setStickerSetThumbnailName
]
type SetStickerSetThumbnailContent
= "setStickerSetThumbnail"
:> MultipartForm Tmp SetStickerSetThumbnailRequest
:> Post '[JSON] (Response Bool)
type SetStickerSetThumbnailLink
= "setStickerSetThumbnail"
:> ReqBody '[JSON] SetStickerSetThumbnailRequest
:> Post '[JSON] (Response Bool)
setStickerSetThumbnail :: SetStickerSetThumbnailRequest -> ClientM (Response Bool)
setStickerSetThumbnail :: SetStickerSetThumbnailRequest -> ClientM (Response Bool)
setStickerSetThumbnail SetStickerSetThumbnailRequest
r =
case SetStickerSetThumbnailRequest -> InputFile
setStickerSetThumbnailThumbnail SetStickerSetThumbnailRequest
r of
InputFile{} -> 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 @SetStickerSetThumbnailContent) (ByteString
boundary, SetStickerSetThumbnailRequest
r)
InputFile
_ -> forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall {k} (t :: k). Proxy t
Proxy @SetStickerSetThumbnailLink) SetStickerSetThumbnailRequest
r
foldMap makeDefault
[ ''SendStickerRequest
, ''GetCustomEmojiStickersRequest
, ''UploadStickerFileRequest
, ''CreateNewStickerSetRequest
, ''AddStickerToSetRequest
, ''SetStickerSetThumbnailRequest
]