discord-haskell 0.8.3 → 0.8.4
raw patch · 11 files changed
+286/−118 lines, 11 files
Files
- README.md +1/−1
- changelog.md +6/−0
- discord-haskell.cabal +1/−1
- src/Discord.hs +4/−0
- src/Discord/Rest/Guild.hs +161/−47
- src/Discord/Rest/Prelude.hs +1/−1
- src/Discord/Rest/User.hs +6/−0
- src/Discord/Types/Channel.hs +67/−29
- src/Discord/Types/Events.hs +4/−4
- src/Discord/Types/Gateway.hs +8/−8
- src/Discord/Types/Guild.hs +27/−27
README.md view
@@ -23,7 +23,7 @@ Client ID and Permissions come from previous steps. `https://discordapp.com/oauth2/authorize?client_id=<CLIENT_ID>&scope=bot&permissions=<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.
changelog.md view
@@ -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`
discord-haskell.cabal view
@@ -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 <https://discordapp.com/developers/docs/reference>. .
src/Discord.hs view
@@ -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
src/Discord/Rest/Guild.hs view
@@ -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
src/Discord/Rest/Prelude.hs view
@@ -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 //
src/Discord/Rest/User.hs view
@@ -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
src/Discord/Types/Channel.hs view
@@ -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)
src/Discord/Types/Events.hs view
@@ -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 ->
src/Discord/Types/Gateway.hs view
@@ -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
src/Discord/Types/Guild.hs view
@@ -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