{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Telegram.Bot.API.Methods.UnbanChatMember 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

-- | Request parameters for 'unbanChatMember'.
data UnbanChatMemberRequest = UnbanChatMemberRequest
  { UnbanChatMemberRequest -> SomeChatId
unbanChatMemberChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target channel (in the format @channelusername)
  , UnbanChatMemberRequest -> UserId
unbanChatMemberUserId :: UserId -- ^ Unique identifier of the target user
  , UnbanChatMemberRequest -> Maybe Bool
unbanChatMemberOnlyIfBanned :: Maybe Bool -- ^ Do nothing if the user is not banned
  }
  deriving forall x. Rep UnbanChatMemberRequest x -> UnbanChatMemberRequest
forall x. UnbanChatMemberRequest -> Rep UnbanChatMemberRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnbanChatMemberRequest x -> UnbanChatMemberRequest
$cfrom :: forall x. UnbanChatMemberRequest -> Rep UnbanChatMemberRequest x
Generic

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

type UnbanChatMember = "unbanChatMember"
  :> ReqBody '[JSON] UnbanChatMemberRequest
  :> Post '[JSON] (Response Bool)

-- | Use this method to unban a previously
--   banned user in a supergroup or channel.
--   The user will not return to the group
--   or channel automatically, but will be
--   able to join via link, etc. The bot must
--   be an administrator for this to work. By
--   default, this method guarantees that after
--   the call the user is not a member of the chat,
--   but will be able to join it. So if the user is
--   a member of the chat they will also be removed
--   from the chat. If you don't want this, use the
--   parameter only_if_banned.
--   Returns True on success.
unbanChatMember :: UnbanChatMemberRequest ->  ClientM (Response Bool)
unbanChatMember :: UnbanChatMemberRequest -> ClientM (Response Bool)
unbanChatMember = forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall {k} (t :: k). Proxy t
Proxy @UnbanChatMember)

makeDefault ''UnbanChatMemberRequest