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

-- ** 'sendVideo'

-- | Request parameters for 'sendVideo'.
data SendVideoRequest = SendVideoRequest
  { SendVideoRequest -> SomeChatId
sendVideoChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @channelusername)
  , SendVideoRequest -> Maybe MessageThreadId
sendVideoMessageThreadId :: Maybe MessageThreadId -- ^ Unique identifier for the target message thread (topic) of the forum; for forum supergroups only.
  , SendVideoRequest -> InputFile
sendVideoVideo :: InputFile -- ^ Video to send. Pass a file_id as String to send an video that exists on the Telegram servers (recommended), pass an HTTP URL as a String for Telegram to get a video from the Internet, or upload a new video using multipart/form-data. More info on Sending Files »
  , SendVideoRequest -> Maybe Int
sendVideoDuration :: Maybe Int -- ^ Duration of sent video in seconds
  , SendVideoRequest -> Maybe Int
sendVideoWidth :: Maybe Int -- ^ Video width
  , SendVideoRequest -> Maybe Int
sendVideoHeight :: Maybe Int -- ^ Video height
  , SendVideoRequest -> Maybe InputFile
sendVideoThumb :: 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 »
  , SendVideoRequest -> Maybe Text
sendVideoCaption :: Maybe Text -- ^ Video caption (may also be used when resending videos by file_id), 0-1024 characters after entities parsing
  , SendVideoRequest -> Maybe ParseMode
sendVideoParseMode :: 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.
  , SendVideoRequest -> Maybe [MessageEntity]
sendVideoCaptionEntities :: Maybe [MessageEntity] -- ^ A JSON-serialized list of special entities that appear in the caption, which can be specified instead of parse_mode
  , SendVideoRequest -> Maybe Bool
sendVideoHasSpoiler :: Maybe Bool -- ^ Pass 'True' if the video needs to be covered with a spoiler animation.
  , SendVideoRequest -> Maybe Bool
sendVideoSupportsStreaming :: Maybe Bool -- ^ Pass True, if the uploaded video is suitable for streaming
  , SendVideoRequest -> Maybe Bool
sendVideoDisableNotification :: Maybe Bool -- ^ Sends the message silently. Users will receive a notification with no sound.
  , SendVideoRequest -> Maybe Bool
sendVideoProtectContent :: Maybe Bool -- ^ Protects the contents of the sent message from forwarding and saving.
  , SendVideoRequest -> Maybe MessageId
sendVideoReplyToMessageId :: Maybe MessageId -- ^ If the message is a reply, ID of the original message
  , SendVideoRequest -> Maybe Bool
sendVideoAllowSendingWithoutReply :: Maybe Bool -- ^ Pass True, if the message should be sent even if the specified replied-to message is not found
  , SendVideoRequest -> Maybe InlineKeyboardMarkup
sendVideoReplyMarkup :: 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. Rep SendVideoRequest x -> SendVideoRequest
forall x. SendVideoRequest -> Rep SendVideoRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SendVideoRequest x -> SendVideoRequest
$cfrom :: forall x. SendVideoRequest -> Rep SendVideoRequest x
Generic

instance ToJSON SendVideoRequest where toJSON :: SendVideoRequest -> 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 SendVideoRequest where
  toMultipart :: SendVideoRequest -> MultipartData Tmp
toMultipart SendVideoRequest{Maybe Bool
Maybe Int
Maybe [MessageEntity]
Maybe Text
Maybe MessageThreadId
Maybe MessageId
Maybe InlineKeyboardMarkup
Maybe ParseMode
Maybe InputFile
SomeChatId
InputFile
sendVideoReplyMarkup :: Maybe InlineKeyboardMarkup
sendVideoAllowSendingWithoutReply :: Maybe Bool
sendVideoReplyToMessageId :: Maybe MessageId
sendVideoProtectContent :: Maybe Bool
sendVideoDisableNotification :: Maybe Bool
sendVideoSupportsStreaming :: Maybe Bool
sendVideoHasSpoiler :: Maybe Bool
sendVideoCaptionEntities :: Maybe [MessageEntity]
sendVideoParseMode :: Maybe ParseMode
sendVideoCaption :: Maybe Text
sendVideoThumb :: Maybe InputFile
sendVideoHeight :: Maybe Int
sendVideoWidth :: Maybe Int
sendVideoDuration :: Maybe Int
sendVideoVideo :: InputFile
sendVideoMessageThreadId :: Maybe MessageThreadId
sendVideoChatId :: SomeChatId
sendVideoReplyMarkup :: SendVideoRequest -> Maybe InlineKeyboardMarkup
sendVideoAllowSendingWithoutReply :: SendVideoRequest -> Maybe Bool
sendVideoReplyToMessageId :: SendVideoRequest -> Maybe MessageId
sendVideoProtectContent :: SendVideoRequest -> Maybe Bool
sendVideoDisableNotification :: SendVideoRequest -> Maybe Bool
sendVideoSupportsStreaming :: SendVideoRequest -> Maybe Bool
sendVideoHasSpoiler :: SendVideoRequest -> Maybe Bool
sendVideoCaptionEntities :: SendVideoRequest -> Maybe [MessageEntity]
sendVideoParseMode :: SendVideoRequest -> Maybe ParseMode
sendVideoCaption :: SendVideoRequest -> Maybe Text
sendVideoThumb :: SendVideoRequest -> Maybe InputFile
sendVideoHeight :: SendVideoRequest -> Maybe Int
sendVideoWidth :: SendVideoRequest -> Maybe Int
sendVideoDuration :: SendVideoRequest -> Maybe Int
sendVideoVideo :: SendVideoRequest -> InputFile
sendVideoMessageThreadId :: SendVideoRequest -> Maybe MessageThreadId
sendVideoChatId :: SendVideoRequest -> SomeChatId
..} =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (Text -> InputFile -> MultipartData Tmp -> MultipartData Tmp
makeFile Text
"thumb") Maybe InputFile
sendVideoThumb forall a b. (a -> b) -> a -> b
$
    Text -> InputFile -> MultipartData Tmp -> MultipartData Tmp
makeFile Text
"video" InputFile
sendVideoVideo forall a b. (a -> b) -> a -> b
$
    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
sendVideoChatId 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
sendVideoMessageThreadId 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 Text
sendVideoCaption forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
        \Text
t -> Text -> Text -> Input
Input Text
"caption" Text
t
      , Maybe ParseMode
sendVideoParseMode 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
TL.replace Text
"\"" Text
"" forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Text
encodeToLazyText ParseMode
t)
      , Maybe [MessageEntity]
sendVideoCaptionEntities 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 forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Text
encodeToLazyText [MessageEntity]
t)
      , Maybe Bool
sendVideoHasSpoiler forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
        \Bool
t -> Text -> Text -> Input
Input Text
"has_spoiler" (forall a. a -> a -> Bool -> a
bool Text
"false" Text
"true" Bool
t)
      , Maybe Int
sendVideoDuration forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
        \Int
t -> Text -> Text -> Input
Input Text
"duration" (Text -> Text
TL.toStrict forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Text
encodeToLazyText Int
t)
      , Maybe Int
sendVideoWidth forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
        \Int
t -> Text -> Text -> Input
Input Text
"width" (Text -> Text
TL.toStrict forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Text
encodeToLazyText Int
t)
      , Maybe Int
sendVideoHeight forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
        \Int
t -> Text -> Text -> Input
Input Text
"height" (Text -> Text
TL.toStrict forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Text
encodeToLazyText Int
t)
      , Maybe Bool
sendVideoDisableNotification 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
sendVideoSupportsStreaming forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
        \Bool
t -> Text -> Text -> Input
Input Text
"supports_streaming" (forall a. a -> a -> Bool -> a
bool Text
"false" Text
"true" Bool
t)
      , Maybe Bool
sendVideoProtectContent 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
sendVideoReplyToMessageId 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
sendVideoAllowSendingWithoutReply 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
sendVideoReplyMarkup 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 SendVideoContent
  = "sendVideo"
  :> MultipartForm Tmp SendVideoRequest
  :> Post '[JSON] (Response Message)

type SendVideoLink
  = "sendVideo"
  :> ReqBody '[JSON] SendVideoRequest
  :> Post '[JSON] (Response Message)

-- | Use this method to send video files,
--   Telegram clients support mp4 videos
--   (other formats may be sent as Document).
--   On success, the sent Message is returned.
--   Bots can currently send video files of up
--   to 50 MB in size, this limit may be changed in the future.
sendVideo :: SendVideoRequest ->  ClientM (Response Message)
sendVideo :: SendVideoRequest -> ClientM (Response Message)
sendVideo SendVideoRequest
r = case (SendVideoRequest -> InputFile
sendVideoVideo SendVideoRequest
r, SendVideoRequest -> Maybe InputFile
sendVideoThumb SendVideoRequest
r) of
  (InputFile{}, Maybe 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 @SendVideoContent) (ByteString
boundary, SendVideoRequest
r)
  (InputFile
_, Just 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 @SendVideoContent) (ByteString
boundary, SendVideoRequest
r)
  (InputFile, Maybe InputFile)
_ ->  forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall {k} (t :: k). Proxy t
Proxy @SendVideoLink) SendVideoRequest
r