{-# 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.SendVoice where

import Control.Monad.IO.Class (liftIO)
import Data.Aeson (ToJSON (..))
import Data.Aeson.Text (encodeToLazyText)
import Data.Bool
import Data.Maybe (catMaybes)
import Data.Functor ((<&>))
import Data.Proxy
import Data.Text
import GHC.Generics (Generic)
import Servant.API
import Servant.Multipart.API
import Servant.Multipart.Client
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.Internal.TH

-- ** 'sendVoice'

-- | Request parameters for 'sendVoice'.
data SendVoiceRequest = SendVoiceRequest
  { SendVoiceRequest -> SomeChatId
sendVoiceChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @channelusername).
  , SendVoiceRequest -> Maybe MessageThreadId
sendVoiceMessageThreadId :: Maybe MessageThreadId -- ^ Unique identifier for the target message thread (topic) of the forum; for forum supergroups only.
  , SendVoiceRequest -> InputFile
sendVoiceVoice :: InputFile -- ^ Audio file to send. 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. More info on Sending Files »
  , SendVoiceRequest -> Maybe Text
sendVoiceCaption :: Maybe Text -- ^ Voice message caption, 0-1024 characters after entities parsing
  , SendVoiceRequest -> Maybe ParseMode
sendVoiceParseMode :: Maybe ParseMode  -- ^ Send 'MarkdownV2', 'HTML' or 'Markdown' (legacy), if you want Telegram apps to show bold, italic, fixed-width text or inline URLs in your bot's message.
  , SendVoiceRequest -> Maybe [MessageEntity]
sendVoiceCaptionEntities :: Maybe [MessageEntity] -- ^ A JSON-serialized list of special entities that appear in the caption, which can be specified instead of parse_mode
  , SendVoiceRequest -> Maybe Int
sendVoiceDuration :: Maybe Int -- ^ Duration of the voice message in seconds
  , SendVoiceRequest -> Maybe Bool
sendVoiceDisableNotification :: Maybe Bool -- ^ Sends the message silently. Users will receive a notification with no sound.
  , SendVoiceRequest -> Maybe Bool
sendVoiceProtectContent :: Maybe Bool -- ^ Protects the contents of the sent message from forwarding and saving
  , SendVoiceRequest -> Maybe MessageId
sendVoiceReplyToMessageId :: Maybe MessageId -- ^ If the message is a reply, ID of the original message
  , SendVoiceRequest -> Maybe ReplyParameters
sendVoiceReplyParameters :: Maybe ReplyParameters -- ^ Description of the message to reply to.
  , SendVoiceRequest -> Maybe InlineKeyboardMarkup
sendVoiceReplyMarkup :: Maybe InlineKeyboardMarkup -- ^ 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. SendVoiceRequest -> Rep SendVoiceRequest x)
-> (forall x. Rep SendVoiceRequest x -> SendVoiceRequest)
-> Generic SendVoiceRequest
forall x. Rep SendVoiceRequest x -> SendVoiceRequest
forall x. SendVoiceRequest -> Rep SendVoiceRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SendVoiceRequest -> Rep SendVoiceRequest x
from :: forall x. SendVoiceRequest -> Rep SendVoiceRequest x
$cto :: forall x. Rep SendVoiceRequest x -> SendVoiceRequest
to :: forall x. Rep SendVoiceRequest x -> SendVoiceRequest
Generic

instance ToJSON SendVoiceRequest where toJSON :: SendVoiceRequest -> Value
toJSON = SendVoiceRequest -> Value
forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON

instance ToMultipart Tmp SendVoiceRequest where
  toMultipart :: SendVoiceRequest -> MultipartData Tmp
toMultipart SendVoiceRequest{Maybe Bool
Maybe Int
Maybe [MessageEntity]
Maybe Text
Maybe MessageThreadId
Maybe MessageId
Maybe ParseMode
Maybe InlineKeyboardMarkup
Maybe ReplyParameters
SomeChatId
InputFile
sendVoiceChatId :: SendVoiceRequest -> SomeChatId
sendVoiceMessageThreadId :: SendVoiceRequest -> Maybe MessageThreadId
sendVoiceVoice :: SendVoiceRequest -> InputFile
sendVoiceCaption :: SendVoiceRequest -> Maybe Text
sendVoiceParseMode :: SendVoiceRequest -> Maybe ParseMode
sendVoiceCaptionEntities :: SendVoiceRequest -> Maybe [MessageEntity]
sendVoiceDuration :: SendVoiceRequest -> Maybe Int
sendVoiceDisableNotification :: SendVoiceRequest -> Maybe Bool
sendVoiceProtectContent :: SendVoiceRequest -> Maybe Bool
sendVoiceReplyToMessageId :: SendVoiceRequest -> Maybe MessageId
sendVoiceReplyParameters :: SendVoiceRequest -> Maybe ReplyParameters
sendVoiceReplyMarkup :: SendVoiceRequest -> Maybe InlineKeyboardMarkup
sendVoiceChatId :: SomeChatId
sendVoiceMessageThreadId :: Maybe MessageThreadId
sendVoiceVoice :: InputFile
sendVoiceCaption :: Maybe Text
sendVoiceParseMode :: Maybe ParseMode
sendVoiceCaptionEntities :: Maybe [MessageEntity]
sendVoiceDuration :: Maybe Int
sendVoiceDisableNotification :: Maybe Bool
sendVoiceProtectContent :: Maybe Bool
sendVoiceReplyToMessageId :: Maybe MessageId
sendVoiceReplyParameters :: Maybe ReplyParameters
sendVoiceReplyMarkup :: Maybe InlineKeyboardMarkup
..} =
    Text -> InputFile -> MultipartData Tmp -> MultipartData Tmp
makeFile Text
"voice" InputFile
sendVoiceVoice (MultipartData Tmp -> MultipartData Tmp)
-> MultipartData Tmp -> MultipartData Tmp
forall a b. (a -> b) -> a -> b
$
    [Input] -> [FileData Tmp] -> MultipartData Tmp
forall tag. [Input] -> [FileData tag] -> MultipartData tag
MultipartData [Input]
fields [] where
    fields :: [Input]
fields =
      [ Text -> Text -> Input
Input Text
"chat_id" (Text -> Input) -> Text -> Input
forall a b. (a -> b) -> a -> b
$ case SomeChatId
sendVoiceChatId of
          SomeChatId (ChatId Integer
chat_id) -> String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
chat_id
          SomeChatUsername Text
txt -> Text
txt
      ] [Input] -> [Input] -> [Input]
forall a. Semigroup a => a -> a -> a
<> [Maybe Input] -> [Input]
forall a. [Maybe a] -> [a]
catMaybes
      [ Maybe MessageThreadId
sendVoiceMessageThreadId Maybe MessageThreadId -> (MessageThreadId -> Input) -> Maybe Input
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 (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ MessageThreadId -> String
forall a. Show a => a -> String
show MessageThreadId
t)
      , Maybe Text
sendVoiceCaption Maybe Text -> (Text -> Input) -> Maybe Input
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
        \Text
t -> Text -> Text -> Input
Input Text
"caption" Text
t
      , Maybe ParseMode
sendVoiceParseMode Maybe ParseMode -> (ParseMode -> Input) -> Maybe Input
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
        \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)
      , Maybe [MessageEntity]
sendVoiceCaptionEntities Maybe [MessageEntity] -> ([MessageEntity] -> Input) -> Maybe Input
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
        \[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)
      , Maybe Int
sendVoiceDuration Maybe Int -> (Int -> Input) -> Maybe Input
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
        \Int
t -> Text -> Text -> Input
Input Text
"duration" (Text -> Text
TL.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. ToJSON a => a -> Text
encodeToLazyText Int
t)
      , Maybe Bool
sendVoiceProtectContent Maybe Bool -> (Bool -> Input) -> Maybe Input
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
        \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)
      , Maybe Bool
sendVoiceDisableNotification Maybe Bool -> (Bool -> Input) -> Maybe Input
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
        \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)
      , Maybe MessageId
sendVoiceReplyToMessageId Maybe MessageId -> (MessageId -> Input) -> Maybe Input
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 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ MessageId -> Text
forall a. ToJSON a => a -> Text
encodeToLazyText MessageId
t)
      , Maybe ReplyParameters
sendVoiceReplyParameters Maybe ReplyParameters -> (ReplyParameters -> Input) -> Maybe Input
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
        \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)
      , Maybe InlineKeyboardMarkup
sendVoiceReplyMarkup Maybe InlineKeyboardMarkup
-> (InlineKeyboardMarkup -> Input) -> Maybe Input
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 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ InlineKeyboardMarkup -> Text
forall a. ToJSON a => a -> Text
encodeToLazyText InlineKeyboardMarkup
t)
      ]

type SendVoiceContent
  = "sendVoice"
  :> MultipartForm Tmp SendVoiceRequest
  :> Post '[JSON] (Response Message)

type SendVoiceLink
  = "sendVoice"
  :> ReqBody '[JSON] SendVoiceRequest
  :> Post '[JSON] (Response Message)

-- | Use this method to send audio files,
--   if you want Telegram clients to display
--   the file as a playable voice message. For
--   this to work, your audio must be in an .OGG
--   file encoded with OPUS (other formats may be
--   sent as Audio or Document).
--   On success, the sent Message is returned.
--   Bots can currently send voice messages of up
--   to 50 MB in size, this limit may be changed in the future.
sendVoice :: SendVoiceRequest ->  ClientM (Response Message)
sendVoice :: SendVoiceRequest -> ClientM (Response Message)
sendVoice SendVoiceRequest
r = case SendVoiceRequest -> InputFile
sendVoiceVoice SendVoiceRequest
r of
  InputFile{} -> 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 SendVoiceContent -> Client ClientM SendVoiceContent
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SendVoiceContent) (ByteString
boundary, SendVoiceRequest
r)
  InputFile
_ ->  Proxy SendVoiceLink -> Client ClientM SendVoiceLink
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SendVoiceLink) SendVoiceRequest
r

makeDefault ''SendVoiceRequest