{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE LambdaCase #-}

module Telegram.Bot.API.Forum where

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

import Telegram.Bot.API.Internal.Utils
import Telegram.Bot.API.MakingRequests (Response)
import Telegram.Bot.API.Types

-- ** 'getForumTopicIconStickers'

type GetForumTopicIconStickers
  = "getForumTopicIconStickers"
  :> Post '[JSON] (Response [Sticker])

-- | Use this method to get custom emoji stickers, which can be used as a forum topic icon by any user.
-- Requires no parameters. Returns an '[Sticker]' objects.
getForumTopicIconStickers :: ClientM (Response [Sticker])
getForumTopicIconStickers :: ClientM (Response [Sticker])
getForumTopicIconStickers = Proxy GetForumTopicIconStickers
-> Client ClientM GetForumTopicIconStickers
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy GetForumTopicIconStickers
forall k (t :: k). Proxy t
Proxy @GetForumTopicIconStickers)

-- ** 'createForumTopic'

data CreateForumTopicRequest = CreateForumTopicRequest
  { CreateForumTopicRequest -> SomeChatId
createForumTopicRequestChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target supergroup (in the format @supergroupusername).
  , CreateForumTopicRequest -> Text
createForumTopicRequestName :: Text -- ^ Topic name, 1-128 characters.
  , CreateForumTopicRequest -> Maybe Integer
createForumTopicRequestIconColor :: Maybe Integer -- ^ Color of the topic icon in RGB format. Currently, must be one of @7322096 (0x6FB9F0), 16766590 (0xFFD67E), 13338331 (0xCB86DB), 9367192 (0x8EEE98), 16749490 (0xFF93B2), or 16478047 (0xFB6F5F)@.
  , CreateForumTopicRequest -> Maybe Text
createForumTopicRequestIconCustomEmojiId :: Maybe Text -- ^ Unique identifier of the custom emoji shown as the topic icon. Use 'getForumTopicIconStickers' to get all allowed custom emoji identifiers.
  }
  deriving (forall x.
 CreateForumTopicRequest -> Rep CreateForumTopicRequest x)
-> (forall x.
    Rep CreateForumTopicRequest x -> CreateForumTopicRequest)
-> Generic CreateForumTopicRequest
forall x. Rep CreateForumTopicRequest x -> CreateForumTopicRequest
forall x. CreateForumTopicRequest -> Rep CreateForumTopicRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateForumTopicRequest x -> CreateForumTopicRequest
$cfrom :: forall x. CreateForumTopicRequest -> Rep CreateForumTopicRequest x
Generic

instance ToJSON CreateForumTopicRequest where toJSON :: CreateForumTopicRequest -> Value
toJSON = CreateForumTopicRequest -> Value
forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON

type CreateForumTopic
  = "createForumTopic"
  :> ReqBody '[JSON] CreateForumTopicRequest
  :> Post '[JSON] (Response ForumTopic)

-- | Use this method to create a topic in a forum supergroup chat. The bot must be an administrator in the chat for this to work and must have the @can_manage_topics@ administrator rights. Returns information about the created topic as a 'ForumTopic' object.
createForumTopic :: CreateForumTopicRequest -> ClientM (Response ForumTopic)
createForumTopic :: CreateForumTopicRequest -> ClientM (Response ForumTopic)
createForumTopic = Proxy CreateForumTopic -> Client ClientM CreateForumTopic
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy CreateForumTopic
forall k (t :: k). Proxy t
Proxy @CreateForumTopic)


-- ** 'editForumTopic'

data EditForumTopicRequest = EditForumTopicRequest
  { EditForumTopicRequest -> SomeChatId
editForumTopicChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target supergroup (in the format @supergroupusername).
  , EditForumTopicRequest -> MessageThreadId
editForumTopicMessageThreadId :: MessageThreadId -- ^ Unique identifier for the target message thread of the forum topic.
  , EditForumTopicRequest -> Maybe Text
editForumTopicName :: Maybe Text -- ^ New topic name, 0-128 characters. If not specified or empty, the current name of the topic will be kept.
  , EditForumTopicRequest -> Maybe Text
editForumTopicIconCustomEmojiId :: Maybe Text -- ^ New unique identifier of the custom emoji shown as the topic icon. Use 'getForumTopicIconStickers' to get all allowed custom emoji identifiers. Pass an empty string to remove the icon. If not specified, the current icon will be kept.
  }
  deriving (forall x. EditForumTopicRequest -> Rep EditForumTopicRequest x)
-> (forall x. Rep EditForumTopicRequest x -> EditForumTopicRequest)
-> Generic EditForumTopicRequest
forall x. Rep EditForumTopicRequest x -> EditForumTopicRequest
forall x. EditForumTopicRequest -> Rep EditForumTopicRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EditForumTopicRequest x -> EditForumTopicRequest
$cfrom :: forall x. EditForumTopicRequest -> Rep EditForumTopicRequest x
Generic

instance ToJSON EditForumTopicRequest where toJSON :: EditForumTopicRequest -> Value
toJSON = EditForumTopicRequest -> Value
forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON

type EditForumTopic
  = "editForumTopic"
  :> ReqBody '[JSON] EditForumTopicRequest
  :> Post '[JSON] (Response Bool)

-- | Use this method to edit name and icon of a topic in a forum supergroup chat. The bot must be an administrator in the chat for this to work and must have @can_manage_topics@ administrator rights, unless it is the creator of the topic. Returns 'True' on success.
editForumTopic :: EditForumTopicRequest -> ClientM (Response Bool)
editForumTopic :: EditForumTopicRequest -> ClientM (Response Bool)
editForumTopic = Proxy EditForumTopic -> Client ClientM EditForumTopic
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy EditForumTopic
forall k (t :: k). Proxy t
Proxy @EditForumTopic)

-- ** 'closeForumTopic'

data CloseForumTopicRequest = CloseForumTopicRequest
  { CloseForumTopicRequest -> SomeChatId
closeForumTopicRequestChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target supergroup (in the format @supergroupusername).
  , CloseForumTopicRequest -> MessageThreadId
closeForumTopicRequestMessageThreadId :: MessageThreadId -- ^ Unique identifier for the target message thread of the forum topic.
  }
  deriving (forall x. CloseForumTopicRequest -> Rep CloseForumTopicRequest x)
-> (forall x.
    Rep CloseForumTopicRequest x -> CloseForumTopicRequest)
-> Generic CloseForumTopicRequest
forall x. Rep CloseForumTopicRequest x -> CloseForumTopicRequest
forall x. CloseForumTopicRequest -> Rep CloseForumTopicRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CloseForumTopicRequest x -> CloseForumTopicRequest
$cfrom :: forall x. CloseForumTopicRequest -> Rep CloseForumTopicRequest x
Generic

instance ToJSON CloseForumTopicRequest where toJSON :: CloseForumTopicRequest -> Value
toJSON = CloseForumTopicRequest -> Value
forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON

type CloseForumTopic
  = "closeForumTopic"
  :> ReqBody '[JSON] CloseForumTopicRequest
  :> Post '[JSON] (Response Bool)

-- | Use this method to close an open topic in a forum supergroup chat. The bot must be an administrator in the chat for this to work and must have the @can_manage_topics@ administrator rights, unless it is the creator of the topic. Returns 'True' on success.
closeForumTopic :: CloseForumTopicRequest -> ClientM (Response Bool)
closeForumTopic :: CloseForumTopicRequest -> ClientM (Response Bool)
closeForumTopic = Proxy CloseForumTopic -> Client ClientM CloseForumTopic
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy CloseForumTopic
forall k (t :: k). Proxy t
Proxy @CloseForumTopic)

-- ** 'reopenForumTopic'

data ReopenForumTopicRequest = ReopenForumTopicRequest
  { ReopenForumTopicRequest -> SomeChatId
reopenForumTopicRequestChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target supergroup (in the format @supergroupusername).
  , ReopenForumTopicRequest -> MessageThreadId
reopenForumTopicRequestMessageThreadId :: MessageThreadId -- ^ Unique identifier for the target message thread of the forum topic.
  }
  deriving (forall x.
 ReopenForumTopicRequest -> Rep ReopenForumTopicRequest x)
-> (forall x.
    Rep ReopenForumTopicRequest x -> ReopenForumTopicRequest)
-> Generic ReopenForumTopicRequest
forall x. Rep ReopenForumTopicRequest x -> ReopenForumTopicRequest
forall x. ReopenForumTopicRequest -> Rep ReopenForumTopicRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReopenForumTopicRequest x -> ReopenForumTopicRequest
$cfrom :: forall x. ReopenForumTopicRequest -> Rep ReopenForumTopicRequest x
Generic

instance ToJSON ReopenForumTopicRequest where toJSON :: ReopenForumTopicRequest -> Value
toJSON = ReopenForumTopicRequest -> Value
forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON

type ReopenForumTopic
  = "reopenForumTopic"
  :> ReqBody '[JSON] ReopenForumTopicRequest
  :> Post '[JSON] (Response Bool)

-- | Use this method to reopen a closed topic in a forum supergroup chat. The bot must be an administrator in the chat for this to work and must have the @can_manage_topics@ administrator rights, unless it is the creator of the topic. Returns 'True' on success.
reopenForumTopic :: ReopenForumTopicRequest -> ClientM (Response Bool)
reopenForumTopic :: ReopenForumTopicRequest -> ClientM (Response Bool)
reopenForumTopic = Proxy ReopenForumTopic -> Client ClientM ReopenForumTopic
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy ReopenForumTopic
forall k (t :: k). Proxy t
Proxy @ReopenForumTopic)

-- ** 'deleteForumTopic'

data DeleteForumTopicRequest = DeleteForumTopicRequest
  { DeleteForumTopicRequest -> SomeChatId
deleteForumTopicRequestChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target supergroup (in the format @supergroupusername).
  , DeleteForumTopicRequest -> MessageThreadId
deleteForumTopicRequestMessageThreadId :: MessageThreadId -- ^ Unique identifier for the target message thread of the forum topic.
  }
  deriving (forall x.
 DeleteForumTopicRequest -> Rep DeleteForumTopicRequest x)
-> (forall x.
    Rep DeleteForumTopicRequest x -> DeleteForumTopicRequest)
-> Generic DeleteForumTopicRequest
forall x. Rep DeleteForumTopicRequest x -> DeleteForumTopicRequest
forall x. DeleteForumTopicRequest -> Rep DeleteForumTopicRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteForumTopicRequest x -> DeleteForumTopicRequest
$cfrom :: forall x. DeleteForumTopicRequest -> Rep DeleteForumTopicRequest x
Generic

instance ToJSON DeleteForumTopicRequest where toJSON :: DeleteForumTopicRequest -> Value
toJSON = DeleteForumTopicRequest -> Value
forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON

type DeleteForumTopic
  = "deleteForumTopic"
  :> ReqBody '[JSON] DeleteForumTopicRequest
  :> Post '[JSON] (Response Bool)

-- | Use this method to delete a forum topic along with all its messages in a forum supergroup chat. The bot must be an administrator in the chat for this to work and must have the @can_delete_messages@ administrator rights. Returns 'True' on success.
deleteForumTopic :: DeleteForumTopicRequest -> ClientM (Response Bool)
deleteForumTopic :: DeleteForumTopicRequest -> ClientM (Response Bool)
deleteForumTopic = Proxy DeleteForumTopic -> Client ClientM DeleteForumTopic
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy DeleteForumTopic
forall k (t :: k). Proxy t
Proxy @DeleteForumTopic)

-- ** 'unpinAllForumTopicMessages'

data UnpinAllForumTopicMessagesRequest = UnpinAllForumTopicMessagesRequest
  { UnpinAllForumTopicMessagesRequest -> SomeChatId
unpinAllForumTopicMessagesRequestChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target supergroup (in the format @supergroupusername)
  , UnpinAllForumTopicMessagesRequest -> MessageThreadId
unpinAllForumTopicMessagesRequestMessageThreadId :: MessageThreadId -- ^ Unique identifier for the target message thread of the forum topic.
  }
  deriving (forall x.
 UnpinAllForumTopicMessagesRequest
 -> Rep UnpinAllForumTopicMessagesRequest x)
-> (forall x.
    Rep UnpinAllForumTopicMessagesRequest x
    -> UnpinAllForumTopicMessagesRequest)
-> Generic UnpinAllForumTopicMessagesRequest
forall x.
Rep UnpinAllForumTopicMessagesRequest x
-> UnpinAllForumTopicMessagesRequest
forall x.
UnpinAllForumTopicMessagesRequest
-> Rep UnpinAllForumTopicMessagesRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UnpinAllForumTopicMessagesRequest x
-> UnpinAllForumTopicMessagesRequest
$cfrom :: forall x.
UnpinAllForumTopicMessagesRequest
-> Rep UnpinAllForumTopicMessagesRequest x
Generic

instance ToJSON UnpinAllForumTopicMessagesRequest where toJSON :: UnpinAllForumTopicMessagesRequest -> Value
toJSON = UnpinAllForumTopicMessagesRequest -> Value
forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON

type UnpinAllForumTopicMessages
  = "unpinAllForumTopicMessages"
  :> ReqBody '[JSON] UnpinAllForumTopicMessagesRequest
  :> Post '[JSON] (Response Bool)

-- | Use this method to clear the list of pinned messages in a forum topic. The bot must be an administrator in the chat for this to work and must have the @can_pin_messages@ administrator right in the supergroup. Returns 'True' on success.
unpinAllForumTopicMessages :: UnpinAllForumTopicMessagesRequest -> ClientM (Response Bool)
unpinAllForumTopicMessages :: UnpinAllForumTopicMessagesRequest -> ClientM (Response Bool)
unpinAllForumTopicMessages = Proxy UnpinAllForumTopicMessages
-> Client ClientM UnpinAllForumTopicMessages
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy UnpinAllForumTopicMessages
forall k (t :: k). Proxy t
Proxy @UnpinAllForumTopicMessages)

-- ** 'editGeneralForumTopic'

data EditGeneralForumTopicRequest = EditGeneralForumTopicRequest
  { EditGeneralForumTopicRequest -> SomeChatId
editGeneralForumTopicRequestChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target supergroup (in the format @supergroupusername).
  , EditGeneralForumTopicRequest -> Text
editGeneralForumTopicRequestName :: Text -- ^ New topic name, 1-128 characters.
  }
  deriving (forall x.
 EditGeneralForumTopicRequest -> Rep EditGeneralForumTopicRequest x)
-> (forall x.
    Rep EditGeneralForumTopicRequest x -> EditGeneralForumTopicRequest)
-> Generic EditGeneralForumTopicRequest
forall x.
Rep EditGeneralForumTopicRequest x -> EditGeneralForumTopicRequest
forall x.
EditGeneralForumTopicRequest -> Rep EditGeneralForumTopicRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep EditGeneralForumTopicRequest x -> EditGeneralForumTopicRequest
$cfrom :: forall x.
EditGeneralForumTopicRequest -> Rep EditGeneralForumTopicRequest x
Generic

instance ToJSON EditGeneralForumTopicRequest where toJSON :: EditGeneralForumTopicRequest -> Value
toJSON = EditGeneralForumTopicRequest -> Value
forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON

type EditGeneralForumTopic
  = "editGeneralForumTopic"
  :> ReqBody '[JSON] EditGeneralForumTopicRequest
  :> Post '[JSON] (Response Bool)

-- | Use this method to edit the name of the @General@ topic in a forum supergroup chat. The bot must be an administrator in the chat for this to work and must have @can_manage_topics@ administrator rights. Returns 'True' on success.
editGeneralForumTopic :: EditGeneralForumTopicRequest -> ClientM (Response Bool)
editGeneralForumTopic :: EditGeneralForumTopicRequest -> ClientM (Response Bool)
editGeneralForumTopic = Proxy EditGeneralForumTopic -> Client ClientM EditGeneralForumTopic
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy EditGeneralForumTopic
forall k (t :: k). Proxy t
Proxy @EditGeneralForumTopic)

-- ** 'closeGeneralForumTopic'

data CloseGeneralForumTopicRequest = CloseGeneralForumTopicRequest
  { CloseGeneralForumTopicRequest -> SomeChatId
closeGeneralForumTopicChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target supergroup (in the format @supergroupusername).
  }
  deriving (forall x.
 CloseGeneralForumTopicRequest
 -> Rep CloseGeneralForumTopicRequest x)
-> (forall x.
    Rep CloseGeneralForumTopicRequest x
    -> CloseGeneralForumTopicRequest)
-> Generic CloseGeneralForumTopicRequest
forall x.
Rep CloseGeneralForumTopicRequest x
-> CloseGeneralForumTopicRequest
forall x.
CloseGeneralForumTopicRequest
-> Rep CloseGeneralForumTopicRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CloseGeneralForumTopicRequest x
-> CloseGeneralForumTopicRequest
$cfrom :: forall x.
CloseGeneralForumTopicRequest
-> Rep CloseGeneralForumTopicRequest x
Generic

instance ToJSON CloseGeneralForumTopicRequest where toJSON :: CloseGeneralForumTopicRequest -> Value
toJSON = CloseGeneralForumTopicRequest -> Value
forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON

type CloseGeneralForumTopic
  = "closeGeneralForumTopic"
  :> ReqBody '[JSON] CloseGeneralForumTopicRequest
  :> Post '[JSON] (Response Bool)

-- | Use this method to close an open @General@ topic in a forum supergroup chat. The bot must be an administrator in the chat for this to work and must have the @can_manage_topics@ administrator rights. Returns 'True' on success.
closeGeneralForumTopic :: CloseGeneralForumTopicRequest -> ClientM (Response Bool)
closeGeneralForumTopic :: CloseGeneralForumTopicRequest -> ClientM (Response Bool)
closeGeneralForumTopic = Proxy CloseGeneralForumTopic
-> Client ClientM CloseGeneralForumTopic
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy CloseGeneralForumTopic
forall k (t :: k). Proxy t
Proxy @CloseGeneralForumTopic)

-- ** 'reopenGeneralForumTopic'

data ReopenGeneralForumTopicRequest = ReopenGeneralForumTopicRequest
  { ReopenGeneralForumTopicRequest -> SomeChatId
reopenGeneralForumTopicRequestChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target supergroup (in the format @supergroupusername).
  }
  deriving (forall x.
 ReopenGeneralForumTopicRequest
 -> Rep ReopenGeneralForumTopicRequest x)
-> (forall x.
    Rep ReopenGeneralForumTopicRequest x
    -> ReopenGeneralForumTopicRequest)
-> Generic ReopenGeneralForumTopicRequest
forall x.
Rep ReopenGeneralForumTopicRequest x
-> ReopenGeneralForumTopicRequest
forall x.
ReopenGeneralForumTopicRequest
-> Rep ReopenGeneralForumTopicRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ReopenGeneralForumTopicRequest x
-> ReopenGeneralForumTopicRequest
$cfrom :: forall x.
ReopenGeneralForumTopicRequest
-> Rep ReopenGeneralForumTopicRequest x
Generic

instance ToJSON ReopenGeneralForumTopicRequest where toJSON :: ReopenGeneralForumTopicRequest -> Value
toJSON = ReopenGeneralForumTopicRequest -> Value
forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON

type ReopenGeneralForumTopic
  = "reopenGeneralForumTopic"
  :> ReqBody '[JSON] ReopenGeneralForumTopicRequest
  :> Post '[JSON] (Response Bool)

-- | Use this method to reopen a closed @General@ topic in a forum supergroup chat. The bot must be an administrator in the chat for this to work and must have the @can_manage_topics@ administrator rights. The topic will be automatically unhidden if it was hidden. Returns 'True' on success.
reopenGeneralForumTopic :: ReopenGeneralForumTopicRequest -> ClientM (Response Bool)
reopenGeneralForumTopic :: ReopenGeneralForumTopicRequest -> ClientM (Response Bool)
reopenGeneralForumTopic = Proxy ReopenGeneralForumTopic
-> Client ClientM ReopenGeneralForumTopic
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy ReopenGeneralForumTopic
forall k (t :: k). Proxy t
Proxy @ReopenGeneralForumTopic)

-- ** 'hideGeneralForumTopic'

data HideGeneralForumTopicRequest = HideGeneralForumTopicRequest
  { HideGeneralForumTopicRequest -> SomeChatId
hideGeneralForumTopicRequestChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target supergroup (in the format @supergroupusername).
  }
  deriving (forall x.
 HideGeneralForumTopicRequest -> Rep HideGeneralForumTopicRequest x)
-> (forall x.
    Rep HideGeneralForumTopicRequest x -> HideGeneralForumTopicRequest)
-> Generic HideGeneralForumTopicRequest
forall x.
Rep HideGeneralForumTopicRequest x -> HideGeneralForumTopicRequest
forall x.
HideGeneralForumTopicRequest -> Rep HideGeneralForumTopicRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep HideGeneralForumTopicRequest x -> HideGeneralForumTopicRequest
$cfrom :: forall x.
HideGeneralForumTopicRequest -> Rep HideGeneralForumTopicRequest x
Generic

instance ToJSON HideGeneralForumTopicRequest where toJSON :: HideGeneralForumTopicRequest -> Value
toJSON = HideGeneralForumTopicRequest -> Value
forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON

type HideGeneralForumTopic
  = "hideGeneralForumTopic"
  :> ReqBody '[JSON] HideGeneralForumTopicRequest
  :> Post '[JSON] (Response Bool)

-- | Use this method to hide the @General@ topic in a forum supergroup chat. The bot must be an administrator in the chat for this to work and must have the @can_manage_topics@ administrator rights. The topic will be automatically closed if it was open. Returns 'True' on success.
hideGeneralForumTopic :: HideGeneralForumTopicRequest -> ClientM (Response Bool)
hideGeneralForumTopic :: HideGeneralForumTopicRequest -> ClientM (Response Bool)
hideGeneralForumTopic = Proxy HideGeneralForumTopic -> Client ClientM HideGeneralForumTopic
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy HideGeneralForumTopic
forall k (t :: k). Proxy t
Proxy @HideGeneralForumTopic)

-- ** 'unhideGeneralForumTopic'

data UnhideGeneralForumTopicRequest = UnhideGeneralForumTopicRequest
  { UnhideGeneralForumTopicRequest -> SomeChatId
unhideGeneralForumTopicRequestChatId :: SomeChatId -- ^ Unique identifier for the target chat or username of the target supergroup (in the format @supergroupusername)
  }
  deriving (forall x.
 UnhideGeneralForumTopicRequest
 -> Rep UnhideGeneralForumTopicRequest x)
-> (forall x.
    Rep UnhideGeneralForumTopicRequest x
    -> UnhideGeneralForumTopicRequest)
-> Generic UnhideGeneralForumTopicRequest
forall x.
Rep UnhideGeneralForumTopicRequest x
-> UnhideGeneralForumTopicRequest
forall x.
UnhideGeneralForumTopicRequest
-> Rep UnhideGeneralForumTopicRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UnhideGeneralForumTopicRequest x
-> UnhideGeneralForumTopicRequest
$cfrom :: forall x.
UnhideGeneralForumTopicRequest
-> Rep UnhideGeneralForumTopicRequest x
Generic

instance ToJSON UnhideGeneralForumTopicRequest where toJSON :: UnhideGeneralForumTopicRequest -> Value
toJSON = UnhideGeneralForumTopicRequest -> Value
forall a (d :: Meta) (f :: * -> *).
(Generic a, GToJSON Zero (Rep a), Rep a ~ D1 d f, Datatype d) =>
a -> Value
gtoJSON

type UnhideGeneralForumTopic
  = "unhideGeneralForumTopic"
  :> ReqBody '[JSON] UnhideGeneralForumTopicRequest
  :> Post '[JSON] (Response Bool)

-- | Use this method to unhide the @General@ topic in a forum supergroup chat. The bot must be an administrator in the chat for this to work and must have the @can_manage_topics@ administrator rights. Returns 'True' on success.
unhideGeneralForumTopic :: UnhideGeneralForumTopicRequest -> ClientM (Response Bool)
unhideGeneralForumTopic :: UnhideGeneralForumTopicRequest -> ClientM (Response Bool)
unhideGeneralForumTopic = Proxy UnhideGeneralForumTopic
-> Client ClientM UnhideGeneralForumTopic
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy UnhideGeneralForumTopic
forall k (t :: k). Proxy t
Proxy @UnhideGeneralForumTopic)