diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -23,7 +23,7 @@ Client ID and Permissions come from previous steps. `https://discordapp.com/oauth2/authorize?client_id=&scope=bot&permissions=` -4 Tos end `CreateMessage` events with restCall, you must connect to the gateway at least once. Try running `examples/gateway.hs` with your token to satisfy this. +4 To send `CreateMessage` events with restCall, you must connect to the gateway at least once. Try running `examples/gateway.hs` with your token to satisfy this. [This is a Discord requirement.](https://discordapp.com/developers/docs/resources/channel#create-message) 5 Look at the examples to get an idea of how the library is used. diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -4,6 +4,12 @@ ## master +## 0.8.4 + +[marcotoniut](https://github.com/aquarial/discord-haskell/pull/18) Improved changed Embed ADT to have optional fields, and improved two field names + +Add `ModifyGuildMember`, `AddGuildMember`, `AddGuildMemberRole`, `AddGuildMemberRole`, `RemoveGuildmembeRole`, `GetGuildBan`, `GetGuildVanityURL` rest data types + ## 0.8.3 Simplify Message Author from `Either WebhookId User` to `User` diff --git a/discord-haskell.cabal b/discord-haskell.cabal --- a/discord-haskell.cabal +++ b/discord-haskell.cabal @@ -1,7 +1,7 @@ cabal-version: 2.0 name: discord-haskell -- library version is also noted at src/Discord/Rest/Prelude.hs -version: 0.8.3 +version: 0.8.4 description: Functions and data types to write discord bots. Official discord docs . . diff --git a/src/Discord.hs b/src/Discord.hs --- a/src/Discord.hs +++ b/src/Discord.hs @@ -7,6 +7,8 @@ , module Discord.Rest.User , module Discord.Rest.Invite , module Discord.Rest.Emoji + , module Discord.Rest.Voice + , module Discord.Rest.Webhook , Cache(..) , Gateway(..) , RestChan(..) @@ -38,6 +40,8 @@ import Discord.Rest.User import Discord.Rest.Invite import Discord.Rest.Emoji +import Discord.Rest.Voice +import Discord.Rest.Webhook import Discord.Types import Discord.Gateway import Discord.Gateway.Cache diff --git a/src/Discord/Rest/Guild.hs b/src/Discord/Rest/Guild.hs --- a/src/Discord/Rest/Guild.hs +++ b/src/Discord/Rest/Guild.hs @@ -9,7 +9,13 @@ ( GuildRequest(..) , CreateGuildChannelOpts(..) , ModifyGuildOpts(..) + , AddGuildMemberOpts(..) + , ModifyGuildMemberOpts(..) , GuildMembersTiming(..) + , CreateGuildBanOpts(..) + , ModifyGuildRoleOpts(..) + , CreateGuildIntegrationOpts(..) + , ModifyGuildIntegrationOpts(..) ) where @@ -54,37 +60,44 @@ -- for the user with the guilds.join scope. Returns the guild 'Member' as the body. -- Fires a Guild Member Add 'Event'. Requires the bot to have the -- CREATE_INSTANT_INVITE permission. - -- todo AddGuildMember :: ToJSON o => GuildId -> UserId -> o - -- -> GuildRequest GuildMember + AddGuildMember :: GuildId -> UserId -> AddGuildMemberOpts + -> GuildRequest () -- | Modify attributes of a guild 'Member'. Fires a Guild Member Update 'Event'. - -- todo ModifyGuildMember :: ToJSON o => GuildId -> UserId -> o - -- -> GuildRequest () + ModifyGuildMember :: GuildId -> UserId -> ModifyGuildMemberOpts -> GuildRequest () + -- | Modify the nickname of the current user + ModifyCurrentUserNick :: GuildId -> T.Text -> GuildRequest () + -- | Add a member to a guild role. Requires 'MANAGE_ROLES' permission. + AddGuildMemberRole :: GuildId -> UserId -> RoleId -> GuildRequest () + -- | Remove a member from a guild role. Requires 'MANAGE_ROLES' permission. + RemoveGuildMemberRole :: GuildId -> UserId -> RoleId -> GuildRequest () -- | Remove a member from a guild. Requires 'KICK_MEMBER' permission. Fires a -- Guild Member Remove 'Event'. RemoveGuildMember :: GuildId -> UserId -> GuildRequest () - -- | Returns a list of 'User' objects that are banned from this guild. Requires the + -- | Returns a list of 'Ban' objects for users that are banned from this guild. Requires the -- 'BAN_MEMBERS' permission - GetGuildBans :: GuildId -> GuildRequest [User] + GetGuildBans :: GuildId -> GuildRequest [Ban] + -- | Returns a 'Ban' object for the user banned from this guild. Requires the + -- 'BAN_MEMBERS' permission + GetGuildBan :: GuildId -> UserId -> GuildRequest Ban -- | Create a guild ban, and optionally Delete previous messages sent by the banned -- user. Requires the 'BAN_MEMBERS' permission. Fires a Guild Ban Add 'Event'. - CreateGuildBan :: GuildId -> UserId -> Integer -> GuildRequest () + CreateGuildBan :: GuildId -> UserId -> CreateGuildBanOpts -> GuildRequest () -- | Remove the ban for a user. Requires the 'BAN_MEMBERS' permissions. -- Fires a Guild Ban Remove 'Event'. RemoveGuildBan :: GuildId -> UserId -> GuildRequest () -- | Returns a list of 'Role' objects for the guild. Requires the 'MANAGE_ROLES' -- permission GetGuildRoles :: GuildId -> GuildRequest [Role] - -- -- | Create a new 'Role' for the guild. Requires the 'MANAGE_ROLES' permission. - -- -- Returns the new role object on success. Fires a Guild Role Create 'Event'. - -- CreateGuildRole :: GuildId -> GuildRequest Role + -- | Create a new 'Role' for the guild. Requires the 'MANAGE_ROLES' permission. + -- Returns the new role object on success. Fires a Guild Role Create 'Event'. + CreateGuildRole :: GuildId -> ModifyGuildRoleOpts -> GuildRequest Role -- | Modify the positions of a set of role objects for the guild. Requires the -- 'MANAGE_ROLES' permission. Returns a list of all of the guild's 'Role' objects -- on success. Fires multiple Guild Role Update 'Event's. - -- todo ModifyGuildRolePositions :: ToJSON o => GuildId -> [o] -> GuildRequest [Role] + ModifyGuildRolePositions :: GuildId -> [(RoleId, Integer)] -> GuildRequest [Role] -- | Modify a guild role. Requires the 'MANAGE_ROLES' permission. Returns the -- updated 'Role' on success. Fires a Guild Role Update 'Event's. - -- todo ModifyGuildRole :: ToJSON o => GuildId -> RoleId -> o - -- -> GuildRequest Role + ModifyGuildRole :: GuildId -> RoleId -> ModifyGuildRoleOpts -> GuildRequest Role -- | Delete a guild role. Requires the 'MANAGE_ROLES' permission. Fires a Guild Role -- Delete 'Event'. DeleteGuildRole :: GuildId -> RoleId -> GuildRequest Role @@ -107,10 +120,11 @@ GetGuildIntegrations :: GuildId -> GuildRequest [Integration] -- | Attach an 'Integration' object from the current user to the guild. Requires the -- 'MANAGE_GUILD' permission. Fires a Guild Integrations Update 'Event'. - -- todo CreateGuildIntegration :: ToJSON o => GuildId -> o -> GuildRequest () + CreateGuildIntegration :: GuildId -> IntegrationId -> CreateGuildIntegrationOpts -> GuildRequest () -- | Modify the behavior and settings of a 'Integration' object for the guild. -- Requires the 'MANAGE_GUILD' permission. Fires a Guild Integrations Update 'Event'. - -- todo ModifyGuildIntegration :: ToJSON o => GuildId -> IntegrationId -> o -> GuildRequest () + ModifyGuildIntegration :: GuildId -> IntegrationId -> ModifyGuildIntegrationOpts + -> GuildRequest () -- | Delete the attached 'Integration' object for the guild. Requires the -- 'MANAGE_GUILD' permission. Fires a Guild Integrations Update 'Event'. DeleteGuildIntegration :: GuildId -> IntegrationId -> GuildRequest () @@ -122,7 +136,87 @@ -- JSON and modified. Requires the 'MANAGE_GUILD' permission. Returns the updated -- 'GuildEmbed' object. ModifyGuildEmbed :: GuildId -> GuildEmbed -> GuildRequest GuildEmbed + -- | Vanity URL + GetGuildVanityURL :: GuildId -> GuildRequest T.Text +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 :: Bool + , modifyGuildRoleOptsMentionable :: 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 <$> Just modifyGuildRoleOptsSeparateSidebar ), + ("mentionable", toJSON <$> Just 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 @@ -134,7 +228,7 @@ , createGuildChannelOptsMaxUsers :: Maybe Integer , createGuildChannelOptsCategoryId :: Maybe ChannelId } | CreateGuildChannelOptsCategory - deriving (Show, Eq) + deriving (Show, Eq, Ord) createChannelOptsToJSON :: T.Text -> [Overwrite] -> CreateGuildChannelOpts -> Value createChannelOptsToJSON name perms opts = object [(key, val) | (key, Just val) <- optsJSON] @@ -202,31 +296,36 @@ (DeleteGuild g) -> "guild " <> show g (GetGuildChannels g) -> "guild_chan " <> show g (CreateGuildChannel g _ _ _) -> "guild_chan " <> show g - (ModifyGuildChannelPositions 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_memb " <> show g - -- (ModifyGuildMember g _ _) -> "guild_memb " <> show g - (RemoveGuildMember g _) -> "guild_memb " <> 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 + (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 + (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 + (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 -- | The base url (Req) for API requests @@ -266,37 +365,49 @@ (ListGuildMembers guild range) -> Get (guilds // guild /: "members") (guildMembersTimingToQuery range) - -- (AddGuildMember guild user patch) -> - -- Put (guilds // guild /: "members" // user) (R.ReqBodyJson patch) mempty + (AddGuildMember guild user patch) -> + Put (guilds // guild /: "members" // user) (R.ReqBodyJson patch) mempty - -- (ModifyGuildMember guild member patch) -> - -- let body = R.ReqBodyJson patch - -- in Patch (guilds // guild /: "members" // member) body 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 - (GetGuildBans guild) -> - Get (guilds // guild /: "bans") mempty + (GetGuildBan guild user) -> Get (guilds // guild /: "bans" // user) mempty - (CreateGuildBan guild user msgs) -> - let body = R.ReqBodyJson (object ["delete-message-days" .= msgs]) - in Put (guilds // guild /: "bans" // user) body 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) -> - -- Post (guilds // guild /: "roles") (pure R.NoReqBody) mempty + (CreateGuildRole guild patch) -> + Post (guilds // guild /: "roles") (pure (R.ReqBodyJson patch)) mempty - -- (ModifyGuildRolePositions guild patch) -> - -- Post (guilds // guild /: "roles") (pure (R.ReqBodyJson patch)) mempty - -- (ModifyGuildRole guild role patch) -> - -- Post (guilds // guild /: "roles" // role) (pure (R.ReqBodyJson patch)) mempty + (ModifyGuildRolePositions guild patch) -> + let body = map (\(role, pos) -> object ["id".=role, "position".=pos]) patch + in Post (guilds // guild /: "roles") (pure (R.ReqBodyJson body)) mempty + (ModifyGuildRole guild role patch) -> + Post (guilds // guild /: "roles" // role) (pure (R.ReqBodyJson patch)) mempty + (DeleteGuildRole guild role) -> Delete (guilds // guild /: "roles" // role) mempty @@ -315,12 +426,13 @@ (GetGuildIntegrations guild) -> Get (guilds // guild /: "integrations") mempty - -- (CreateGuildIntegration guild patch) -> - -- Post (guilds // guild /: "integrations") (pure (R.ReqBodyJson patch)) 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 integ patch) -> - -- let body = R.ReqBodyJson patch - -- in Patch (guilds // guild /: "integrations" // integ) body 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 @@ -334,3 +446,5 @@ (ModifyGuildEmbed guild patch) -> Patch (guilds // guild /: "embed") (R.ReqBodyJson patch) mempty + (GetGuildVanityURL guild) -> + Get (guilds // guild /: "vanity-url") mempty diff --git a/src/Discord/Rest/Prelude.hs b/src/Discord/Rest/Prelude.hs --- a/src/Discord/Rest/Prelude.hs +++ b/src/Discord/Rest/Prelude.hs @@ -24,7 +24,7 @@ where -- | https://discordapp.com/developers/docs/reference#user-agent -- Second place where the library version is noted - agent = "DiscordBot (https://github.com/aquarial/discord-haskell, 0.8.3)" + agent = "DiscordBot (https://github.com/aquarial/discord-haskell, 0.8.4)" -- Append to an URL infixl 5 // diff --git a/src/Discord/Rest/User.hs b/src/Discord/Rest/User.hs --- a/src/Discord/Rest/User.hs +++ b/src/Discord/Rest/User.hs @@ -50,6 +50,8 @@ -- | Create a new DM channel with a user. Returns a DM 'Channel' object. CreateDM :: UserId -> UserRequest Channel + GetUserConnections :: UserRequest [ConnectionObject] + -- | Formatted avatar data https://discordapp.com/developers/docs/resources/user#avatar-data data CurrentUserAvatar = CurrentUserAvatar String @@ -70,6 +72,7 @@ (LeaveGuild g) -> "leave_guild " <> show g (GetUserDMs) -> "get_dms " (CreateDM _) -> "make_dm " + (GetUserConnections) -> "connections " -- | The base url (Req) for API requests baseUrl :: R.Url 'R.Https @@ -98,3 +101,6 @@ (CreateDM user) -> let body = R.ReqBodyJson $ object ["recipient_id" .= user] in Post (users /: "@me" /: "channels") (pure body) mempty + + (GetUserConnections) -> + Get (users /: "@me" /: "connections") mempty diff --git a/src/Discord/Types/Channel.hs b/src/Discord/Types/Channel.hs --- a/src/Discord/Types/Channel.hs +++ b/src/Discord/Types/Channel.hs @@ -4,12 +4,12 @@ -- | Data structures pertaining to Discord Channels module Discord.Types.Channel where -import qualified Data.Text as T - import Data.Aeson import Data.Aeson.Types (Parser) -import Data.Time.Clock +import Data.Default (Default, def) import Data.Monoid ((<>)) +import Data.Text (Text) +import Data.Time.Clock import qualified Data.HashMap.Strict as HM import qualified Data.Vector as V @@ -43,22 +43,49 @@ data Webhook = Webhook { webhookId :: WebhookId - , webhookToken :: T.Text + , webhookToken :: Text + , webhookChannelId :: ChannelId } deriving (Show, Eq, Ord) instance FromJSON Webhook where parseJSON = withObject "Webhook" $ \o -> Webhook <$> o .: "id" <*> o .: "token" + <*> o .: "channel_id" +data ConnectionObject = ConnectionObject + { connectionObjectId :: Text + , connectionObjectName :: Text + , connectionObjectType :: Text + , connectionObjectRevoked :: Bool + , connectionObjectIntegrations :: [IntegrationId] + , connectionObjectVerified :: Bool + , connectionObjectFriendSyncOn :: Bool + , connectionObjectShownInPresenceUpdates :: Bool + , connectionObjectVisibleToOthers :: Bool + } deriving (Show, Eq, Ord) +instance FromJSON ConnectionObject where + parseJSON = withObject "ConnectionObject" $ \o -> do + integrations <- o .: "integrations" + ConnectionObject <$> o .: "id" + <*> o .: "name" + <*> o .: "type" + <*> o .: "revoked" + <*> sequence (map (.: "id") integrations) + <*> o .: "verified" + <*> o .: "friend_sync" + <*> o .: "show_activity" + <*> ( (==) (1::Int) <$> o .: "visibility") + + -- | Guild channels represent an isolated set of users and messages in a Guild (Server) data Channel -- | A text channel in a guild. = ChannelText { channelId :: ChannelId -- ^ The id of the channel (Will be equal to -- the guild if it's the "general" channel). - , channelGuild :: GuildId -- ^ The id of the guild. + , channelGuild :: GuildId -- ^ The id of the guild. , channelName :: String -- ^ The name of the guild (2 - 1000 characters). , channelPosition :: Integer -- ^ The storing position of the channel. , channelPermissions :: [Overwrite] -- ^ An array of permission 'Overwrite's @@ -164,7 +191,7 @@ -- was sent in , messageAuthor :: User -- ^ The 'User' the message was sent -- by - , messageText :: T.Text -- ^ Contents of the message + , messageText :: Text -- ^ Contents of the message , messageTimestamp :: UTCTime -- ^ When the message was sent , messageEdited :: Maybe UTCTime -- ^ When/if the message was edited , messageTts :: Bool -- ^ Whether this message was a TTS @@ -173,7 +200,7 @@ -- everyone , messageMentions :: [User] -- ^ 'User's specifically mentioned in -- the message - , messageMentionRoles :: [RoleId] -- ^ 'Role's specifically mentioned in + , messageMentionRoles :: [RoleId] -- ^ 'Role's specifically mentioned in -- the message , messageAttachments :: [Attachment] -- ^ Any attached files , messageEmbeds :: [Embed] -- ^ Any embedded content @@ -181,7 +208,7 @@ -- was sent , messagePinned :: Bool -- ^ Whether this message is pinned , messageGuild :: Maybe GuildId -- ^ The guild the message went to - } deriving (Show, Eq) + } deriving (Show, Eq, Ord) instance FromJSON Message where parseJSON = withObject "Message" $ \o -> @@ -214,7 +241,7 @@ , attachmentProxy :: String -- ^ Proxied url of file , attachmentHeight :: Maybe Integer -- ^ Height of file (if image) , attachmentWidth :: Maybe Integer -- ^ Width of file (if image) - } deriving (Show, Eq) + } deriving (Show, Eq, Ord) instance FromJSON Attachment where parseJSON = withObject "Attachment" $ \o -> @@ -228,23 +255,34 @@ -- | An embed attached to a message. data Embed = Embed - { embedTitle :: String -- ^ Title of the embed - , embedType :: String -- ^ Type of embed (Always "rich" for webhooks) - , embedDesc :: String -- ^ Description of embed - , embedUrl :: String -- ^ URL of embed - , embedTime :: UTCTime -- ^ The time of the embed content - , embedColor :: Integer -- ^ The embed color - , embedFields :: [SubEmbed] -- ^ Fields of the embed - } deriving (Show, Read, Eq) + { embedTitle :: Maybe String -- ^ Title of the embed + , embedType :: Maybe String -- ^ Type of embed (Always "rich" for webhooks) + , embedDescription :: Maybe String -- ^ Description of embed + , embedUrl :: Maybe String -- ^ URL of embed + , embedTimestamp :: Maybe UTCTime -- ^ The time of the embed content + , embedColor :: Maybe Integer -- ^ The embed color + , embedFields :: [SubEmbed] -- ^ Fields of the embed + } deriving (Show, Eq, Ord) +instance Default Embed where + def = Embed + { embedTitle = Nothing + , embedType = Nothing + , embedDescription = Nothing + , embedUrl = Nothing + , embedTimestamp = Nothing + , embedColor = Nothing + , embedFields = [] + } + instance FromJSON Embed where parseJSON = withObject "Embed" $ \o -> - Embed <$> o .:? "title" .!= "Untitled" - <*> o .: "type" - <*> o .:? "description" .!= "" - <*> o .:? "url" .!= "" - <*> o .:? "timestamp" .!= epochTime - <*> o .:? "color" .!= 0 + Embed <$> o .:? "title" + <*> o .:? "type" + <*> o .:? "description" + <*> o .:? "url" + <*> o .:? "timestamp" + <*> o .:? "color" <*> sequence (HM.foldrWithKey to_embed [] o) where to_embed k (Object v) a = case k of @@ -281,20 +319,20 @@ toJSON (Embed {..}) = object [ "title" .= embedTitle , "type" .= embedType - , "description" .= embedDesc + , "description" .= embedDescription , "url" .= embedUrl - , "timestamp" .= embedTime + , "timestamp" .= embedTimestamp , "color" .= embedColor ] |> makeSubEmbeds embedFields where - (|>) :: Value -> HM.HashMap T.Text Value -> Value + (|>) :: Value -> HM.HashMap Text Value -> Value (|>) (Object o) hm = Object $ HM.union o hm (|>) _ _ = error "Type mismatch" - makeSubEmbeds :: [SubEmbed] -> HM.HashMap T.Text Value + makeSubEmbeds :: [SubEmbed] -> HM.HashMap Text Value makeSubEmbeds = foldr embed HM.empty - embed :: SubEmbed -> HM.HashMap T.Text Value -> HM.HashMap T.Text Value + embed :: SubEmbed -> HM.HashMap Text Value -> HM.HashMap Text Value embed (Thumbnail url _ height width) = HM.alter (\_ -> Just $ object [ "url" .= url @@ -367,4 +405,4 @@ String String Bool - deriving (Show, Read, Eq) + deriving (Show, Eq, Ord) diff --git a/src/Discord/Types/Events.hs b/src/Discord/Types/Events.hs --- a/src/Discord/Types/Events.hs +++ b/src/Discord/Types/Events.hs @@ -54,14 +54,14 @@ -- | VoiceStateUpdate -- | VoiceServerUpdate | UnknownEvent String Object - deriving Show + deriving (Show, Eq) data ReactionInfo = ReactionInfo { reactionUserId :: UserId , reactionChannelId :: ChannelId , reactionMessageId :: MessageId , reactionEmoji :: Emoji - } deriving Show + } deriving (Show, Eq, Ord) instance FromJSON ReactionInfo where parseJSON = withObject "ReactionInfo" $ \o -> @@ -76,7 +76,7 @@ -- , presenceGame :: Maybe Activity , presenceGuildId :: GuildId , presenceStatus :: String - } deriving Show + } deriving (Show, Eq, Ord) instance FromJSON PresenceInfo where parseJSON = withObject "PresenceInfo" $ \o -> @@ -90,7 +90,7 @@ { typingUserId :: UserId , typingChannelId :: ChannelId , typingTimestamp :: UTCTime - } deriving Show + } deriving (Show, Eq, Ord) instance FromJSON TypingInfo where parseJSON = withObject "TypingInfo" $ \o -> diff --git a/src/Discord/Types/Gateway.hs b/src/Discord/Types/Gateway.hs --- a/src/Discord/Types/Gateway.hs +++ b/src/Discord/Types/Gateway.hs @@ -28,7 +28,7 @@ | Hello Int | HeartbeatAck | ParseError String - deriving Show + deriving (Show, Eq) data GatewaySendable = Heartbeat Integer @@ -37,13 +37,13 @@ | RequestGuildMembers RequestGuildMembersOpts | UpdateStatus UpdateStatusOpts | UpdateStatusVoice UpdateStatusVoiceOpts - deriving (Show) + deriving (Show, Eq, Ord) data RequestGuildMembersOpts = RequestGuildMembersOpts { requestGuildMembersGuildId :: GuildId , requestGuildMembersSearchQuery :: T.Text , requestGuildMembersLimit :: Integer } - deriving (Show) + deriving (Show, Eq, Ord) data UpdateStatusVoiceOpts = UpdateStatusVoiceOpts { updateStatusVoiceGuildId :: GuildId @@ -51,7 +51,7 @@ , updateStatusVoiceIsMuted :: Bool , updateStatusVoiceIsDeaf :: Bool } - deriving (Show) + deriving (Show, Eq, Ord) data UpdateStatusOpts = UpdateStatusOpts { updateStatusSince :: Maybe UTCTime @@ -59,27 +59,27 @@ , updateStatusNewStatus :: UpdateStatusType , updateStatusAFK :: Bool } - deriving (Show) + deriving (Show, Eq, Ord) data Activity = Activity { activityName :: T.Text , activityType :: ActivityType , activityUrl :: Maybe T.Text } - deriving (Show) + deriving (Show, Eq, Ord) data ActivityType = ActivityTypeGame | ActivityTypeStreaming | ActivityTypeListening | ActivityTypeWatching - deriving (Enum, Show) + deriving (Show, Eq, Ord, Enum) data UpdateStatusType = UpdateStatusOnline | UpdateStatusDoNotDisturb | UpdateStatusAwayFromKeyboard | UpdateStatusInvisibleOffline | UpdateStatusOffline - deriving (Show) + deriving (Show, Eq, Ord, Enum) statusString :: UpdateStatusType -> T.Text statusString s = case s of diff --git a/src/Discord/Types/Guild.hs b/src/Discord/Types/Guild.hs --- a/src/Discord/Types/Guild.hs +++ b/src/Discord/Types/Guild.hs @@ -165,29 +165,33 @@ <*> o .: "mentionable" -- | VoiceRegion is only refrenced in Guild endpoints, will be moved when voice support is added -data VoiceRegion = - VoiceRegion - { regionId :: Snowflake -- ^ Unique id of the region - , regionName :: T.Text -- ^ Name of the region - , regionHostname :: T.Text -- ^ Example hostname for the region - , regionPort :: Int -- ^ Example port for the region - , regionVip :: Bool -- ^ True if this is a VIP only server - , regionOptimal :: Bool -- ^ True for the closest server to a client - , regionDepreciated :: Bool -- ^ Whether this is a deprecated region - , regionCustom :: Bool -- ^ Whether this is a custom region +data VoiceRegion = VoiceRegion + { voiceRegionId :: T.Text -- ^ Unique id of the region + , voiceRegionName :: T.Text -- ^ Name of the region + , voiceRegionVip :: Bool -- ^ True if this is a VIP only server + , voiceRegionOptimal :: Bool -- ^ True for the closest server to a client + , voiceRegionDepreciated :: Bool -- ^ Whether this is a deprecated region + , voiceRegionCustom :: Bool -- ^ Whether this is a custom region } deriving (Show, Eq, Ord) instance FromJSON VoiceRegion where parseJSON = withObject "VoiceRegion" $ \o -> VoiceRegion <$> o .: "id" <*> o .: "name" - <*> o .: "sample_hostname" - <*> o .: "sample_port" <*> o .: "vip" <*> o .: "optimal" <*> o .: "deprecated" <*> o .: "custom" +-- | Info about a Ban +data Ban = Ban + { banReason :: T.Text + , banUser :: User + } deriving (Show, Eq, Ord) + +instance FromJSON Ban where + parseJSON = withObject "Ban" $ \o -> Ban <$> o .: "reason" <*> o .: "user" + -- | Represents a code to add a user to a guild data Invite = Invite { inviteCode :: T.Text -- ^ The invite code @@ -210,16 +214,15 @@ parseJSON ob = InviteWithMeta <$> parseJSON ob <*> parseJSON ob -- | Additional metadata about an invite. -data InviteMeta = - InviteMeta { - inviteCreator :: User -- ^ The user that created the invite +data InviteMeta = InviteMeta + { inviteCreator :: User -- ^ The user that created the invite , inviteUses :: Integer -- ^ Number of times the invite has been used , inviteMax :: Integer -- ^ Max number of times the invite can be used , inviteAge :: Integer -- ^ The duration (in seconds) after which the invite expires , inviteTemp :: Bool -- ^ Whether this invite only grants temporary membership , inviteCreated :: UTCTime -- ^ When the invite was created , inviteRevoked :: Bool -- ^ If the invite is revoked - } + } deriving (Show, Eq, Ord) instance FromJSON InviteMeta where parseJSON = withObject "InviteMeta" $ \o -> @@ -232,8 +235,7 @@ <*> o .: "revoked" -- | Represents the behavior of a third party account link. -data Integration = - Integration +data Integration = Integration { integrationId :: !Snowflake -- ^ Integration id , integrationName :: T.Text -- ^ Integration name , integrationType :: T.Text -- ^ Integration type (Twitch, Youtube, ect.) @@ -262,26 +264,24 @@ <*> o .: "synced_at" -- | Represents a third party account link. -data IntegrationAccount = - Account +data IntegrationAccount = IntegrationAccount { accountId :: T.Text -- ^ The id of the account. , accountName :: T.Text -- ^ The name of the account. } deriving (Show, Eq, Ord) instance FromJSON IntegrationAccount where - parseJSON = withObject "Account" $ \o -> - Account <$> o .: "id" <*> o .: "name" + parseJSON = withObject "IntegrationAccount" $ \o -> + IntegrationAccount <$> o .: "id" <*> o .: "name" -- | Represents an image to be used in third party sites to link to a discord channel -data GuildEmbed = - GuildEmbed +data GuildEmbed = GuildEmbed { embedEnabled :: Bool -- ^ Whether the embed is enabled , embedChannel :: ChannelId -- ^ The embed channel id - } + } deriving (Show, Eq, Ord) instance FromJSON GuildEmbed where - parseJSON = withObject "GuildEmbed" $ \o -> GuildEmbed <$> o .: "enabled" - <*> o .: "snowflake" + parseJSON = withObject "GuildEmbed" $ \o -> + GuildEmbed <$> o .: "enabled" <*> o .: "snowflake" instance ToJSON GuildEmbed where toJSON (GuildEmbed enabled snowflake) = object