{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
module Discord.Rest.Guild
( GuildRequest(..)
, CreateGuildChannelOpts(..)
, ModifyGuildOpts(..)
, GuildMembersTiming(..)
) 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.Rest.Prelude
import Discord.Types
instance Request (GuildRequest a) where
majorRoute = guildMajorRoute
jsonRequest = guildJsonRequest
data GuildRequest a where
GetGuild :: GuildId -> GuildRequest Guild
ModifyGuild :: GuildId -> ModifyGuildOpts -> GuildRequest Guild
DeleteGuild :: GuildId -> GuildRequest Guild
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]
RemoveGuildMember :: GuildId -> UserId -> GuildRequest ()
GetGuildBans :: GuildId -> GuildRequest [User]
CreateGuildBan :: GuildId -> UserId -> Integer -> GuildRequest ()
RemoveGuildBan :: GuildId -> UserId -> GuildRequest ()
GetGuildRoles :: GuildId -> GuildRequest [Role]
DeleteGuildRole :: GuildId -> RoleId -> GuildRequest Role
GetGuildPruneCount :: GuildId -> Integer -> GuildRequest Object
BeginGuildPrune :: GuildId -> Integer -> GuildRequest Object
GetGuildVoiceRegions :: GuildId -> GuildRequest [VoiceRegion]
GetGuildInvites :: GuildId -> GuildRequest [Invite]
GetGuildIntegrations :: GuildId -> GuildRequest [Integration]
DeleteGuildIntegration :: GuildId -> IntegrationId -> GuildRequest ()
SyncGuildIntegration :: GuildId -> IntegrationId -> GuildRequest ()
GetGuildEmbed :: GuildId -> GuildRequest GuildEmbed
ModifyGuildEmbed :: GuildId -> GuildEmbed -> GuildRequest GuildEmbed
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)
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
(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
(RemoveGuildMember g _) -> "guild_memb " <> 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
(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
(DeleteGuildIntegration g _) -> "guild_intgr " <> show g
(SyncGuildIntegration g _) -> "guild_sync " <> show g
(GetGuildEmbed g) -> "guild_embed " <> show g
(ModifyGuildEmbed g _) -> "guild_embed " <> 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
(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)
(RemoveGuildMember guild user) ->
Delete (guilds // guild /: "members" // user) mempty
(GetGuildBans guild) ->
Get (guilds // guild /: "bans") mempty
(CreateGuildBan guild user msgs) ->
let body = R.ReqBodyJson (object ["delete-message-days" .= msgs])
in Put (guilds // guild /: "bans" // user) body mempty
(RemoveGuildBan guild ban) ->
Delete (guilds // guild /: "bans" // ban) mempty
(GetGuildRoles guild) ->
Get (guilds // guild /: "roles") 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
(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