discord-haskell 0.6.0 → 0.7.0
raw patch · 11 files changed
+233/−169 lines, 11 filesdep ~aesondep ~asyncdep ~req
Dependency ranges changed: aeson, async, req
Files
- discord-haskell.cabal +4/−4
- src/Discord/Gateway/Cache.hs +1/−1
- src/Discord/Rest/Channel.hs +66/−54
- src/Discord/Rest/Emoji.hs +13/−14
- src/Discord/Rest/Guild.hs +91/−49
- src/Discord/Rest/HTTP.hs +9/−7
- src/Discord/Rest/Prelude.hs +1/−1
- src/Discord/Rest/User.hs +3/−3
- src/Discord/Types/Channel.hs +32/−32
- src/Discord/Types/Events.hs +2/−2
- src/Discord/Types/Prelude.hs +11/−2
discord-haskell.cabal view
@@ -1,6 +1,6 @@ name: discord-haskell -- library version is also noted at src/Discord/Rest/Prelude.hs-version: 0.6.0+version: 0.7.0 synopsis: Write bots for Discord in Haskell description: Functions and data types to write discord bots. Official discord docs <https://discordapp.com/developers/docs/reference>.@@ -43,8 +43,8 @@ , Discord.Types.Guild build-depends: base >=4 && <5- , aeson >=1.2.4.0 && <1.3- , async >=2.1.1.1 && <2.2+ , aeson >=1.3.1.1 && < 1.4+ , async >=2.2.1 && <2.3 , bytestring >=0.10.8.2 && <0.11 , base64-bytestring >= 1.0.0.1 && <1.1 , containers >=0.5.10.2 && <0.6@@ -52,7 +52,7 @@ , http-client >=0.5.12.1 && <0.6 , iso8601-time >=0.1.4 && <0.2 , MonadRandom >=0.5.1 && <0.6- , req >=1.0.0 && <1.1+ , req >=1.1.0 && <1.2 , JuicyPixels >= 3.2.9.0 && < 3.3 , safe-exceptions >=0.1.7.0 && <0.2 , text >=1.2.3.0 && <1.3
src/Discord/Gateway/Cache.hs view
@@ -76,6 +76,6 @@ _ -> minfo setChanGuildID :: Snowflake -> Channel -> Channel-setChanGuildID s c = if isGuildChannel c+setChanGuildID s c = if channelIsInGuild c then c { channelGuild = s } else c
src/Discord/Rest/Channel.hs view
@@ -9,6 +9,7 @@ ( ChannelRequest(..) , ReactionTiming(..) , MessageTiming(..)+ , ChannelInviteOpts(..) , ModifyChannelOpts(..) , ChannelPermissionsOpts(..) , GroupDMAddRecipientOpts(..)@@ -35,65 +36,63 @@ -- | Data constructor for requests. See <https://discordapp.com/developers/docs/resources/ API> data ChannelRequest a where -- | Gets a channel by its id.- GetChannel :: Snowflake -> ChannelRequest Channel+ GetChannel :: ChannelId -> ChannelRequest Channel -- | Edits channels options.- ModifyChannel :: Snowflake -> ModifyChannelOpts -> ChannelRequest Channel+ ModifyChannel :: ChannelId -> ModifyChannelOpts -> ChannelRequest Channel -- | Deletes a channel if its id doesn't equal to the id of guild.- DeleteChannel :: Snowflake -> ChannelRequest Channel+ DeleteChannel :: ChannelId -> ChannelRequest Channel -- | Gets a messages from a channel with limit of 100 per request.- GetChannelMessages :: Snowflake -> (Int, MessageTiming) -> ChannelRequest [Message]+ GetChannelMessages :: ChannelId -> (Int, MessageTiming) -> ChannelRequest [Message] -- | Gets a message in a channel by its id.- GetChannelMessage :: (Snowflake, Snowflake) -> ChannelRequest Message+ GetChannelMessage :: (ChannelId, MessageId) -> ChannelRequest Message -- | Sends a message to a channel.- CreateMessage :: Snowflake -> T.Text -> Maybe Embed -> ChannelRequest Message+ CreateMessage :: ChannelId -> T.Text -> ChannelRequest Message+ -- | Sends a message with an Embed to a channel.+ CreateMessageEmbed :: ChannelId -> T.Text -> Embed -> ChannelRequest Message -- | Sends a message with a file to a channel.- UploadFile :: Snowflake -> FilePath -> BL.ByteString -> ChannelRequest Message+ CreateMessageUploadFile :: ChannelId -> T.Text -> BL.ByteString -> ChannelRequest Message -- | Add an emoji reaction to a message. ID must be present for custom emoji- CreateReaction :: (Snowflake, Snowflake) -> (T.Text, Maybe Snowflake)- -> ChannelRequest ()+ CreateReaction :: (ChannelId, MessageId) -> T.Text -> ChannelRequest () -- | Remove a Reaction this bot added- DeleteOwnReaction :: (Snowflake, Snowflake) -> (T.Text, Maybe Snowflake)- -> ChannelRequest ()+ DeleteOwnReaction :: (ChannelId, MessageId) -> T.Text -> ChannelRequest () -- | Remove a Reaction someone else added- DeleteUserReaction :: (Snowflake, Snowflake) -> (T.Text, Maybe Snowflake)- -> Snowflake -> ChannelRequest ()+ DeleteUserReaction :: (ChannelId, MessageId) -> UserId -> T.Text -> ChannelRequest () -- | List of users that reacted with this emoji- GetReactions :: (Snowflake, Snowflake) -> (T.Text, Maybe Snowflake)- -> (Int, ReactionTiming) -> ChannelRequest ()+ GetReactions :: (ChannelId, MessageId) -> T.Text -> (Int, ReactionTiming) -> ChannelRequest () -- | Delete all reactions on a message- DeleteAllReactions :: (Snowflake, Snowflake) -> ChannelRequest ()+ DeleteAllReactions :: (ChannelId, MessageId) -> ChannelRequest () -- | Edits a message content.- EditMessage :: (Snowflake, Snowflake) -> T.Text -> Maybe Embed+ EditMessage :: (ChannelId, MessageId) -> T.Text -> Maybe Embed -> ChannelRequest Message -- | Deletes a message.- DeleteMessage :: (Snowflake, Snowflake) -> ChannelRequest ()+ DeleteMessage :: (ChannelId, MessageId) -> ChannelRequest () -- | Deletes a group of messages.- BulkDeleteMessage :: (Snowflake, [Snowflake]) -> ChannelRequest ()+ BulkDeleteMessage :: (ChannelId, [MessageId]) -> ChannelRequest () -- | Edits a permission overrides for a channel.- EditChannelPermissions :: Snowflake -> Snowflake -> ChannelPermissionsOpts -> ChannelRequest ()+ EditChannelPermissions :: ChannelId -> OverwriteId -> ChannelPermissionsOpts -> ChannelRequest () -- | Gets all instant invites to a channel.- GetChannelInvites :: Snowflake -> ChannelRequest Object+ GetChannelInvites :: ChannelId -> ChannelRequest Object -- | Creates an instant invite to a channel.- CreateChannelInvite :: Snowflake -> ChannelInviteOpts -> ChannelRequest Invite+ CreateChannelInvite :: ChannelId -> ChannelInviteOpts -> ChannelRequest Invite -- | Deletes a permission override from a channel.- DeleteChannelPermission :: Snowflake -> Snowflake -> ChannelRequest ()+ DeleteChannelPermission :: ChannelId -> OverwriteId -> ChannelRequest () -- | Sends a typing indicator a channel which lasts 10 seconds.- TriggerTypingIndicator :: Snowflake -> ChannelRequest ()+ TriggerTypingIndicator :: ChannelId -> ChannelRequest () -- | Gets all pinned messages of a channel.- GetPinnedMessages :: Snowflake -> ChannelRequest [Message]+ GetPinnedMessages :: ChannelId -> ChannelRequest [Message] -- | Pins a message.- AddPinnedMessage :: (Snowflake, Snowflake) -> ChannelRequest ()+ AddPinnedMessage :: (ChannelId, MessageId) -> ChannelRequest () -- | Unpins a message.- DeletePinnedMessage :: (Snowflake, Snowflake) -> ChannelRequest ()+ DeletePinnedMessage :: (ChannelId, MessageId) -> ChannelRequest () -- | Adds a recipient to a Group DM using their access token- GroupDMAddRecipient :: Snowflake -> GroupDMAddRecipientOpts -> ChannelRequest ()+ GroupDMAddRecipient :: ChannelId -> GroupDMAddRecipientOpts -> ChannelRequest () -- | Removes a recipient from a Group DM- GroupDMRemoveRecipient :: Snowflake -> Snowflake -> ChannelRequest ()+ GroupDMRemoveRecipient :: ChannelId -> UserId -> ChannelRequest () -- | Data constructor for GetReaction requests-data ReactionTiming = BeforeReaction Snowflake- | AfterReaction Snowflake+data ReactionTiming = BeforeReaction MessageId+ | AfterReaction MessageId reactionTimingToQuery :: ReactionTiming -> R.Option 'R.Https reactionTimingToQuery t = case t of@@ -101,15 +100,17 @@ (AfterReaction snow) -> "after" R.=: show snow -- | Data constructor for GetChannelMessages requests. See <https://discordapp.com/developers/docs/resources/channel#get-channel-messages>-data MessageTiming = AroundMessage Snowflake- | BeforeMessage Snowflake- | AfterMessage Snowflake+data MessageTiming = AroundMessage MessageId+ | BeforeMessage MessageId+ | AfterMessage MessageId+ | LatestMessages messageTimingToQuery :: MessageTiming -> R.Option 'R.Https messageTimingToQuery t = case t of (AroundMessage snow) -> "around" R.=: show snow (BeforeMessage snow) -> "before" R.=: show snow (AfterMessage snow) -> "after" R.=: show snow+ (LatestMessages) -> mempty data ChannelInviteOpts = ChannelInviteOpts { channelInviteOptsMaxAgeSeconds :: Maybe Integer@@ -133,7 +134,7 @@ , modifyChannelBitrate :: Maybe Integer , modifyChannelUserRateLimit :: Maybe Integer , modifyChannelPermissionOverwrites :: Maybe [Overwrite]- , modifyChannelParentId :: Maybe Snowflake+ , modifyChannelParentId :: Maybe ChannelId } instance ToJSON ModifyChannelOpts where@@ -166,7 +167,7 @@ -- | https://discordapp.com/developers/docs/resources/channel#group-dm-add-recipient data GroupDMAddRecipientOpts = GroupDMAddRecipientOpts- { groupDMAddRecipientUserToAdd :: Snowflake+ { groupDMAddRecipientUserToAdd :: UserId , groupDMAddRecipientUserToAddNickName :: T.Text , groupDMAddRecipientGDMJoinAccessToken :: T.Text }@@ -178,8 +179,9 @@ (DeleteChannel chan) -> "mod_chan " <> show chan (GetChannelMessages chan _) -> "msg " <> show chan (GetChannelMessage (chan, _)) -> "get_msg " <> show chan- (CreateMessage chan _ _) -> "msg " <> show chan- (UploadFile chan _ _) -> "msg " <> show chan+ (CreateMessage chan _) -> "msg " <> show chan+ (CreateMessageEmbed chan _ _) -> "msg " <> show chan+ (CreateMessageUploadFile chan _ _) -> "msg " <> show chan (CreateReaction (chan, _) _) -> "react " <> show chan (DeleteOwnReaction (chan, _) _) -> "react " <> show chan (DeleteUserReaction (chan, _) _ _) -> "react " <> show chan@@ -199,6 +201,11 @@ (GroupDMAddRecipient chan _) -> "groupdm " <> show chan (GroupDMRemoveRecipient chan _) -> "groupdm " <> show chan +cleanupEmoji :: T.Text -> T.Text+cleanupEmoji emoji =+ let noAngles = T.replace "<" "" (T.replace ">" "" emoji)+ in case T.stripPrefix ":" noAngles of Just a -> "custom:" <> a+ Nothing -> noAngles maybeEmbed :: Maybe Embed -> [(T.Text, Value)] maybeEmbed = maybe [] $ \embed -> ["embed" .= embed]@@ -230,34 +237,39 @@ (GetChannelMessage (chan, msg)) -> Get (channels // chan /: "messages" // msg) mempty - (CreateMessage chan msg embed) ->- let content = ["content" .= msg] <> maybeEmbed embed+ (CreateMessage chan msg) ->+ let content = ["content" .= msg] body = pure $ R.ReqBodyJson $ object content in Post (channels // chan /: "messages") body mempty - (UploadFile chan fileName file) ->- let part = partFileRequestBody "file" fileName $ RequestBodyLBS file+ (CreateMessageEmbed chan msg embed) ->+ let content = ["content" .= msg] <> maybeEmbed (Just embed)+ body = pure $ R.ReqBodyJson $ object content+ in Post (channels // chan /: "messages") body mempty++ (CreateMessageUploadFile chan fileName file) ->+ let part = partFileRequestBody "file" (T.unpack fileName) $ RequestBodyLBS file body = R.reqBodyMultipart [part] in Post (channels // chan /: "messages") body mempty - (CreateReaction (chan, msgid) (name, rID)) ->- let emoji = "" <> name <> maybe "" ((<>) ":" . T.pack . show) rID- in Put (channels // chan /: "messages" // msgid /: "reactions" /: emoji /: "@me" )+ (CreateReaction (chan, msgid) emoji) ->+ let e = cleanupEmoji emoji+ in Put (channels // chan /: "messages" // msgid /: "reactions" /: e /: "@me" ) R.NoReqBody mempty - (DeleteOwnReaction (chan, msgid) (name, rID)) ->- let emoji = "" <> name <> maybe "" ((<>) ":" . T.pack . show) rID- in Delete (channels // chan /: "messages" // msgid /: "reactions" /: emoji /: "@me" ) mempty+ (DeleteOwnReaction (chan, msgid) emoji) ->+ let e = cleanupEmoji emoji+ in Delete (channels // chan /: "messages" // msgid /: "reactions" /: e /: "@me" ) mempty - (DeleteUserReaction (chan, msgid) (name, rID) uID) ->- let emoji = "" <> name <> maybe "" ((<>) ":" . T.pack . show) rID- in Delete (channels // chan /: "messages" // msgid /: "reactions" /: emoji // uID ) mempty+ (DeleteUserReaction (chan, msgid) uID emoji) ->+ let e = cleanupEmoji emoji+ in Delete (channels // chan /: "messages" // msgid /: "reactions" /: e // uID ) mempty - (GetReactions (chan, msgid) (name, rID) (n, timing)) ->- let emoji = "" <> name <> maybe "" ((<>) ":" . T.pack . show) rID+ (GetReactions (chan, msgid) emoji (n, timing)) ->+ let e = cleanupEmoji emoji n' = if n < 1 then 1 else (if n > 100 then 100 else n) options = "limit" R.=: n' <> reactionTimingToQuery timing- in Get (channels // chan /: "messages" // msgid /: "reactions" /: emoji ) options+ in Get (channels // chan /: "messages" // msgid /: "reactions" /: e) options (DeleteAllReactions (chan, msgid)) -> Delete (channels // chan /: "messages" // msgid /: "reactions" ) mempty
src/Discord/Rest/Emoji.hs view
@@ -9,7 +9,6 @@ module Discord.Rest.Emoji ( EmojiRequest(..) , ModifyGuildEmojiOpts(..)- , EmojiImage , parseEmojiImage ) where @@ -33,19 +32,19 @@ -- | Data constructor for requests. See <https://discordapp.com/developers/docs/resources/ API> data EmojiRequest a where -- | List of emoji objects for the given guild. Requires MANAGE_EMOJIS permission.- ListGuildEmojis :: Snowflake -> EmojiRequest [Emoji]+ ListGuildEmojis :: GuildId -> EmojiRequest [Emoji] -- | Emoji object for the given guild and emoji ID- GetGuildEmoji :: Snowflake -> Snowflake -> EmojiRequest Emoji+ GetGuildEmoji :: GuildId -> EmojiId -> EmojiRequest Emoji -- | Create a new guild emoji (static&animated). Requires MANAGE_EMOJIS permission.- CreateGuildEmoji :: Snowflake -> T.Text -> EmojiImage -> EmojiRequest Emoji+ CreateGuildEmoji :: GuildId -> T.Text -> EmojiImageParsed -> EmojiRequest Emoji -- | Requires MANAGE_EMOJIS permission- ModifyGuildEmoji :: Snowflake -> Snowflake -> ModifyGuildEmojiOpts -> EmojiRequest Emoji+ ModifyGuildEmoji :: GuildId -> EmojiId -> ModifyGuildEmojiOpts -> EmojiRequest Emoji -- | Requires MANAGE_EMOJIS permission- DeleteGuildEmoji :: Snowflake -> Snowflake -> EmojiRequest ()+ DeleteGuildEmoji :: GuildId -> EmojiId -> EmojiRequest () data ModifyGuildEmojiOpts = ModifyGuildEmojiOpts { modifyGuildEmojiName :: T.Text- , modifyGuildEmojiRoles :: [Snowflake]+ , modifyGuildEmojiRoles :: [RoleId] } instance ToJSON ModifyGuildEmojiOpts where@@ -53,9 +52,9 @@ object [ "name" .= name, "roles" .= roles ] -data EmojiImage = EmojiImage [Char]+data EmojiImageParsed = EmojiImageParsed String -parseEmojiImage :: Q.ByteString -> Either String EmojiImage+parseEmojiImage :: Q.ByteString -> Either String EmojiImageParsed parseEmojiImage bs = if Q.length bs > 256000 then Left "Cannot create emoji - File is larger than 256kb"@@ -63,12 +62,12 @@ (Left e1, Left e2) -> Left ("Could not parse image or gif: " <> e1 <> " and " <> e2) (Right ims, _) -> if all is128 ims- then Right (EmojiImage ("data:text/plain;"- <> "base64,"- <> Q.unpack (B64.encode bs)))+ then Right (EmojiImageParsed ("data:text/plain;"+ <> "base64,"+ <> Q.unpack (B64.encode bs))) else Left ("The frames are not all 128x128") (_, Right im) -> if is128 im- then Right (EmojiImage ("data:text/plain;"+ then Right (EmojiImageParsed ("data:text/plain;" <> "base64," <> Q.unpack (B64.encode bs))) else Left ("Image is not 128x128")@@ -97,7 +96,7 @@ emojiJsonRequest c = case c of (ListGuildEmojis g) -> Get (guilds // g) mempty (GetGuildEmoji g e) -> Get (guilds // g /: "emojis" // e) mempty- (CreateGuildEmoji g name (EmojiImage im)) ->+ (CreateGuildEmoji g name (EmojiImageParsed im)) -> Post (guilds // g /: "emojis") (pure (R.ReqBodyJson (object [ "name" .= name , "image" .= im
src/Discord/Rest/Guild.hs view
@@ -7,6 +7,7 @@ -- | Provides actions for Channel API interactions module Discord.Rest.Guild ( GuildRequest(..)+ , CreateGuildChannelOpts(..) , ModifyGuildOpts(..) , GuildMembersTiming(..) ) where@@ -29,110 +30,148 @@ data GuildRequest a where -- todo CreateGuild :: So many parameters -- | Returns the new 'Guild' object for the given id- GetGuild :: Snowflake -> GuildRequest Guild+ GetGuild :: GuildId -> GuildRequest Guild -- | Modify a guild's settings. Returns the updated 'Guild' object on success. Fires a -- Guild Update 'Event'.- ModifyGuild :: Snowflake -> ModifyGuildOpts -> GuildRequest Guild+ ModifyGuild :: GuildId -> ModifyGuildOpts -> GuildRequest Guild -- | Delete a guild permanently. User must be owner. Fires a Guild Delete 'Event'.- DeleteGuild :: Snowflake -> GuildRequest Guild+ DeleteGuild :: GuildId -> GuildRequest Guild -- | Returns a list of guild 'Channel' objects- GetGuildChannels :: Snowflake -> GuildRequest [Channel]+ GetGuildChannels :: GuildId -> GuildRequest [Channel] -- | Create a new 'Channel' object for the guild. Requires 'MANAGE_CHANNELS' -- permission. Returns the new 'Channel' object on success. Fires a Channel Create -- 'Event'- -- todo CreateGuildChannel :: ToJSON o => Snowflake -> o -> GuildRequest Channel+ CreateGuildChannel :: GuildId -> T.Text -> [Overwrite] -> CreateGuildChannelOpts -> GuildRequest Channel -- | Modify the positions of a set of channel objects for the guild. Requires -- 'MANAGE_CHANNELS' permission. Returns a list of all of the guild's 'Channel' -- objects on success. Fires multiple Channel Update 'Event's.- -- todo ModifyChanPosition :: ToJSON o => Snowflake -> o -> GuildRequest [Channel]+ ModifyGuildChannelPositions :: GuildId -> [(ChannelId,Int)] -> GuildRequest [Channel] -- | Returns a guild 'Member' object for the specified user- GetGuildMember :: Snowflake -> Snowflake -> GuildRequest GuildMember+ GetGuildMember :: GuildId -> UserId -> GuildRequest GuildMember -- | Returns a list of guild 'Member' objects that are members of the guild.- ListGuildMembers :: Snowflake -> GuildMembersTiming -> GuildRequest [GuildMember]+ ListGuildMembers :: GuildId -> GuildMembersTiming -> GuildRequest [GuildMember] -- | Adds a user to the guild, provided you have a valid oauth2 access token -- 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 => Snowflake -> Snowflake -> o+ -- todo AddGuildMember :: ToJSON o => GuildId -> UserId -> o -- -> GuildRequest GuildMember -- | Modify attributes of a guild 'Member'. Fires a Guild Member Update 'Event'.- -- todo ModifyGuildMember :: ToJSON o => Snowflake -> Snowflake -> o+ -- todo ModifyGuildMember :: ToJSON o => GuildId -> UserId -> o -- -> GuildRequest () -- | Remove a member from a guild. Requires 'KICK_MEMBER' permission. Fires a -- Guild Member Remove 'Event'.- RemoveGuildMember :: Snowflake -> Snowflake -> GuildRequest ()+ RemoveGuildMember :: GuildId -> UserId -> GuildRequest () -- | Returns a list of 'User' objects that are banned from this guild. Requires the -- 'BAN_MEMBERS' permission- GetGuildBans :: Snowflake -> GuildRequest [User]+ GetGuildBans :: GuildId -> GuildRequest [User] -- | 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 :: Snowflake -> Snowflake -> Integer -> GuildRequest ()+ CreateGuildBan :: GuildId -> UserId -> Integer -> GuildRequest () -- | Remove the ban for a user. Requires the 'BAN_MEMBERS' permissions. -- Fires a Guild Ban Remove 'Event'.- RemoveGuildBan :: Snowflake -> Snowflake -> GuildRequest ()+ RemoveGuildBan :: GuildId -> UserId -> GuildRequest () -- | Returns a list of 'Role' objects for the guild. Requires the 'MANAGE_ROLES' -- permission- GetGuildRoles :: Snowflake -> 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 :: Snowflake -> GuildRequest Role+ 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 -- | 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 => Snowflake -> [o] -> GuildRequest [Role]+ -- todo ModifyGuildRolePositions :: ToJSON o => GuildId -> [o] -> 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 => Snowflake -> Snowflake -> o+ -- todo ModifyGuildRole :: ToJSON o => GuildId -> RoleId -> o -- -> GuildRequest Role -- | Delete a guild role. Requires the 'MANAGE_ROLES' permission. Fires a Guild Role -- Delete 'Event'.- DeleteGuildRole :: Snowflake -> Snowflake -> GuildRequest Role+ DeleteGuildRole :: GuildId -> RoleId -> GuildRequest Role -- | Returns an object with one 'pruned' key indicating the number of members -- that would be removed in a prune operation. Requires the 'KICK_MEMBERS' -- permission.- GetGuildPruneCount :: Snowflake -> Integer -> GuildRequest Object+ GetGuildPruneCount :: GuildId -> Integer -> GuildRequest Object -- | Begin a prune operation. Requires the 'KICK_MEMBERS' permission. Returns an -- object with one 'pruned' key indicating the number of members that were removed -- in the prune operation. Fires multiple Guild Member Remove 'Events'.- BeginGuildPrune :: Snowflake -> Integer -> GuildRequest Object+ BeginGuildPrune :: GuildId -> Integer -> GuildRequest Object -- | Returns a list of 'VoiceRegion' objects for the guild. Unlike the similar /voice -- route, this returns VIP servers when the guild is VIP-enabled.- GetGuildVoiceRegions :: Snowflake -> GuildRequest [VoiceRegion]+ GetGuildVoiceRegions :: GuildId -> GuildRequest [VoiceRegion] -- | Returns a list of 'Invite' objects for the guild. Requires the 'MANAGE_GUILD' -- permission.- GetGuildInvites :: Snowflake -> GuildRequest [Invite]+ GetGuildInvites :: GuildId -> GuildRequest [Invite] -- | Return a list of 'Integration' objects for the guild. Requires the 'MANAGE_GUILD' -- permission.- GetGuildIntegrations :: Snowflake -> GuildRequest [Integration]+ 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 => Snowflake -> o -> GuildRequest ()+ -- todo CreateGuildIntegration :: ToJSON o => GuildId -> o -> 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 => Snowflake -> Snowflake -> o -> GuildRequest ()+ -- todo ModifyGuildIntegration :: ToJSON o => GuildId -> IntegrationId -> o -> GuildRequest () -- | Delete the attached 'Integration' object for the guild. Requires the -- 'MANAGE_GUILD' permission. Fires a Guild Integrations Update 'Event'.- DeleteGuildIntegration :: Snowflake -> Snowflake -> GuildRequest ()+ DeleteGuildIntegration :: GuildId -> IntegrationId -> GuildRequest () -- | Sync an 'Integration'. Requires the 'MANAGE_GUILD' permission.- SyncGuildIntegration :: Snowflake -> Snowflake -> GuildRequest ()+ SyncGuildIntegration :: GuildId -> IntegrationId -> GuildRequest () -- | Returns the 'GuildEmbed' object. Requires the 'MANAGE_GUILD' permission.- GetGuildEmbed :: Snowflake -> GuildRequest GuildEmbed+ GetGuildEmbed :: GuildId -> GuildRequest GuildEmbed -- | Modify a 'GuildEmbed' object for the guild. All attributes may be passed in with -- JSON and modified. Requires the 'MANAGE_GUILD' permission. Returns the updated -- 'GuildEmbed' object.- ModifyGuildEmbed :: Snowflake -> GuildEmbed -> 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)]++ -- | https://discordapp.com/developers/docs/resources/guild#modify-guild data ModifyGuildOpts = ModifyGuildOpts- { modifyGuildOptsName :: Maybe T.Text- , modifyGuildOptsAFKChannelId :: Maybe Snowflake- , modifyGuildOptsIcon :: Maybe T.Text- , modifyGuildOptsOwnerId :: Maybe Snowflake+ { modifyGuildOptsName :: Maybe T.Text+ , modifyGuildOptsAFKChannelId :: Maybe ChannelId+ , modifyGuildOptsIcon :: Maybe T.Text+ , modifyGuildOptsOwnerId :: Maybe UserId -- Region -- VerificationLevel -- DefaultMessageNotification -- ExplicitContentFilter- }+ } deriving (Show, Eq, Ord) instance ToJSON ModifyGuildOpts where toJSON ModifyGuildOpts{..} = object [(name, val) | (name, Just val) <-@@ -143,7 +182,7 @@ data GuildMembersTiming = GuildMembersTiming { guildMembersTimingLimit :: Maybe Int- , guildMembersTimingAfter :: Maybe Snowflake+ , guildMembersTimingAfter :: Maybe UserId } guildMembersTimingToQuery :: GuildMembersTiming -> R.Option 'R.Https@@ -162,8 +201,8 @@ (ModifyGuild g _) -> "guild " <> show g (DeleteGuild g) -> "guild " <> show g (GetGuildChannels g) -> "guild_chan " <> show g- -- (CreateGuildChannel g _) -> "guild_chan " <> show g- -- (ModifyChanPosition 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_memb " <> show g@@ -172,13 +211,13 @@ (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+ (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+ (BeginGuildPrune g _) -> "guild_prune " <> show g (GetGuildVoiceRegions g) -> "guild_voice " <> show g (GetGuildInvites g) -> "guild_invit " <> show g (GetGuildIntegrations g) -> "guild_integ " <> show g@@ -212,11 +251,14 @@ (GetGuildChannels guild) -> Get (guilds // guild /: "channels") mempty - -- (CreateGuildChannel guild patch) ->- -- Post (guilds // guild /: "channels") (pure (R.ReqBodyJson patch)) mempty+ (CreateGuildChannel guild name perms patch) ->+ Post (guilds // guild /: "channels")+ (pure (R.ReqBodyJson (createChannelOptsToJSON name perms patch))) mempty - -- (ModifyChanPosition guild patch) ->- -- Post (guilds // guild /: "channels") (pure (R.ReqBodyJson 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@@ -247,8 +289,8 @@ (GetGuildRoles guild) -> Get (guilds // guild /: "roles") mempty - (CreateGuildRole guild) ->- Post (guilds // guild /: "roles") (pure R.NoReqBody) mempty+ -- (CreateGuildRole guild) ->+ -- Post (guilds // guild /: "roles") (pure R.NoReqBody) mempty -- (ModifyGuildRolePositions guild patch) -> -- Post (guilds // guild /: "roles") (pure (R.ReqBodyJson patch)) mempty
src/Discord/Rest/HTTP.hs view
@@ -30,7 +30,7 @@ import Discord.Types import Discord.Rest.Prelude -data RestCallException = RestCallErrorCode Int Q.ByteString+data RestCallException = RestCallErrorCode Int Q.ByteString Q.ByteString | RestCallNoParse String QL.ByteString | RestCallHttpException R.HttpException deriving (Show)@@ -59,7 +59,8 @@ -- decode "[]" == () for expected empty calls ResponseByteString "" -> putMVar thread (Right "[]") ResponseByteString bs -> putMVar thread (Right bs)- ResponseErrorCode e s -> putMVar thread (Left (RestCallErrorCode e s))+ ResponseErrorCode e s b ->+ putMVar thread (Left (RestCallErrorCode e s b)) ResponseTryAgain -> writeChan urls (route, request, thread) case retry of GlobalWait i -> do@@ -81,7 +82,7 @@ data RequestResponse = ResponseTryAgain | ResponseByteString QL.ByteString- | ResponseErrorCode Int Q.ByteString+ | ResponseErrorCode Int Q.ByteString Q.ByteString deriving (Show) data Timeout = GlobalWait POSIXTime@@ -92,7 +93,8 @@ tryRequest action log = do resp <- action next10 <- liftIO (round . (+10) <$> getPOSIXTime)- let code = R.responseStatusCode resp+ let body = R.responseBody resp+ code = R.responseStatusCode resp status = R.responseStatusMessage resp remain = fromMaybe 1 $ readMaybeBS =<< R.responseHeader resp "X-Ratelimit-Remaining" global = fromMaybe False $ readMaybeBS =<< R.responseHeader resp "X-RateLimit-Global"@@ -103,11 +105,11 @@ pure (ResponseTryAgain, if global then GlobalWait reset else PathWait reset) | code `elem` [500,502] -> pure (ResponseTryAgain, NoLimit)- | inRange (200,299) code -> pure ( ResponseByteString (R.responseBody resp)+ | inRange (200,299) code -> pure ( ResponseByteString body , if remain > 0 then NoLimit else PathWait reset )- | inRange (400,499) code -> pure (ResponseErrorCode code status+ | inRange (400,499) code -> pure (ResponseErrorCode code status (QL.toStrict body) , if remain > 0 then NoLimit else PathWait reset )- | otherwise -> pure (ResponseErrorCode code status, NoLimit)+ | otherwise -> pure (ResponseErrorCode code status (QL.toStrict body), NoLimit) readMaybeBS :: Read a => Q.ByteString -> Maybe a readMaybeBS = readMaybe . Q.unpack
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.6.0)"+ agent = "DiscordBot (https://github.com/aquarial/discord-haskell, 0.7.0)" -- Append to an URL infixl 5 //
src/Discord/Rest/User.hs view
@@ -37,18 +37,18 @@ -- the email scope, which returns the object with an email. GetCurrentUser :: UserRequest User -- | Returns a 'User' for a given user ID- GetUser :: Snowflake -> UserRequest User+ GetUser :: UserId -> UserRequest User -- | Modify user's username & avatar pic ModifyCurrentUser :: T.Text -> CurrentUserAvatar -> UserRequest User -- | Returns a list of user 'Guild' objects the current user is a member of. -- Requires the guilds OAuth2 scope. GetCurrentUserGuilds :: UserRequest [PartialGuild] -- | Leave a guild.- LeaveGuild :: Snowflake -> UserRequest ()+ LeaveGuild :: GuildId -> UserRequest () -- | Returns a list of DM 'Channel' objects GetUserDMs :: UserRequest [Channel] -- | Create a new DM channel with a user. Returns a DM 'Channel' object.- CreateDM :: Snowflake -> UserRequest Channel+ CreateDM :: UserId -> UserRequest Channel -- | Formatted avatar data https://discordapp.com/developers/docs/resources/user#avatar-data data CurrentUserAvatar = CurrentUserAvatar String
src/Discord/Types/Channel.hs view
@@ -46,7 +46,7 @@ -- | Guild channels represent an isolated set of users and messages in a Guild (Server) data Channel -- | A text channel in a guild.- = Text+ = ChannelText { channelId :: Snowflake -- ^ The id of the channel (Will be equal to -- the guild if it's the "general" channel). , channelGuild :: Snowflake -- ^ The id of the guild.@@ -58,7 +58,7 @@ -- channel } -- | A voice channel in a guild.- | Voice+ | ChannelVoice { channelId :: Snowflake , channelGuild :: Snowflake , channelName :: String@@ -69,17 +69,17 @@ } -- | DM Channels represent a one-to-one conversation between two users, outside the scope -- of guilds- | DirectMessage+ | ChannelDirectMessage { channelId :: Snowflake , channelRecipients :: [User] -- ^ The 'User' object(s) of the DM recipient(s). , channelLastMessage :: Maybe Snowflake }- | GroupDM+ | ChannelGroupDM { channelId :: Snowflake , channelRecipients :: [User] , channelLastMessage :: Maybe Snowflake }- | GuildCategory+ | ChannelGuildCategory { channelId :: Snowflake , channelGuild :: Snowflake } deriving (Show, Eq)@@ -89,40 +89,40 @@ type' <- (o .: "type") :: Parser Int case type' of 0 ->- Text <$> o .: "id"- <*> o .:? "guild_id" .!= 0- <*> o .: "name"- <*> o .: "position"- <*> o .: "permission_overwrites"- <*> o .:? "topic" .!= ""- <*> o .:? "last_message_id"+ ChannelText <$> o .: "id"+ <*> o .:? "guild_id" .!= 0+ <*> o .: "name"+ <*> o .: "position"+ <*> o .: "permission_overwrites"+ <*> o .:? "topic" .!= ""+ <*> o .:? "last_message_id" 1 ->- DirectMessage <$> o .: "id"- <*> o .: "recipients"- <*> o .:? "last_message_id"+ ChannelDirectMessage <$> o .: "id"+ <*> o .: "recipients"+ <*> o .:? "last_message_id" 2 ->- Voice <$> o .: "id"- <*> o .:? "guild_id" .!= 0- <*> o .: "name"- <*> o .: "position"- <*> o .: "permission_overwrites"- <*> o .: "bitrate"- <*> o .: "user_limit"+ ChannelVoice <$> o .: "id"+ <*> o .:? "guild_id" .!= 0+ <*> o .: "name"+ <*> o .: "position"+ <*> o .: "permission_overwrites"+ <*> o .: "bitrate"+ <*> o .: "user_limit" 3 ->- GroupDM <$> o .: "id"- <*> o .: "recipients"- <*> o .:? "last_message_id"+ ChannelGroupDM <$> o .: "id"+ <*> o .: "recipients"+ <*> o .:? "last_message_id" 4 ->- GuildCategory <$> o .: "id"- <*> o .:? "guild_id" .!= 0+ ChannelGuildCategory <$> o .: "id"+ <*> o .:? "guild_id" .!= 0 _ -> fail ("Unknown channel type:" <> show type') -- | If the channel is part of a guild (has a guild id field)-isGuildChannel :: Channel -> Bool-isGuildChannel c = case c of- GuildCategory{..} -> True- Text{..} -> True- Voice{..} -> True+channelIsInGuild :: Channel -> Bool+channelIsInGuild c = case c of+ ChannelGuildCategory{..} -> True+ ChannelText{..} -> True+ ChannelVoice{..} -> True _ -> False -- | Permission overwrites for a channel.
src/Discord/Types/Events.hs view
@@ -36,7 +36,7 @@ | GuildIntegrationsUpdate Snowflake | GuildMemberAdd Snowflake GuildMember | GuildMemberRemove Snowflake User- | GuildMemberUpdate Snowflake [Snowflake] User String+ | GuildMemberUpdate Snowflake [Snowflake] User (Maybe String) | GuildMemberChunk Snowflake [GuildMember] | GuildRoleCreate Snowflake Role | GuildRoleUpdate Snowflake Role@@ -135,7 +135,7 @@ "GUILD_MEMBER_UPDATE" -> GuildMemberUpdate <$> o .: "guild_id" <*> o .: "roles" <*> o .: "user"- <*> o .: "nick"+ <*> o .:? "nick" "GUILD_MEMBER_CHUNK" -> GuildMemberChunk <$> o .: "guild_id" <*> o .: "members" "GUILD_ROLE_CREATE" -> GuildRoleCreate <$> o .: "guild_id" <*> o .: "role" "GUILD_ROLE_UPDATE" -> GuildRoleUpdate <$> o .: "guild_id" <*> o .: "role"
src/Discord/Types/Prelude.hs view
@@ -45,9 +45,18 @@ parseJSON (String snowflake) = Snowflake <$> (return . read $ T.unpack snowflake) parseJSON _ = mzero +type ChannelId = Snowflake+type GuildId = Snowflake+type MessageId = Snowflake+type EmojiId = Snowflake+type UserId = Snowflake+type OverwriteId = Snowflake+type RoleId = Snowflake+type IntegrationId = Snowflake+ -- | Gets a creation date from a snowflake.-creationDate :: Snowflake -> UTCTime-creationDate x = posixSecondsToUTCTime . realToFrac+snowflakeCreationDate :: Snowflake -> UTCTime+snowflakeCreationDate x = posixSecondsToUTCTime . realToFrac $ 1420070400 + quot (shiftR x 22) 1000 -- | Default timestamp