SendVideo.hs

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

-- ** 'sendVideo'

-- | Request parameters for 'sendVideo'.
data SendVideoRequest = SendVideoRequest
  { sendVideoBusinessConnectionId :: Maybe BusinessConnectionId -- ^ Unique identifier of the business connection on behalf of which the message will be sent.
  , sendVideoChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @channelusername)
  , sendVideoMessageThreadId :: Maybe MessageThreadId -- ^ Unique identifier for the target message thread (topic) of the forum; for forum supergroups only.
  , 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 »
  , sendVideoDuration :: Maybe Int -- ^ Duration of sent video in seconds
  , sendVideoWidth :: Maybe Int -- ^ Video width
  , sendVideoHeight :: Maybe Int -- ^ Video height
  , sendVideoThumbnail :: 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 »
  , sendVideoCaption :: Maybe Text -- ^ Video caption (may also be used when resending videos by file_id), 0-1024 characters after entities parsing
  , 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.
  , sendVideoCaptionEntities :: Maybe [MessageEntity] -- ^ A JSON-serialized list of special entities that appear in the caption, which can be specified instead of @parse_mode@.
  , sendVideoShowCaptionAboveMedia :: Maybe Bool -- ^ Pass 'True', if the caption must be shown above the message media.
  , sendVideoHasSpoiler :: Maybe Bool -- ^ Pass 'True' if the video needs to be covered with a spoiler animation.
  , sendVideoSupportsStreaming :: Maybe Bool -- ^ Pass True, if the uploaded video is suitable for streaming
  , sendVideoDisableNotification :: Maybe Bool -- ^ Sends the message silently. Users will receive a notification with no sound.
  , sendVideoProtectContent :: Maybe Bool -- ^ Protects the contents of the sent message from forwarding and saving.
  , sendVideoMessageEffectId :: Maybe Text -- ^ Unique identifier of the message effect to be added to the message; for private chats only.
  , sendVideoReplyToMessageId :: Maybe MessageId -- ^ If the message is a reply, ID of the original message
  , sendVideoReplyParameters :: Maybe ReplyParameters -- ^ Description of the message to reply to.
  , 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 Generic

instance ToJSON SendVideoRequest where toJSON = gtoJSON

instance ToMultipart Tmp SendVideoRequest where
  toMultipart SendVideoRequest{..} =
    maybe id (makeFile "thumbnail") sendVideoThumbnail $
    makeFile "video" sendVideoVideo $
    MultipartData fields [] where
    fields =
      [ Input "chat_id" $ case sendVideoChatId of
          SomeChatId (ChatId chat_id) -> showText chat_id
          SomeChatUsername txt -> txt
      ] <> catMaybes
      [ sendVideoMessageThreadId <&>
        \t -> Input "message_thread_id" (showText t)
      , sendVideoCaption <&>
        \t -> Input "caption" t
      , sendVideoParseMode <&>
        \t -> Input "parse_mode" (TL.toStrict . TL.replace "\"" "" $ encodeToLazyText t)
      , sendVideoCaptionEntities <&>
        \t -> Input "caption_entities" (TL.toStrict $ encodeToLazyText t)
      , sendVideoHasSpoiler <&>
        \t -> Input "has_spoiler" (bool "false" "true" t)
      , sendVideoDuration <&>
        \t -> Input "duration" (TL.toStrict $ encodeToLazyText t)
      , sendVideoWidth <&>
        \t -> Input "width" (TL.toStrict $ encodeToLazyText t)
      , sendVideoHeight <&>
        \t -> Input "height" (TL.toStrict $ encodeToLazyText t)
      , sendVideoDisableNotification <&>
        \t -> Input "disable_notification" (bool "false" "true" t)
      , sendVideoSupportsStreaming <&>
        \t -> Input "supports_streaming" (bool "false" "true" t)
      , sendVideoProtectContent <&>
        \t -> Input "protect_content" (bool "false" "true" t)
      , sendVideoReplyToMessageId <&>
        \t -> Input "reply_to_message_id" (TL.toStrict $ encodeToLazyText t)
      , sendVideoReplyParameters <&>
        \t -> Input "reply_parameters" (TL.toStrict $ encodeToLazyText t)
      , sendVideoReplyMarkup <&>
        \t -> Input "reply_markup" (TL.toStrict $ encodeToLazyText 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 r = case (sendVideoVideo r, sendVideoThumbnail r) of
  (InputFile{}, _) -> do
    boundary <- liftIO genBoundary
    client (Proxy @SendVideoContent) (boundary, r)
  (_, Just InputFile{}) -> do
    boundary <- liftIO genBoundary
    client (Proxy @SendVideoContent) (boundary, r)
  _ ->  client (Proxy @SendVideoLink) r

makeDefault ''SendVideoRequest