{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Telegram.Bot.API.Methods.CopyMessage where

import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Proxy
import Data.Text
import GHC.Generics (Generic)
import Servant.API
import Servant.Client hiding (Response)

import Telegram.Bot.API.Internal.Utils
import Telegram.Bot.API.MakingRequests
import Telegram.Bot.API.Types
import Telegram.Bot.API.Types.ParseMode

-- ** 'copyMessage'

type CopyMessage
  = "copyMessage"
  :> ReqBody '[JSON] CopyMessageRequest
  :> Post '[JSON] (Response CopyMessageId)

-- | Use this method to copy messages of any kind.
--   Service messages and invoice messages can't be
--   copied. The method is analogous to the method
--   forwardMessage, but the copied message doesn't
--   have a link to the original message.
--   Returns the MessageId of the sent message on success.
copyMessage :: CopyMessageRequest ->  ClientM (Response CopyMessageId)
copyMessage :: CopyMessageRequest -> ClientM (Response CopyMessageId)
copyMessage = forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall {k} (t :: k). Proxy t
Proxy @CopyMessage)

-- | Request parameters for 'copyMessage'.
data CopyMessageRequest = CopyMessageRequest
  { CopyMessageRequest -> SomeChatId
copyMessageChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @channelusername).
  , CopyMessageRequest -> Maybe Message
copyMessageMessageThreadId :: Maybe Message -- ^ Unique identifier for the target message thread (topic) of the forum; for forum supergroups only.
  , CopyMessageRequest -> SomeChatId
copyMessageFromChatId :: SomeChatId -- ^ Unique identifier for the chat where the original message was sent (or channel username in the format @channelusername)
  , CopyMessageRequest -> MessageId
copyMessageMessageId :: MessageId -- ^ Message identifier in the chat specified in from_chat_id
  , CopyMessageRequest -> Maybe Text
copyMessageCaption :: Maybe Text -- ^ New caption for media, 0-1024 characters after entities parsing. If not specified, the original caption is kept
  , CopyMessageRequest -> Maybe ParseMode
copyMessageParseMode :: 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.
  , CopyMessageRequest -> Maybe [MessageEntity]
copyMessageCaptionEntities :: Maybe [MessageEntity] -- ^ A JSON-serialized list of special entities that appear in the caption, which can be specified instead of parse_mode
  , CopyMessageRequest -> Maybe Bool
copyMessageDisableNotification :: Maybe Bool -- ^ Sends the message silently. Users will receive a notification with no sound.
  , CopyMessageRequest -> Maybe Bool
copyMessageProtectContent :: Maybe Bool -- ^ Protects the contents of the sent message from forwarding and saving
  , CopyMessageRequest -> Maybe MessageId
copyMessageReplyToMessageId :: Maybe MessageId -- ^ If the message is a reply, ID of the original message
  , CopyMessageRequest -> Maybe Bool
copyMessageAllowSendingWithoutReply :: Maybe Bool -- ^ Pass True, if the message should be sent even if the specified replied-to message is not found
  , CopyMessageRequest -> Maybe InlineKeyboardMarkup
copyMessageReplyMarkup :: 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 CopyMessageRequest x -> CopyMessageRequest
forall x. CopyMessageRequest -> Rep CopyMessageRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CopyMessageRequest x -> CopyMessageRequest
$cfrom :: forall x. CopyMessageRequest -> Rep CopyMessageRequest x
Generic

instance ToJSON   CopyMessageRequest where toJSON :: CopyMessageRequest -> Value
toJSON = forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON
instance FromJSON CopyMessageRequest where parseJSON :: Value -> Parser CopyMessageRequest
parseJSON = forall a (d :: Meta) (f :: * -> *).
(Generic a, GFromJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
Value -> Parser a
gparseJSON