{-# 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.SendVideoNote 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 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.Internal.TH

-- ** 'sendVideoNote'

-- | Request parameters for 'sendVideoNote'.
data SendVideoNoteRequest = SendVideoNoteRequest
  { SendVideoNoteRequest -> SomeChatId
sendVideoNoteChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @channelusername).
  , SendVideoNoteRequest -> Maybe MessageThreadId
sendVideoNoteMessageThreadId :: Maybe MessageThreadId -- ^ Unique identifier for the target message thread (topic) of the forum; for forum supergroups only.
  , SendVideoNoteRequest -> InputFile
sendVideoNoteVideoNote :: InputFile -- ^ Video note to send. Pass a file_id as String to send a video note that exists on the Telegram servers (recommended) or upload a new video using multipart/form-data. More info on Sending Files ». Sending video notes by a URL is currently unsupported
  , SendVideoNoteRequest -> Maybe Int
sendVideoNoteDuration :: Maybe Int -- ^ Duration of sent video in seconds
  , SendVideoNoteRequest -> Maybe Int
sendVideoNoteLength :: Maybe Int -- ^ Video width and height, i.e. diameter of the video message
  , SendVideoNoteRequest -> Maybe InputFile
sendVideoNoteThumbnail :: Maybe InputFile -- ^ 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>. More info on Sending Files »
  , SendVideoNoteRequest -> Maybe Bool
sendVideoNoteDisableNotification :: Maybe Bool -- ^ Sends the message silently. Users will receive a notification with no sound.
  , SendVideoNoteRequest -> Maybe Bool
sendVideoNoteProtectContent :: Maybe Bool -- ^ Protects the contents of the sent message from forwarding and saving
  , SendVideoNoteRequest -> Maybe MessageId
sendVideoNoteReplyToMessageId :: Maybe MessageId -- ^ If the message is a reply, ID of the original message
  , SendVideoNoteRequest -> Maybe ReplyParameters
sendVideoNoteReplyParameters :: Maybe ReplyParameters -- ^ Description of the message to reply to.
  , SendVideoNoteRequest -> Maybe InlineKeyboardMarkup
sendVideoNoteReplyMarkup :: 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. SendVideoNoteRequest -> Rep SendVideoNoteRequest x)
-> (forall x. Rep SendVideoNoteRequest x -> SendVideoNoteRequest)
-> Generic SendVideoNoteRequest
forall x. Rep SendVideoNoteRequest x -> SendVideoNoteRequest
forall x. SendVideoNoteRequest -> Rep SendVideoNoteRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SendVideoNoteRequest -> Rep SendVideoNoteRequest x
from :: forall x. SendVideoNoteRequest -> Rep SendVideoNoteRequest x
$cto :: forall x. Rep SendVideoNoteRequest x -> SendVideoNoteRequest
to :: forall x. Rep SendVideoNoteRequest x -> SendVideoNoteRequest
Generic

instance ToJSON SendVideoNoteRequest where toJSON :: SendVideoNoteRequest -> Value
toJSON = SendVideoNoteRequest -> 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 SendVideoNoteRequest where
  toMultipart :: SendVideoNoteRequest -> MultipartData Tmp
toMultipart SendVideoNoteRequest{Maybe Bool
Maybe Int
Maybe MessageThreadId
Maybe MessageId
Maybe InlineKeyboardMarkup
Maybe ReplyParameters
Maybe InputFile
SomeChatId
InputFile
sendVideoNoteChatId :: SendVideoNoteRequest -> SomeChatId
sendVideoNoteMessageThreadId :: SendVideoNoteRequest -> Maybe MessageThreadId
sendVideoNoteVideoNote :: SendVideoNoteRequest -> InputFile
sendVideoNoteDuration :: SendVideoNoteRequest -> Maybe Int
sendVideoNoteLength :: SendVideoNoteRequest -> Maybe Int
sendVideoNoteThumbnail :: SendVideoNoteRequest -> Maybe InputFile
sendVideoNoteDisableNotification :: SendVideoNoteRequest -> Maybe Bool
sendVideoNoteProtectContent :: SendVideoNoteRequest -> Maybe Bool
sendVideoNoteReplyToMessageId :: SendVideoNoteRequest -> Maybe MessageId
sendVideoNoteReplyParameters :: SendVideoNoteRequest -> Maybe ReplyParameters
sendVideoNoteReplyMarkup :: SendVideoNoteRequest -> Maybe InlineKeyboardMarkup
sendVideoNoteChatId :: SomeChatId
sendVideoNoteMessageThreadId :: Maybe MessageThreadId
sendVideoNoteVideoNote :: InputFile
sendVideoNoteDuration :: Maybe Int
sendVideoNoteLength :: Maybe Int
sendVideoNoteThumbnail :: Maybe InputFile
sendVideoNoteDisableNotification :: Maybe Bool
sendVideoNoteProtectContent :: Maybe Bool
sendVideoNoteReplyToMessageId :: Maybe MessageId
sendVideoNoteReplyParameters :: Maybe ReplyParameters
sendVideoNoteReplyMarkup :: Maybe InlineKeyboardMarkup
..} =
    (MultipartData Tmp -> MultipartData Tmp)
-> (InputFile -> MultipartData Tmp -> MultipartData Tmp)
-> Maybe InputFile
-> MultipartData Tmp
-> MultipartData Tmp
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MultipartData Tmp -> MultipartData Tmp
forall a. a -> a
id (Text -> InputFile -> MultipartData Tmp -> MultipartData Tmp
makeFile Text
"thumbnail") Maybe InputFile
sendVideoNoteThumbnail (MultipartData Tmp -> MultipartData Tmp)
-> MultipartData Tmp -> MultipartData Tmp
forall a b. (a -> b) -> a -> b
$
    Text -> InputFile -> MultipartData Tmp -> MultipartData Tmp
makeFile Text
"video_note" InputFile
sendVideoNoteVideoNote (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
sendVideoNoteChatId 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
sendVideoNoteMessageThreadId 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 Bool
sendVideoNoteDisableNotification 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 Bool
sendVideoNoteProtectContent 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 MessageId
sendVideoNoteReplyToMessageId 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
sendVideoNoteReplyParameters 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
sendVideoNoteReplyMarkup 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 SendVideoNoteContent
  = "sendVideoNote"
  :> MultipartForm Tmp SendVideoNoteRequest
  :> Post '[JSON] (Response Message)

type SendVideoNoteLink
  = "sendVideoNote"
  :> ReqBody '[JSON] SendVideoNoteRequest
  :> Post '[JSON] (Response Message)

-- | As of v.4.0, Telegram clients support rounded
--   square mp4 videos of up to 1 minute long. Use
--   this method to send video messages.
--   On success, the sent Message is returned.
sendVideoNote :: SendVideoNoteRequest ->  ClientM (Response Message)
sendVideoNote :: SendVideoNoteRequest -> ClientM (Response Message)
sendVideoNote SendVideoNoteRequest
r = case (SendVideoNoteRequest -> InputFile
sendVideoNoteVideoNote SendVideoNoteRequest
r, SendVideoNoteRequest -> Maybe InputFile
sendVideoNoteThumbnail SendVideoNoteRequest
r) of
  (InputFile{}, Maybe 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 SendVideoNoteContent -> Client ClientM SendVideoNoteContent
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SendVideoNoteContent) (ByteString
boundary, SendVideoNoteRequest
r)
  (InputFile
_, Just 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 SendVideoNoteContent -> Client ClientM SendVideoNoteContent
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SendVideoNoteContent) (ByteString
boundary, SendVideoNoteRequest
r)
  (InputFile, Maybe InputFile)
_ ->  Proxy SendVideoNoteLink -> Client ClientM SendVideoNoteLink
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SendVideoNoteLink) SendVideoNoteRequest
r

makeDefault ''SendVideoNoteRequest