{-# LANGUAGE DeriveGeneric #-}
module Telegram.Bot.API.Types.ChatInviteLink where

import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Text (Text)
import Data.Time.Clock.POSIX (POSIXTime)
import GHC.Generics (Generic)

import Telegram.Bot.API.Types.User
import Telegram.Bot.API.Internal.Utils

-- ** 'ChatInviteLink'

-- | Represents an invite link for a chat.
data ChatInviteLink = ChatInviteLink
  { ChatInviteLink -> Text
chatInviteLinkInviteLink              :: Text            -- ^ The invite link. If the link was created by another chat administrator, then the second part of the link will be replaced with “…”.
  , ChatInviteLink -> User
chatInviteLinkCreator                 :: User            -- ^ Creator of the link.
  , ChatInviteLink -> Bool
chatInviteLinkCreatesJoinRequest      :: Bool            -- ^ 'True', if users joining the chat via the link need to be approved by chat administrators.
  , ChatInviteLink -> Bool
chatInviteLinkIsPrimary               :: Bool            -- ^ 'True', if the link is primary.
  , ChatInviteLink -> Bool
chatInviteLinkIsRevoked               :: Bool            -- ^ 'True', if the link is revoked.
  , ChatInviteLink -> Maybe Text
chatInviteLinkName                    :: Maybe Text      -- ^ Invite link name.
  , ChatInviteLink -> Maybe POSIXTime
chatInviteLinkExpireDate              :: Maybe POSIXTime -- ^ Point in time (Unix timestamp) when the link will expire or has been expired.
  , ChatInviteLink -> Maybe Int
chatInviteLinkMemberLimit             :: Maybe Int     -- ^ Maximum number of users that can be members of the chat simultaneously after joining the chat via this invite link; 1-99999.
  , ChatInviteLink -> Maybe Int
chatInviteLinkPendingJoinRequestCount :: Maybe Int     -- ^ Number of pending join requests created using this link.
  }
  deriving (forall x. Rep ChatInviteLink x -> ChatInviteLink
forall x. ChatInviteLink -> Rep ChatInviteLink x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChatInviteLink x -> ChatInviteLink
$cfrom :: forall x. ChatInviteLink -> Rep ChatInviteLink x
Generic, Int -> ChatInviteLink -> ShowS
[ChatInviteLink] -> ShowS
ChatInviteLink -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChatInviteLink] -> ShowS
$cshowList :: [ChatInviteLink] -> ShowS
show :: ChatInviteLink -> String
$cshow :: ChatInviteLink -> String
showsPrec :: Int -> ChatInviteLink -> ShowS
$cshowsPrec :: Int -> ChatInviteLink -> ShowS
Show)

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