{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
module Discord.Internal.Rest.Guild
( GuildRequest(..)
, CreateGuildChannelOpts(..)
, CreateGuildOpts(..)
, ModifyGuildOpts(..)
, AddGuildMemberOpts(..)
, ModifyGuildMemberOpts(..)
, GuildMembersTiming(..)
, CreateGuildBanOpts(..)
, ModifyGuildRoleOpts(..)
, CreateGuildIntegrationOpts(..)
, ModifyGuildIntegrationOpts(..)
) where
import Data.Aeson
import Data.Monoid (mempty, (<>))
import Network.HTTP.Req ((/:))
import qualified Network.HTTP.Req as R
import qualified Data.Text as T
import Discord.Internal.Rest.Prelude
import Discord.Internal.Types
instance Request (GuildRequest a) where
majorRoute = guildMajorRoute
jsonRequest = guildJsonRequest
data GuildRequest a where
CreateGuild :: CreateGuildOpts -> GuildRequest Guild
GetGuild :: GuildId -> GuildRequest Guild
ModifyGuild :: GuildId -> ModifyGuildOpts -> GuildRequest Guild
DeleteGuild :: GuildId -> GuildRequest ()
GetGuildChannels :: GuildId -> GuildRequest [Channel]
CreateGuildChannel :: GuildId -> T.Text -> [Overwrite] -> CreateGuildChannelOpts -> GuildRequest Channel
ModifyGuildChannelPositions :: GuildId -> [(ChannelId,Int)] -> GuildRequest [Channel]
GetGuildMember :: GuildId -> UserId -> GuildRequest GuildMember
ListGuildMembers :: GuildId -> GuildMembersTiming -> GuildRequest [GuildMember]
AddGuildMember :: GuildId -> UserId -> AddGuildMemberOpts
-> GuildRequest ()
ModifyGuildMember :: GuildId -> UserId -> ModifyGuildMemberOpts -> GuildRequest ()
ModifyCurrentUserNick :: GuildId -> T.Text -> GuildRequest ()
AddGuildMemberRole :: GuildId -> UserId -> RoleId -> GuildRequest ()
RemoveGuildMemberRole :: GuildId -> UserId -> RoleId -> GuildRequest ()
RemoveGuildMember :: GuildId -> UserId -> GuildRequest ()
GetGuildBans :: GuildId -> GuildRequest [Ban]
GetGuildBan :: GuildId -> UserId -> GuildRequest Ban
CreateGuildBan :: GuildId -> UserId -> CreateGuildBanOpts -> GuildRequest ()
RemoveGuildBan :: GuildId -> UserId -> GuildRequest ()
GetGuildRoles :: GuildId -> GuildRequest [Role]
CreateGuildRole :: GuildId -> ModifyGuildRoleOpts -> GuildRequest Role
ModifyGuildRolePositions :: GuildId -> [(RoleId, Integer)] -> GuildRequest [Role]
ModifyGuildRole :: GuildId -> RoleId -> ModifyGuildRoleOpts -> GuildRequest Role
DeleteGuildRole :: GuildId -> RoleId -> GuildRequest ()
GetGuildPruneCount :: GuildId -> Integer -> GuildRequest Object
BeginGuildPrune :: GuildId -> Integer -> GuildRequest Object
GetGuildVoiceRegions :: GuildId -> GuildRequest [VoiceRegion]
GetGuildInvites :: GuildId -> GuildRequest [Invite]
GetGuildIntegrations :: GuildId -> GuildRequest [Integration]
CreateGuildIntegration :: GuildId -> IntegrationId -> CreateGuildIntegrationOpts -> GuildRequest ()
ModifyGuildIntegration :: GuildId -> IntegrationId -> ModifyGuildIntegrationOpts
-> GuildRequest ()
DeleteGuildIntegration :: GuildId -> IntegrationId -> GuildRequest ()
SyncGuildIntegration :: GuildId -> IntegrationId -> GuildRequest ()
GetGuildEmbed :: GuildId -> GuildRequest GuildEmbed
ModifyGuildEmbed :: GuildId -> GuildEmbed -> GuildRequest GuildEmbed
GetGuildVanityURL :: GuildId -> GuildRequest T.Text
data CreateGuildOpts = CreateGuildOpts
{ createGuildOptsName :: T.Text
, createGuildOptsChannels :: [Channel]
} deriving (Show, Eq, Ord)
instance ToJSON CreateGuildOpts where
toJSON CreateGuildOpts{..} = object [(name, val) | (name, Just val) <-
[ ("name", toJSON <$> pure createGuildOptsName )
, ("channels", toJSON <$> pure createGuildOptsChannels ) ]]
data ModifyGuildIntegrationOpts = ModifyGuildIntegrationOpts
{ modifyGuildIntegrationOptsExpireBehavior :: Integer
, modifyGuildIntegrationOptsExpireGraceSeconds :: Integer
, modifyGuildIntegrationOptsEmoticonsEnabled :: Bool
} deriving (Show, Eq, Ord)
instance ToJSON ModifyGuildIntegrationOpts where
toJSON ModifyGuildIntegrationOpts{..} = object [(name, val) | (name, Just val) <-
[ ("expire_grace_period", toJSON <$> pure modifyGuildIntegrationOptsExpireGraceSeconds )
, ("expire_behavior", toJSON <$> pure modifyGuildIntegrationOptsExpireBehavior )
, ("enable_emoticons", toJSON <$> pure modifyGuildIntegrationOptsEmoticonsEnabled ) ]]
data CreateGuildIntegrationOpts = CreateGuildIntegrationOpts
{ createGuildIntegrationOptsType :: T.Text
} deriving (Show, Eq, Ord)
instance ToJSON CreateGuildIntegrationOpts where
toJSON CreateGuildIntegrationOpts{..} = object [(name, val) | (name, Just val) <-
[("type", toJSON <$> pure createGuildIntegrationOptsType ) ]]
data CreateGuildBanOpts = CreateGuildBanOpts
{ createGuildBanOptsDeleteLastNMessages :: Maybe Int
, createGuildBanOptsReason :: Maybe T.Text
} deriving (Show, Eq, Ord)
instance ToJSON CreateGuildBanOpts where
toJSON CreateGuildBanOpts{..} = object [(name, val) | (name, Just val) <-
[("delete-message-days",
toJSON <$> createGuildBanOptsDeleteLastNMessages ),
("reason", toJSON <$> createGuildBanOptsReason )]]
data ModifyGuildRoleOpts = ModifyGuildRoleOpts
{ modifyGuildRoleOptsName :: Maybe T.Text
, modifyGuildRoleOptsPermissions :: Maybe Integer
, modifyGuildRoleOptsColor :: Maybe Integer
, modifyGuildRoleOptsSeparateSidebar :: Maybe Bool
, modifyGuildRoleOptsMentionable :: Maybe Bool
} deriving (Show, Eq, Ord)
instance ToJSON ModifyGuildRoleOpts where
toJSON ModifyGuildRoleOpts{..} = object [(name, val) | (name, Just val) <-
[("name", toJSON <$> modifyGuildRoleOptsName ),
("permissions", toJSON <$> modifyGuildRoleOptsPermissions ),
("color", toJSON <$> modifyGuildRoleOptsColor ),
("hoist", toJSON <$> modifyGuildRoleOptsSeparateSidebar ),
("mentionable", toJSON <$> modifyGuildRoleOptsMentionable )]]
data AddGuildMemberOpts = AddGuildMemberOpts
{ addGuildMemberOptsAccessToken :: T.Text
, addGuildMemberOptsNickname :: Maybe T.Text
, addGuildMemberOptsRoles :: Maybe [RoleId]
, addGuildMemberOptsIsMuted :: Maybe Bool
, addGuildMemberOptsIsDeafened :: Maybe Bool
} deriving (Show, Eq, Ord)
instance ToJSON AddGuildMemberOpts where
toJSON AddGuildMemberOpts{..} = object [(name, val) | (name, Just val) <-
[("access_token", toJSON <$> Just addGuildMemberOptsAccessToken ),
("nick", toJSON <$> addGuildMemberOptsNickname ),
("roles", toJSON <$> addGuildMemberOptsRoles ),
("mute", toJSON <$> addGuildMemberOptsIsMuted ),
("deaf", toJSON <$> addGuildMemberOptsIsDeafened )]]
data ModifyGuildMemberOpts = ModifyGuildMemberOpts
{ modifyGuildMemberOptsNickname :: Maybe T.Text
, modifyGuildMemberOptsRoles :: Maybe [RoleId]
, modifyGuildMemberOptsIsMuted :: Maybe Bool
, modifyGuildMemberOptsIsDeafened :: Maybe Bool
, modifyGuildMemberOptsMoveToChannel :: Maybe ChannelId
} deriving (Show, Eq, Ord)
instance ToJSON ModifyGuildMemberOpts where
toJSON ModifyGuildMemberOpts{..} = object [(name, val) | (name, Just val) <-
[("nick", toJSON <$> modifyGuildMemberOptsNickname ),
("roles", toJSON <$> modifyGuildMemberOptsRoles ),
("mute", toJSON <$> modifyGuildMemberOptsIsMuted ),
("deaf", toJSON <$> modifyGuildMemberOptsIsDeafened ),
("channel_id", toJSON <$> modifyGuildMemberOptsMoveToChannel)]]
data CreateGuildChannelOpts
= CreateGuildChannelOptsText {
createGuildChannelOptsTopic :: Maybe T.Text
, createGuildChannelOptsUserMessageRateDelay :: Maybe Integer
, createGuildChannelOptsIsNSFW :: Maybe Bool
, createGuildChannelOptsCategoryId :: Maybe ChannelId }
| CreateGuildChannelOptsVoice {
createGuildChannelOptsBitrate :: Maybe Integer
, createGuildChannelOptsMaxUsers :: Maybe Integer
, createGuildChannelOptsCategoryId :: Maybe ChannelId }
| CreateGuildChannelOptsCategory
deriving (Show, Eq, Ord)
createChannelOptsToJSON :: T.Text -> [Overwrite] -> CreateGuildChannelOpts -> Value
createChannelOptsToJSON name perms opts = object [(key, val) | (key, Just val) <- optsJSON]
where
optsJSON = case opts of
CreateGuildChannelOptsText{..} ->
[("name", Just (String name))
,("type", Just (Number 0))
,("permission_overwrites", toJSON <$> Just perms)
,("topic", toJSON <$> createGuildChannelOptsTopic)
,("rate_limit_per_user", toJSON <$> createGuildChannelOptsUserMessageRateDelay)
,("nsfw", toJSON <$> createGuildChannelOptsIsNSFW)
,("parent_id", toJSON <$> createGuildChannelOptsCategoryId)]
CreateGuildChannelOptsVoice{..} ->
[("name", Just (String name))
,("type", Just (Number 2))
,("permission_overwrites", toJSON <$> Just perms)
,("bitrate", toJSON <$> createGuildChannelOptsBitrate)
,("user_limit", toJSON <$> createGuildChannelOptsMaxUsers)
,("parent_id", toJSON <$> createGuildChannelOptsCategoryId)]
CreateGuildChannelOptsCategory ->
[("name", Just (String name))
,("type", Just (Number 4))
,("permission_overwrites", toJSON <$> Just perms)]
data ModifyGuildOpts = ModifyGuildOpts
{ modifyGuildOptsName :: Maybe T.Text
, modifyGuildOptsAFKChannelId :: Maybe ChannelId
, modifyGuildOptsIcon :: Maybe T.Text
, modifyGuildOptsOwnerId :: Maybe UserId
} deriving (Show, Eq, Ord)
instance ToJSON ModifyGuildOpts where
toJSON ModifyGuildOpts{..} = object [(name, val) | (name, Just val) <-
[("name", toJSON <$> modifyGuildOptsName ),
("afk_channel_id", toJSON <$> modifyGuildOptsAFKChannelId ),
("icon", toJSON <$> modifyGuildOptsIcon ),
("owner_id", toJSON <$> modifyGuildOptsOwnerId )] ]
data GuildMembersTiming = GuildMembersTiming
{ guildMembersTimingLimit :: Maybe Int
, guildMembersTimingAfter :: Maybe UserId
}
guildMembersTimingToQuery :: GuildMembersTiming -> R.Option 'R.Https
guildMembersTimingToQuery (GuildMembersTiming mLimit mAfter) =
let limit = case mLimit of
Nothing -> mempty
Just lim -> "limit" R.=: lim
after = case mAfter of
Nothing -> mempty
Just aft -> "after" R.=: show aft
in limit <> after
guildMajorRoute :: GuildRequest a -> String
guildMajorRoute c = case c of
(CreateGuild _) -> "guild "
(GetGuild g) -> "guild " <> show g
(ModifyGuild g _) -> "guild " <> show g
(DeleteGuild g) -> "guild " <> show g
(GetGuildChannels g) -> "guild_chan " <> show g
(CreateGuildChannel g _ _ _) -> "guild_chan " <> show g
(ModifyGuildChannelPositions g _) -> "guild_chan " <> show g
(GetGuildMember g _) -> "guild_memb " <> show g
(ListGuildMembers g _) -> "guild_membs " <> show g
(AddGuildMember g _ _) -> "guild_membs " <> show g
(ModifyGuildMember g _ _) -> "guild_membs " <> show g
(ModifyCurrentUserNick g _) -> "guild_membs " <> show g
(AddGuildMemberRole g _ _) -> "guild_membs " <> show g
(RemoveGuildMemberRole g _ _) -> "guild_membs " <> show g
(RemoveGuildMember g _) -> "guild_membs " <> show g
(GetGuildBan g _) -> "guild_bans " <> show g
(GetGuildBans g) -> "guild_bans " <> show g
(CreateGuildBan g _ _) -> "guild_ban " <> show g
(RemoveGuildBan g _) -> "guild_ban " <> show g
(GetGuildRoles g) -> "guild_roles " <> show g
(CreateGuildRole g _) -> "guild_roles " <> show g
(ModifyGuildRolePositions g _) -> "guild_roles " <> show g
(ModifyGuildRole g _ _) -> "guild_role " <> show g
(DeleteGuildRole g _ ) -> "guild_role " <> show g
(GetGuildPruneCount g _) -> "guild_prune " <> show g
(BeginGuildPrune g _) -> "guild_prune " <> show g
(GetGuildVoiceRegions g) -> "guild_voice " <> show g
(GetGuildInvites g) -> "guild_invit " <> show g
(GetGuildIntegrations g) -> "guild_integ " <> show g
(CreateGuildIntegration g _ _) -> "guild_integ " <> show g
(ModifyGuildIntegration g _ _) -> "guild_intgr " <> show g
(DeleteGuildIntegration g _) -> "guild_intgr " <> show g
(SyncGuildIntegration g _) -> "guild_sync " <> show g
(GetGuildEmbed g) -> "guild_embed " <> show g
(ModifyGuildEmbed g _) -> "guild_embed " <> show g
(GetGuildVanityURL g) -> "guild " <> show g
baseUrl :: R.Url 'R.Https
baseUrl = R.https "discordapp.com" R./: "api" R./: apiVersion
where apiVersion = "v6"
guilds :: R.Url 'R.Https
guilds = baseUrl /: "guilds"
guildJsonRequest :: GuildRequest r -> JsonRequest
guildJsonRequest c = case c of
(CreateGuild opts) ->
Post (guilds) (pure (R.ReqBodyJson opts)) mempty
(GetGuild guild) ->
Get (guilds // guild) mempty
(ModifyGuild guild patch) ->
Patch (guilds // guild) (R.ReqBodyJson patch) mempty
(DeleteGuild guild) ->
Delete (guilds // guild) mempty
(GetGuildChannels guild) ->
Get (guilds // guild /: "channels") mempty
(CreateGuildChannel guild name perms patch) ->
Post (guilds // guild /: "channels")
(pure (R.ReqBodyJson (createChannelOptsToJSON name perms patch))) mempty
(ModifyGuildChannelPositions guild newlocs) ->
let patch = map (\(a, b) -> object [("id", toJSON a)
,("position", toJSON b)]) newlocs
in Patch (guilds // guild /: "channels") (R.ReqBodyJson patch) mempty
(GetGuildMember guild member) ->
Get (guilds // guild /: "members" // member) mempty
(ListGuildMembers guild range) ->
Get (guilds // guild /: "members") (guildMembersTimingToQuery range)
(AddGuildMember guild user patch) ->
Put (guilds // guild /: "members" // user) (R.ReqBodyJson patch) mempty
(ModifyGuildMember guild member patch) ->
Patch (guilds // guild /: "members" // member) (R.ReqBodyJson patch) mempty
(ModifyCurrentUserNick guild name) ->
let patch = object ["nick" .= name]
in Patch (guilds // guild /: "members/@me/nick") (R.ReqBodyJson patch) mempty
(AddGuildMemberRole guild user role) ->
let body = R.ReqBodyJson (object [])
in Put (guilds // guild /: "members" // user /: "roles" // role) body mempty
(RemoveGuildMemberRole guild user role) ->
Delete (guilds // guild /: "members" // user /: "roles" // role) mempty
(RemoveGuildMember guild user) ->
Delete (guilds // guild /: "members" // user) mempty
(GetGuildBan guild user) -> Get (guilds // guild /: "bans" // user) mempty
(GetGuildBans guild) -> Get (guilds // guild /: "bans") mempty
(CreateGuildBan guild user patch) ->
Put (guilds // guild /: "bans" // user) (R.ReqBodyJson patch) mempty
(RemoveGuildBan guild ban) ->
Delete (guilds // guild /: "bans" // ban) mempty
(GetGuildRoles guild) ->
Get (guilds // guild /: "roles") mempty
(CreateGuildRole guild patch) ->
Post (guilds // guild /: "roles") (pure (R.ReqBodyJson patch)) mempty
(ModifyGuildRolePositions guild patch) ->
let body = map (\(role, pos) -> object ["id".=role, "position".=pos]) patch
in Patch (guilds // guild /: "roles") (R.ReqBodyJson body) mempty
(ModifyGuildRole guild role patch) ->
Patch (guilds // guild /: "roles" // role) (R.ReqBodyJson patch) mempty
(DeleteGuildRole guild role) ->
Delete (guilds // guild /: "roles" // role) mempty
(GetGuildPruneCount guild days) ->
Get (guilds // guild /: "prune") ("days" R.=: days)
(BeginGuildPrune guild days) ->
Post (guilds // guild /: "prune") (pure R.NoReqBody) ("days" R.=: days)
(GetGuildVoiceRegions guild) ->
Get (guilds // guild /: "regions") mempty
(GetGuildInvites guild) ->
Get (guilds // guild /: "invites") mempty
(GetGuildIntegrations guild) ->
Get (guilds // guild /: "integrations") mempty
(CreateGuildIntegration guild iid opts) ->
let patch = object [("type" .= createGuildIntegrationOptsType opts) ,("id" .= iid)]
in Post (guilds // guild /: "integrations") (pure (R.ReqBodyJson patch)) mempty
(ModifyGuildIntegration guild iid patch) ->
let body = R.ReqBodyJson patch
in Patch (guilds // guild /: "integrations" // iid) body mempty
(DeleteGuildIntegration guild integ) ->
Delete (guilds // guild /: "integrations" // integ) mempty
(SyncGuildIntegration guild integ) ->
Post (guilds // guild /: "integrations" // integ) (pure R.NoReqBody) mempty
(GetGuildEmbed guild) ->
Get (guilds // guild /: "integrations") mempty
(ModifyGuildEmbed guild patch) ->
Patch (guilds // guild /: "embed") (R.ReqBodyJson patch) mempty
(GetGuildVanityURL guild) ->
Get (guilds // guild /: "vanity-url") mempty