{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeOperators #-}
module Telegram.Bot.API.Methods where
import Control.Monad.IO.Class
import Data.Aeson
import Data.Aeson.Text
import Data.Bool
import Data.Proxy
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import GHC.Generics (Generic)
import Servant.API
import Servant.Client hiding (Response)
import Servant.Multipart
import System.FilePath
import Telegram.Bot.API.Internal.Utils
import Telegram.Bot.API.MakingRequests
import Telegram.Bot.API.Types
type GetMe = "getMe" :> Get '[JSON] (Response User)
getMe :: ClientM (Response User)
getMe :: ClientM (Response User)
getMe = Proxy GetMe -> Client ClientM GetMe
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy GetMe
forall k (t :: k). Proxy t
Proxy @GetMe)
type DeleteMessage = "deleteMessage"
:> RequiredQueryParam "chat_id" ChatId
:> RequiredQueryParam "message_id" MessageId
:> Get '[JSON] (Response Bool)
deleteMessage :: ChatId -> MessageId -> ClientM (Response Bool)
deleteMessage :: ChatId -> MessageId -> ClientM (Response Bool)
deleteMessage = Proxy DeleteMessage -> Client ClientM DeleteMessage
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy DeleteMessage
forall k (t :: k). Proxy t
Proxy @DeleteMessage)
type SendMessage
= "sendMessage" :> ReqBody '[JSON] SendMessageRequest :> Post '[JSON] (Response Message)
sendMessage :: SendMessageRequest -> ClientM (Response Message)
sendMessage :: SendMessageRequest -> ClientM (Response Message)
sendMessage = Proxy SendMessage -> Client ClientM SendMessage
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy SendMessage
forall k (t :: k). Proxy t
Proxy @SendMessage)
type ForwardMessage
= "forwardMessage" :> ReqBody '[JSON] ForwardMessageRequest :> Post '[JSON] (Response Message)
forwardMessage :: ForwardMessageRequest -> ClientM (Response Message)
forwardMessage :: ForwardMessageRequest -> ClientM (Response Message)
forwardMessage = Proxy ForwardMessage -> Client ClientM ForwardMessage
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy ForwardMessage
forall k (t :: k). Proxy t
Proxy @ForwardMessage)
data SomeChatId
= SomeChatId ChatId
| SomeChatUsername Text
deriving ((forall x. SomeChatId -> Rep SomeChatId x)
-> (forall x. Rep SomeChatId x -> SomeChatId) -> Generic SomeChatId
forall x. Rep SomeChatId x -> SomeChatId
forall x. SomeChatId -> Rep SomeChatId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SomeChatId x -> SomeChatId
$cfrom :: forall x. SomeChatId -> Rep SomeChatId x
Generic)
instance ToJSON SomeChatId where toJSON :: SomeChatId -> Value
toJSON = SomeChatId -> Value
forall a. (Generic a, GSomeJSON (Rep a)) => a -> Value
genericSomeToJSON
instance FromJSON SomeChatId where parseJSON :: Value -> Parser SomeChatId
parseJSON = Value -> Parser SomeChatId
forall a. (Generic a, GSomeJSON (Rep a)) => Value -> Parser a
genericSomeParseJSON
data SomeReplyMarkup
= SomeInlineKeyboardMarkup InlineKeyboardMarkup
| SomeReplyKeyboardMarkup ReplyKeyboardMarkup
| SomeReplyKeyboardRemove ReplyKeyboardRemove
| SomeForceReply ForceReply
deriving ((forall x. SomeReplyMarkup -> Rep SomeReplyMarkup x)
-> (forall x. Rep SomeReplyMarkup x -> SomeReplyMarkup)
-> Generic SomeReplyMarkup
forall x. Rep SomeReplyMarkup x -> SomeReplyMarkup
forall x. SomeReplyMarkup -> Rep SomeReplyMarkup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SomeReplyMarkup x -> SomeReplyMarkup
$cfrom :: forall x. SomeReplyMarkup -> Rep SomeReplyMarkup x
Generic)
instance ToJSON SomeReplyMarkup where toJSON :: SomeReplyMarkup -> Value
toJSON = SomeReplyMarkup -> Value
forall a. (Generic a, GSomeJSON (Rep a)) => a -> Value
genericSomeToJSON
instance FromJSON SomeReplyMarkup where parseJSON :: Value -> Parser SomeReplyMarkup
parseJSON = Value -> Parser SomeReplyMarkup
forall a. (Generic a, GSomeJSON (Rep a)) => Value -> Parser a
genericSomeParseJSON
data ParseMode
= Markdown
| HTML
| MarkdownV2
deriving ((forall x. ParseMode -> Rep ParseMode x)
-> (forall x. Rep ParseMode x -> ParseMode) -> Generic ParseMode
forall x. Rep ParseMode x -> ParseMode
forall x. ParseMode -> Rep ParseMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ParseMode x -> ParseMode
$cfrom :: forall x. ParseMode -> Rep ParseMode x
Generic)
instance ToJSON ParseMode
instance FromJSON ParseMode
data SendMessageRequest = SendMessageRequest
{ SendMessageRequest -> SomeChatId
sendMessageChatId :: SomeChatId
, SendMessageRequest -> Text
sendMessageText :: Text
, SendMessageRequest -> Maybe ParseMode
sendMessageParseMode :: Maybe ParseMode
, SendMessageRequest -> Maybe Bool
sendMessageDisableWebPagePreview :: Maybe Bool
, SendMessageRequest -> Maybe Bool
sendMessageDisableNotification :: Maybe Bool
, SendMessageRequest -> Maybe MessageId
sendMessageReplyToMessageId :: Maybe MessageId
, SendMessageRequest -> Maybe SomeReplyMarkup
sendMessageReplyMarkup :: Maybe SomeReplyMarkup
} deriving ((forall x. SendMessageRequest -> Rep SendMessageRequest x)
-> (forall x. Rep SendMessageRequest x -> SendMessageRequest)
-> Generic SendMessageRequest
forall x. Rep SendMessageRequest x -> SendMessageRequest
forall x. SendMessageRequest -> Rep SendMessageRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SendMessageRequest x -> SendMessageRequest
$cfrom :: forall x. SendMessageRequest -> Rep SendMessageRequest x
Generic)
instance ToJSON SendMessageRequest where toJSON :: SendMessageRequest -> Value
toJSON = SendMessageRequest -> Value
forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON
instance FromJSON SendMessageRequest where parseJSON :: Value -> Parser SendMessageRequest
parseJSON = Value -> Parser SendMessageRequest
forall a (d :: Meta) (f :: * -> *).
(Generic a, GFromJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
Value -> Parser a
gparseJSON
data ForwardMessageRequest = ForwardMessageRequest
{ ForwardMessageRequest -> SomeChatId
forwardMessageChatId :: SomeChatId
, ForwardMessageRequest -> SomeChatId
forwardMessageFromChatId :: SomeChatId
, ForwardMessageRequest -> Maybe Bool
forwardMessageDisableNotification :: Maybe Bool
, ForwardMessageRequest -> MessageId
forwardMessageMessageId :: MessageId
} deriving ((forall x. ForwardMessageRequest -> Rep ForwardMessageRequest x)
-> (forall x. Rep ForwardMessageRequest x -> ForwardMessageRequest)
-> Generic ForwardMessageRequest
forall x. Rep ForwardMessageRequest x -> ForwardMessageRequest
forall x. ForwardMessageRequest -> Rep ForwardMessageRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ForwardMessageRequest x -> ForwardMessageRequest
$cfrom :: forall x. ForwardMessageRequest -> Rep ForwardMessageRequest x
Generic)
instance ToJSON ForwardMessageRequest where toJSON :: ForwardMessageRequest -> Value
toJSON = ForwardMessageRequest -> Value
forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON
instance FromJSON ForwardMessageRequest where parseJSON :: Value -> Parser ForwardMessageRequest
parseJSON = Value -> Parser ForwardMessageRequest
forall a (d :: Meta) (f :: * -> *).
(Generic a, GFromJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
Value -> Parser a
gparseJSON
type SendDocumentContent
= "sendDocument"
:> MultipartForm Tmp SendDocumentRequest
:> Post '[JSON] (Response Message)
type SendDocumentLink
= "sendDocument"
:> ReqBody '[JSON] SendDocumentRequest
:> Post '[JSON] (Response Message)
sendDocument :: SendDocumentRequest -> ClientM (Response Message)
sendDocument :: SendDocumentRequest -> ClientM (Response Message)
sendDocument r :: SendDocumentRequest
r = do
case SendDocumentRequest -> DocumentFile
sendDocumentDocument SendDocumentRequest
r of
DocumentFile{} -> do
ByteString
boundary <- IO ByteString -> ClientM ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ByteString
genBoundary
Proxy SendDocumentContent
-> (ByteString, SendDocumentRequest) -> ClientM (Response Message)
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy SendDocumentContent
forall k (t :: k). Proxy t
Proxy @SendDocumentContent) (ByteString
boundary, SendDocumentRequest
r)
_ -> Proxy SendDocumentLink
-> SendDocumentRequest -> ClientM (Response Message)
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy SendDocumentLink
forall k (t :: k). Proxy t
Proxy @SendDocumentLink) SendDocumentRequest
r
data SendDocumentRequest = SendDocumentRequest
{ SendDocumentRequest -> SomeChatId
sendDocumentChatId :: SomeChatId
, SendDocumentRequest -> DocumentFile
sendDocumentDocument :: DocumentFile
, SendDocumentRequest -> Maybe FilePath
sendDocumentThumb :: Maybe FilePath
, SendDocumentRequest -> Maybe Text
sendDocumentCaption :: Maybe Text
, SendDocumentRequest -> Maybe ParseMode
sendDocumentParseMode :: Maybe ParseMode
, SendDocumentRequest -> Maybe Bool
sendDocumentDisableNotification :: Maybe Bool
, SendDocumentRequest -> Maybe MessageId
sendDocumentReplyToMessageId :: Maybe MessageId
, SendDocumentRequest -> Maybe SomeReplyMarkup
sendDocumentReplyMarkup :: Maybe SomeReplyMarkup
}
deriving (forall x. SendDocumentRequest -> Rep SendDocumentRequest x)
-> (forall x. Rep SendDocumentRequest x -> SendDocumentRequest)
-> Generic SendDocumentRequest
forall x. Rep SendDocumentRequest x -> SendDocumentRequest
forall x. SendDocumentRequest -> Rep SendDocumentRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SendDocumentRequest x -> SendDocumentRequest
$cfrom :: forall x. SendDocumentRequest -> Rep SendDocumentRequest x
Generic
data DocumentFile
= DocumentFileId Int
| DocumentUrl Text
| DocumentFile FilePath ContentType
instance ToJSON DocumentFile where
toJSON :: DocumentFile -> Value
toJSON (DocumentFileId i :: Int
i) = FilePath -> Value
forall a. ToJSON a => a -> Value
toJSON (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
i)
toJSON (DocumentUrl t :: Text
t) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
t
toJSON (DocumentFile f :: FilePath
f _) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON ("attach://" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (FilePath -> FilePath
takeFileName FilePath
f))
type ContentType = Text
instance ToMultipart Tmp SendDocumentRequest where
toMultipart :: SendDocumentRequest -> MultipartData Tmp
toMultipart SendDocumentRequest{..} = [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 "document" (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
$ "attach://file"
, Text -> Text -> Input
Input "chat_id" (Text -> Input) -> Text -> Input
forall a b. (a -> b) -> a -> b
$ case SomeChatId
sendDocumentChatId of
SomeChatId (ChatId chat_id :: 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 txt :: Text
txt -> Text
txt
] [Input] -> [Input] -> [Input]
forall a. Semigroup a => a -> a -> a
<>
( (([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 (\_ -> ((Text -> Text -> Input
Input "thumb" "attach://thumb")Input -> [Input] -> [Input]
forall a. a -> [a] -> [a]
:)) Maybe FilePath
sendDocumentThumb)
([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 (\t :: Text
t -> ((Text -> Text -> Input
Input "caption" Text
t)Input -> [Input] -> [Input]
forall a. a -> [a] -> [a]
:)) Maybe Text
sendDocumentCaption)
([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 (\t :: ParseMode
t -> ((Text -> Text -> Input
Input "parse_mode" (Text -> Text
TL.toStrict (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
sendDocumentParseMode)
([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 (\t :: Bool
t -> ((Text -> Text -> Input
Input "disable_notifications" (Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool "false" "true" Bool
t))Input -> [Input] -> [Input]
forall a. a -> [a] -> [a]
:)) Maybe Bool
sendDocumentDisableNotification)
([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 (\t :: MessageId
t -> ((Text -> Text -> Input
Input "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
sendDocumentReplyToMessageId)
([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 (\t :: SomeReplyMarkup
t -> ((Text -> Text -> Input
Input "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
sendDocumentReplyMarkup)
[])
files :: [FileData Tmp]
files
= (Text -> Text -> Text -> MultipartResult Tmp -> FileData Tmp
forall tag.
Text -> Text -> Text -> MultipartResult tag -> FileData tag
FileData "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 [] (\t :: FilePath
t -> [Text -> Text -> Text -> MultipartResult Tmp -> FileData Tmp
forall tag.
Text -> Text -> Text -> MultipartResult tag -> FileData tag
FileData "thumb" (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeFileName FilePath
t) "image/jpeg" FilePath
MultipartResult Tmp
t]) Maybe FilePath
sendDocumentThumb
DocumentFile path :: FilePath
path ct :: Text
ct = DocumentFile
sendDocumentDocument
instance ToJSON SendDocumentRequest where toJSON :: SendDocumentRequest -> Value
toJSON = SendDocumentRequest -> Value
forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON
toSendDocument :: SomeChatId -> DocumentFile -> SendDocumentRequest
toSendDocument :: SomeChatId -> DocumentFile -> SendDocumentRequest
toSendDocument ch :: SomeChatId
ch df :: DocumentFile
df = SendDocumentRequest :: SomeChatId
-> DocumentFile
-> Maybe FilePath
-> Maybe Text
-> Maybe ParseMode
-> Maybe Bool
-> Maybe MessageId
-> Maybe SomeReplyMarkup
-> SendDocumentRequest
SendDocumentRequest
{ sendDocumentChatId :: SomeChatId
sendDocumentChatId = SomeChatId
ch
, sendDocumentDocument :: DocumentFile
sendDocumentDocument = DocumentFile
df
, sendDocumentThumb :: Maybe FilePath
sendDocumentThumb = Maybe FilePath
forall a. Maybe a
Nothing
, sendDocumentCaption :: Maybe Text
sendDocumentCaption = Maybe Text
forall a. Maybe a
Nothing
, sendDocumentParseMode :: Maybe ParseMode
sendDocumentParseMode = Maybe ParseMode
forall a. Maybe a
Nothing
, sendDocumentDisableNotification :: Maybe Bool
sendDocumentDisableNotification = Maybe Bool
forall a. Maybe a
Nothing
, sendDocumentReplyToMessageId :: Maybe MessageId
sendDocumentReplyToMessageId = Maybe MessageId
forall a. Maybe a
Nothing
, sendDocumentReplyMarkup :: Maybe SomeReplyMarkup
sendDocumentReplyMarkup = Maybe SomeReplyMarkup
forall a. Maybe a
Nothing
}