{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Telegram.Bot.API.Methods.SetChatPhoto where

import Control.Monad.IO.Class (liftIO)
import Data.Proxy
import Servant.API
import Servant.Multipart.API
import Servant.Multipart.Client
import Servant.Client hiding (Response)

import qualified Data.Text as T

import Telegram.Bot.API.MakingRequests
import Telegram.Bot.API.Types

-- ** 'setChatPhoto'

-- | Request parameters for 'setChatPhoto'.
data SetChatPhotoRequest = SetChatPhotoRequest
  { SetChatPhotoRequest -> SomeChatId
setChatPhotoChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @channelusername)
  , SetChatPhotoRequest -> InputFile
setChatPhotoPhoto :: InputFile -- ^ 	New chat photo, uploaded using multipart/form-data
  }

instance ToMultipart Tmp SetChatPhotoRequest where
  toMultipart :: SetChatPhotoRequest -> MultipartData Tmp
toMultipart SetChatPhotoRequest{SomeChatId
InputFile
setChatPhotoPhoto :: InputFile
setChatPhotoChatId :: SomeChatId
setChatPhotoPhoto :: SetChatPhotoRequest -> InputFile
setChatPhotoChatId :: SetChatPhotoRequest -> SomeChatId
..} =
    Text -> InputFile -> MultipartData Tmp -> MultipartData Tmp
makeFile Text
"photo" InputFile
setChatPhotoPhoto (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
setChatPhotoChatId 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
      ]

type SetChatPhoto = "setChatPhoto"
  :> MultipartForm Tmp SetChatPhotoRequest
  :> Post '[JSON] (Response Bool)

-- | Use this method to set a new profile 
--   photo for the chat. Photos can't be changed
--   for private chats. The bot must be an 
--   administrator in the chat for this to work 
--   and must have the appropriate administrator rights. 
--   Returns True on success.
--
-- *Note*: Only 'InputFile' case might be used in 'SetChatPhotoRequest'.
-- Rest cases will be rejected by Telegram.
setChatPhoto :: SetChatPhotoRequest ->  ClientM (Response Bool)
setChatPhoto :: SetChatPhotoRequest -> ClientM (Response Bool)
setChatPhoto SetChatPhotoRequest
r =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 @SetChatPhoto) (ByteString
boundary, SetChatPhotoRequest
r)