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

-- * Available methods

-- ** 'getMe'

type GetMe = "getMe" :> Get '[JSON] (Response User)

-- | A simple method for testing your bot's auth token.
-- Requires no parameters.
-- Returns basic information about the bot in form of a 'User' object.
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)

-- ** 'deleteMessage'

-- | Notice that deleting by POST method was bugged, so we use GET
type DeleteMessage = "deleteMessage"
  :> RequiredQueryParam "chat_id" ChatId
  :> RequiredQueryParam "message_id" MessageId
  :> Get '[JSON] (Response Bool)

-- | Use this method to delete message in chat.
-- On success, the sent Bool is returned.
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)

-- ** 'sendMessage'

type SendMessage
  = "sendMessage" :> ReqBody '[JSON] SendMessageRequest :> Post '[JSON] (Response Message)

-- | Use this method to send text messages.
-- On success, the sent 'Message' is returned.
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)

-- | Unique identifier for the target chat
-- or username of the target channel (in the format @\@channelusername@).
data SomeChatId
  = SomeChatId ChatId       -- ^ Unique chat ID.
  | SomeChatUsername Text   -- ^ Username of the target channel.
  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

-- | Additional interface options.
-- A JSON-serialized object for an inline keyboard, custom reply keyboard,
-- instructions to remove reply keyboard or to force a reply from the user.
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
  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

-- | Request parameters for 'sendMessage'.
data SendMessageRequest = SendMessageRequest
  { SendMessageRequest -> SomeChatId
sendMessageChatId                :: SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @\@channelusername@).
  , SendMessageRequest -> Text
sendMessageText                  :: Text -- ^ Text of the message to be sent.
  , SendMessageRequest -> Maybe ParseMode
sendMessageParseMode             :: Maybe ParseMode -- ^ Send 'Markdown' or 'HTML', if you want Telegram apps to show bold, italic, fixed-width text or inline URLs in your bot's message.
  , SendMessageRequest -> Maybe Bool
sendMessageDisableWebPagePreview :: Maybe Bool -- ^ Disables link previews for links in this message.
  , SendMessageRequest -> Maybe Bool
sendMessageDisableNotification   :: Maybe Bool -- ^ Sends the message silently. Users will receive a notification with no sound.
  , SendMessageRequest -> Maybe MessageId
sendMessageReplyToMessageId      :: Maybe MessageId -- ^ If the message is a reply, ID of the original message.
  , SendMessageRequest -> Maybe SomeReplyMarkup
sendMessageReplyMarkup           :: Maybe SomeReplyMarkup -- ^ Additional interface options. A JSON-serialized object for an inline keyboard, custom reply keyboard, instructions to remove reply keyboard or to force a reply from the user.
  } 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

-- ** 'sendMessage'

type SendDocumentContent
  = "sendDocument"
  :> MultipartForm Tmp SendDocumentRequest
  :> Post '[JSON] (Response Message)

type SendDocumentLink
  = "sendDocument"
  :> ReqBody '[JSON] SendDocumentRequest
  :> Post '[JSON] (Response Message)

-- | Use this method to send text messages.
-- On success, the sent 'Message' is returned.
--
-- <https:\/\/core.telegram.org\/bots\/api#senddocument>
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

-- | Request parameters for 'sendDocument'
data SendDocumentRequest = SendDocumentRequest
  { SendDocumentRequest -> SomeChatId
sendDocumentChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @\@channelusername@).
  , SendDocumentRequest -> DocumentFile
sendDocumentDocument :: DocumentFile -- ^ Pass a file_id as String to send a file that exists on the Telegram servers (recommended), pass an HTTP URL as a String for Telegram to get a file from the Internet, or upload a new one using multipart/form-data
  , SendDocumentRequest -> Maybe FilePath
sendDocumentThumb :: Maybe FilePath -- ^ Thumbnail of the file sent; can be ignored if thumbnail generation for the file is supported server-side. The thumbnail should be in JPEG format and less than 200 kB in size. A thumbnail's width and height should not exceed 320. Ignored if the file is not uploaded using multipart/form-data. Thumbnails can't be reused and can be only uploaded as a new file, so you can pass “attach://<file_attach_name>” if the thumbnail was uploaded using multipart/form-data under <file_attach_name>
  , SendDocumentRequest -> Maybe Text
sendDocumentCaption :: Maybe Text -- ^ Document caption (may also be used when resending documents by file_id), 0-1024 characters after entities parsing
  , SendDocumentRequest -> Maybe ParseMode
sendDocumentParseMode :: Maybe ParseMode -- ^ Mode for parsing entities in the document caption.
  , SendDocumentRequest -> Maybe Bool
sendDocumentDisableNotification :: Maybe Bool -- ^ Sends the message silently. Users will receive a notification with no sound.
  , SendDocumentRequest -> Maybe MessageId
sendDocumentReplyToMessageId :: Maybe MessageId
  , SendDocumentRequest -> Maybe SomeReplyMarkup
sendDocumentReplyMarkup :: Maybe SomeReplyMarkup -- ^ Additional interface options. A JSON-serialized object for an inline keyboard, custom reply keyboard, instructions to remove reply keyboard or to force a reply from the user.
  }
  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

-- | Generate send document structure.
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
  }