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

import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Proxy
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.Internal.TH

-- ** 'promoteChatMember'

-- | Request parameters for 'promoteChatMember'.
data PromoteChatMemberRequest = PromoteChatMemberRequest
  { PromoteChatMemberRequest -> SomeChatId
promoteChatMemberChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @channelusername).
  , PromoteChatMemberRequest -> UserId
promoteChatMemberUserId :: UserId -- ^ Unique identifier of the target user.
  , PromoteChatMemberRequest -> Maybe Bool
promoteChatMemberIsAnonymous :: Maybe Bool -- ^ Pass 'True', if the administrator's presence in the chat is hidden.
  , PromoteChatMemberRequest -> Maybe Bool
promoteChatMemberCanManageChat :: Maybe Bool -- ^ Pass 'True', if the administrator can access the chat event log, chat statistics, message statistics in channels, see channel members, see anonymous administrators in supergroups and ignore slow mode. Implied by any other administrator privilege.
  , PromoteChatMemberRequest -> Maybe Bool
promoteChatMemberCanPostMessages :: Maybe Bool -- ^ Pass 'True', if the administrator can create channel posts, channels only.
  , PromoteChatMemberRequest -> Maybe Bool
promoteChatMemberCanEditMessages :: Maybe Bool -- ^ Pass 'True', if the administrator can edit messages of other users and can pin messages, channels only.
  , PromoteChatMemberRequest -> Maybe Bool
promoteChatMemberCanDeleteMessages :: Maybe Bool -- ^ Pass 'True', if the administrator can delete messages of other users.
  , PromoteChatMemberRequest -> Maybe Bool
promoteChatMemberCanManageVideoChats :: Maybe Bool -- ^ Pass 'True', if the administrator can manage video chats.
  , PromoteChatMemberRequest -> Maybe Bool
promoteChatMemberCanRestrictMembers :: Maybe Bool -- ^ Pass 'True', if the administrator can restrict, ban or unban chat members.
  , PromoteChatMemberRequest -> Maybe Bool
promoteChatMemberCanPromoteMembers :: Maybe Bool -- ^ Pass 'True', if the administrator can add new administrators with a subset of their own privileges or demote administrators that he has promoted, directly or indirectly (promoted by administrators that were appointed by him).
  , PromoteChatMemberRequest -> Maybe Bool
promoteChatMemberCanChangeInfo :: Maybe Bool -- ^ Pass 'True', if the administrator can change chat title, photo and other settings.
  , PromoteChatMemberRequest -> Maybe Bool
promoteChatMemberCanInviteUsers :: Maybe Bool -- ^ Pass 'True', if the administrator can invite new users to the chat.
  , PromoteChatMemberRequest -> Maybe Bool
promoteChatMemberCanPinMessages :: Maybe Bool -- ^ Pass 'True', if the administrator can pin messages, supergroups only.
  , PromoteChatMemberRequest -> Maybe Bool
promoteChatMemberCanManageTopics :: Maybe Bool -- ^ Pass 'True', if the user is allowed to create, rename, close, and reopen forum topics, supergroups only.
  }
  deriving forall x.
Rep PromoteChatMemberRequest x -> PromoteChatMemberRequest
forall x.
PromoteChatMemberRequest -> Rep PromoteChatMemberRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PromoteChatMemberRequest x -> PromoteChatMemberRequest
$cfrom :: forall x.
PromoteChatMemberRequest -> Rep PromoteChatMemberRequest x
Generic

instance ToJSON   PromoteChatMemberRequest where toJSON :: PromoteChatMemberRequest -> 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 PromoteChatMemberRequest where parseJSON :: Value -> Parser PromoteChatMemberRequest
parseJSON = forall a (d :: Meta) (f :: * -> *).
(Generic a, GFromJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
Value -> Parser a
gparseJSON

type PromoteChatMember = "promoteChatMember"
  :> ReqBody '[JSON] PromoteChatMemberRequest
  :> Post '[JSON] (Response Bool)

-- | Use this method to promote or demote
--   a user in a supergroup or a channel.
--   The bot must be an administrator in
--   the chat for this to work and must have
--   the appropriate administrator rights.
--   Pass False for all boolean parameters
--   to demote a user.
--   Returns True on success.
promoteChatMember ::PromoteChatMemberRequest ->  ClientM (Response Bool)
promoteChatMember :: PromoteChatMemberRequest -> ClientM (Response Bool)
promoteChatMember = forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall {k} (t :: k). Proxy t
Proxy @PromoteChatMember)

makeDefault ''PromoteChatMemberRequest