discord-haskell 1.13.0 → 1.14.0

raw patch · 30 files changed

+1131/−709 lines, 30 filesdep +http-api-datadep −JuicyPixelsdep ~MonadRandomdep ~aesondep ~asyncPVP ok

version bump matches the API change (PVP)

Dependencies added: http-api-data

Dependencies removed: JuicyPixels

Dependency ranges changed: MonadRandom, aeson, async, base, base64-bytestring, bytestring, containers, data-default, emoji, http-client, iso8601-time, mtl, req, safe-exceptions, scientific, text, time, unliftio, websockets, wuss

API changes (from Hackage documentation)

Files

• README.md +1/−1
• changelog.md +58/−48
• discord-haskell.cabal +61/−61
• examples/ping-pong.hs +7/−4
• src/Discord.hs +34/−8
• src/Discord/Handle.hs +23/−10
• src/Discord/Internal/Gateway.hs +1/−0
• src/Discord/Internal/Gateway/EventLoop.hs +132/−112
• src/Discord/Internal/Rest.hs +1/−0
• src/Discord/Internal/Rest/ApplicationCommands.hs +105/−34
• src/Discord/Internal/Rest/Channel.hs +165/−103
• src/Discord/Internal/Rest/Emoji.hs +51/−70
• src/Discord/Internal/Rest/Guild.hs +50/−37
• src/Discord/Internal/Rest/HTTP.hs +9/−3
• src/Discord/Internal/Rest/Interactions.hs +25/−12
• src/Discord/Internal/Rest/Prelude.hs +7/−6
• src/Discord/Internal/Rest/User.hs +18/−21
• src/Discord/Internal/Rest/Voice.hs +2/−1
• src/Discord/Internal/Rest/Webhook.hs +97/−49
• src/Discord/Internal/Types.hs +1/−0
• src/Discord/Internal/Types/ApplicationCommands.hs +18/−3
• src/Discord/Internal/Types/Channel.hs +106/−89
• src/Discord/Internal/Types/Color.hs +4/−1
• src/Discord/Internal/Types/Components.hs +3/−0
• src/Discord/Internal/Types/Emoji.hs +1/−0
• src/Discord/Internal/Types/Events.hs +58/−12
• src/Discord/Internal/Types/Gateway.hs +14/−5
• src/Discord/Internal/Types/Prelude.hs +67/−9
• src/Discord/Internal/Types/User.hs +11/−10
• src/Discord/Types.hs +1/−0

@@ -1,4 +1,4 @@-# discord-haskell        [![CI Status](https://github.com/aquarial/discord-haskell/actions/workflows/main.yml/badge.svg)](https://github.com/aquarial/discord-haskell/actions/)        [![Hackage version](http://img.shields.io/hackage/v/discord-haskell.svg?label=Hackage)](https://hackage.haskell.org/package/discord-haskell)              [![Discord server](https://discord.com/api/guilds/918577626954739722/widget.png?style=shield)](https://discord.gg/eaRAGgX3bK)+# discord-haskell        [![CI Status](https://github.com/discord-haskell/discord-haskell/actions/workflows/main.yml/badge.svg)](https://github.com/discord-haskell/discord-haskell/actions/)        [![Hackage version](http://img.shields.io/hackage/v/discord-haskell.svg?label=Hackage)](https://hackage.haskell.org/package/discord-haskell)              [![Discord server](https://discord.com/api/guilds/918577626954739722/widget.png?style=shield)](https://discord.gg/eaRAGgX3bK)   Build that discord bot in Haskell! Also checkout the

@@ -1,26 +1,36 @@ # Changelog -View on github for newest version: https://github.com/aquarial/discord-haskell/blob/master/changelog.md+View on github for newest version: https://github.com/discord-haskell/discord-haskell/blob/master/changelog.md  Discord API changes, so use the most recent version at all times  ## master +## 1.14.0++[yutotakano](https://github.com/discord-haskell/discord-haskell/pull/124) Replace JuicyPixels image parsing with a mimetype check. Make image handling consistent: use `parseStickerImage` fro sticker images. Use `parseAvatarImage` for avatars.++[L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/123/files) Make webhook API smaller, each constructor takes in a `Maybe WebhookToken`. Passing `Nothing` will continue to work as normal.++[Annwan](https://github.com/discord-haskell/discord-haskell/pull/123) Huge documentation flourish. Removed deprecated AppCommandPermissions func & fix presences typo++[yutotakano](https://github.com/discord-haskell/discord-haskell/pull/121) Replace `OverwriteId` with `Either RoleId UserId` in `ChannelPermission` requests, and remove the `type` field from `ChannelPermissionsOpts`+ ## 1.13.0 -[L0neGamer](https://github.com/aquarial/discord-haskell/pull/117) Shorten ApplicationCommand names! To update search [the pull-request](https://github.com/aquarial/discord-haskell/pull/117/files) for what the names are replaced with+[L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/117) Shorten ApplicationCommand names! To update search [the pull-request](https://github.com/discord-haskell/discord-haskell/pull/117/files) for what the names are replaced with -[L0neGamer](https://github.com/aquarial/discord-haskell/pull/116) Typesafe Snowflakes (guildid, channelid, userid, etcid)+[L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/116) Typesafe Snowflakes (guildid, channelid, userid, etcid) -Improve `restCall` type error messages https://github.com/aquarial/discord-haskell/issues/102+Improve `restCall` type error messages https://github.com/discord-haskell/discord-haskell/issues/102  ## 1.12.5 -[Annwan](https://github.com/aquarial/discord-haskell/pull/109) Add `ScheduledEvent` rest API+[Annwan](https://github.com/discord-haskell/discord-haskell/pull/109) Add `ScheduledEvent` rest API -[L0neGamer](https://github.com/aquarial/discord-haskell/pull/110) Add stickers API+[L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/110) Add stickers API -[L0neGamer](https://github.com/aquarial/discord-haskell/pull/111) Add ModifyGuildMember 'timeout' option+[L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/111) Add ModifyGuildMember 'timeout' option  ## 1.12.4 @@ -32,35 +42,35 @@  ## 1.12.2 -[L0neGamer](https://github.com/aquarial/discord-haskell/pull/107) `EditMessage` takes full `MessageDetailedOpts` (instead of Embed)+[L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/107) `EditMessage` takes full `MessageDetailedOpts` (instead of Embed)  Removed `CreateMessageUploadFile` (use `CreateMessageDetailed { MessageDetailedOpts { messageDetailedFile } }`)  ## 1.12.1 -[L0neGamer](https://github.com/aquarial/discord-haskell/pull/103) Add threads, switch api to V10, Update Guild data fields+[L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/103) Add threads, switch api to V10, Update Guild data fields -[L0neGamer](https://github.com/aquarial/discord-haskell/pull/104) Add model interaction and components+[L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/104) Add model interaction and components  ## 1.12.0 -[L0neGamer](https://github.com/aquarial/discord-haskell/pull/96) breaking changes and fixes to application commands, interactions, and components, and updates elsewhere+[L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/96) breaking changes and fixes to application commands, interactions, and components, and updates elsewhere  ## 1.11.0 -[L0neGamer](https://github.com/aquarial/discord-haskell/pull/88) did a LOT of work wrangling the discord API for interactions and commands!+[L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/88) did a LOT of work wrangling the discord API for interactions and commands!  -[L0neGamer](https://github.com/aquarial/discord-haskell/pull/94) fixed a parse error with webhooktoken+[L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/94) fixed a parse error with webhooktoken   rename fields `messageText` -> `messageContent`, `messageChannel` -> `messageChannelId`  ## 1.10.0 -[drewolson](https://github.com/aquarial/discord-haskell/pull/80) allows parsing an optional guild region+[drewolson](https://github.com/discord-haskell/discord-haskell/pull/80) allows parsing an optional guild region -[L0neGamer](https://github.com/aquarial/discord-haskell/pull/82) add 'animated' flag for Emoji+[L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/82) add 'animated' flag for Emoji  Removed `CreateGuild` rest call! You can only do it if your bot is in fewer than 10 guilds, and it's [a pain to support](https://discord.com/developers/docs/resources/guild#create-guild). Just do it manually. @@ -68,60 +78,60 @@  ## 1.9.1 -Add [color attribute for CreateEmbed](https://github.com/aquarial/discord-haskell/issues/78)+Add [color attribute for CreateEmbed](https://github.com/discord-haskell/discord-haskell/issues/78) -Rewrite [EventLoop.hs](https://github.com/aquarial/discord-haskell/issues/70) to be easier to modify+Rewrite [EventLoop.hs](https://github.com/discord-haskell/discord-haskell/issues/70) to be easier to modify  Rename a bunch of internal handles so they have more consistent names  ## 1.8.9 -Handle both aeson 1.0 and 2.0 [(breaking changes broke builds)](https://github.com/aquarial/discord-haskell/issues/77)+Handle both aeson 1.0 and 2.0 [(breaking changes broke builds)](https://github.com/discord-haskell/discord-haskell/issues/77) -Simplify [some examples](https://github.com/aquarial/discord-haskell/issues/71)+Simplify [some examples](https://github.com/discord-haskell/discord-haskell/issues/71)  ## 1.8.8 -Remove git artifacts from [examples/ping-pong.hs](https://github.com/aquarial/discord-haskell/issues/69)+Remove git artifacts from [examples/ping-pong.hs](https://github.com/discord-haskell/discord-haskell/issues/69)  ## 1.8.7 -Add [Stage channel](https://github.com/aquarial/discord-haskell/issues/68) and a catch-all Unknown channel so we stop crashing on new releases (?)+Add [Stage channel](https://github.com/discord-haskell/discord-haskell/issues/68) and a catch-all Unknown channel so we stop crashing on new releases (?)  ## 1.8.6 -Add [missing fields](https://github.com/aquarial/discord-haskell/issues/67) to ChannelGuildCategory+Add [missing fields](https://github.com/discord-haskell/discord-haskell/issues/67) to ChannelGuildCategory  ## 1.8.5 - Fix examples/ping-pong.hs compilation error https://github.com/aquarial/discord-haskell/issues/65+ Fix examples/ping-pong.hs compilation error https://github.com/discord-haskell/discord-haskell/issues/65  ## 1.8.4 -[yutotakano](https://github.com/aquarial/discord-haskell/pull/64) Added discord replies type, and message constructor+[yutotakano](https://github.com/discord-haskell/discord-haskell/pull/64) Added discord replies type, and message constructor  ## 1.8.3 -Bot no longer disconnects randomly (hopefully)  https://github.com/aquarial/discord-haskell/issues/62+Bot no longer disconnects randomly (hopefully)  https://github.com/discord-haskell/discord-haskell/issues/62  ## 1.8.2 -Added 'Competing' activity https://github.com/aquarial/discord-haskell/issues/61+Added 'Competing' activity https://github.com/discord-haskell/discord-haskell/issues/61 -Resend the last Activity settings on Resume fixing https://github.com/aquarial/discord-haskell/issues/60+Resend the last Activity settings on Resume fixing https://github.com/discord-haskell/discord-haskell/issues/60 ## 1.8.1 -Added `MessageReaction` to Message https://github.com/aquarial/discord-haskell/issues/56+Added `MessageReaction` to Message https://github.com/discord-haskell/discord-haskell/issues/56  ## 1.8.0 -Fixed [null parent_id on channel](https://github.com/aquarial/discord-haskell/issues/55)+Fixed [null parent_id on channel](https://github.com/discord-haskell/discord-haskell/issues/55)  ## 1.7.0 -[elikoga](https://github.com/aquarial/discord-haskell/pull/51) Changed to use `ReaderT` interface+[elikoga](https://github.com/discord-haskell/discord-haskell/pull/51) Changed to use `ReaderT` interface -[elikoga](https://github.com/aquarial/discord-haskell/pull/50) Fixed compiler warnings+[elikoga](https://github.com/discord-haskell/discord-haskell/pull/50) Fixed compiler warnings  Changed api url to new `discord.com` @@ -129,7 +139,7 @@  Changed discordapp.com to discord.com in accordance with official discord policy  -[rexim](https://github.com/aquarial/discord-haskell/pull/41) Add `Emoji.user` field. Who uploaded the emoji+[rexim](https://github.com/discord-haskell/discord-haskell/pull/41) Add `Emoji.user` field. Who uploaded the emoji  ## 1.6.0 @@ -143,7 +153,7 @@  ## 1.5.0 -[rexim](https://github.com/aquarial/discord-haskell/pull/35) Add `Read` instance for `Snowflake`+[rexim](https://github.com/discord-haskell/discord-haskell/pull/35) Add `Read` instance for `Snowflake`  ## 1.4.0 @@ -151,11 +161,11 @@  New and improved Embed API: Add `CreateEmbed` record and `createEmbed :: CreateEmbed -> Embed` -`CreateEmbedImageUpload` implementation inspired by [Flutterlice](https://github.com/aquarial/discord-haskell/pull/32)+`CreateEmbedImageUpload` implementation inspired by [Flutterlice](https://github.com/discord-haskell/discord-haskell/pull/32)  ## 1.3.0 -[PixeLinc](https://github.com/aquarial/discord-haskell/pull/33) Add `DeleteSingleReaction` rest-request, Add GuildId to `ReactinInfo`, Add `MESSAGE_REACTION_REMOVE_EMOJI` gateway event+[PixeLinc](https://github.com/discord-haskell/discord-haskell/pull/33) Add `DeleteSingleReaction` rest-request, Add GuildId to `ReactinInfo`, Add `MESSAGE_REACTION_REMOVE_EMOJI` gateway event  `GetReactions` actually returns the User objects request @@ -165,13 +175,13 @@  ## 1.2.0 -[MDeltaX](https://github.com/aquarial/discord-haskell/pull/27) Fixed typo: depreciated --> deprecated+[MDeltaX](https://github.com/discord-haskell/discord-haskell/pull/27) Fixed typo: depreciated --> deprecated -[MDeltaX](https://github.com/aquarial/discord-haskell/pull/29) More consistency: RoleID --> RoleId+[MDeltaX](https://github.com/discord-haskell/discord-haskell/pull/29) More consistency: RoleID --> RoleId -[MDeltaX](https://github.com/aquarial/discord-haskell/pull/29) Fix ModifyGuildRole: Post --> Patch && optional args+[MDeltaX](https://github.com/discord-haskell/discord-haskell/pull/29) Fix ModifyGuildRole: Post --> Patch && optional args -[Hippu](https://github.com/aquarial/discord-haskell/pull/31) Won't crash on integer-nonces in ChannelMessage-events (usually strings)+[Hippu](https://github.com/discord-haskell/discord-haskell/pull/31) Won't crash on integer-nonces in ChannelMessage-events (usually strings)  ## 1.1.3 @@ -179,7 +189,7 @@  ## 1.1.2 -[michalrus](https://github.com/aquarial/discord-haskell/issues/25) Fix `DeleteGuildRole` parse exception+[michalrus](https://github.com/discord-haskell/discord-haskell/issues/25) Fix `DeleteGuildRole` parse exception  ## 1.1.1 @@ -193,14 +203,14 @@  Going through some major updates to the library. Expect types to change and things to break. -Compare the [old ping-pong](https://github.com/aquarial/discord-haskell/blob/20f7f8556823a754c76d01484118a5abf336530b/examples/ping-pong.hs)-to the [new ping-pong](https://github.com/aquarial/discord-haskell/blob/7eaa6ca068f945603de7f43f6f270c2dbecd3c85/examples/ping-pong.hs)+Compare the [old ping-pong](https://github.com/discord-haskell/discord-haskell/blob/20f7f8556823a754c76d01484118a5abf336530b/examples/ping-pong.hs)+to the [new ping-pong](https://github.com/discord-haskell/discord-haskell/blob/7eaa6ca068f945603de7f43f6f270c2dbecd3c85/examples/ping-pong.hs)  Added a few rest ADT types  ## 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+[marcotoniut](https://github.com/discord-haskell/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 @@ -214,11 +224,11 @@  Hardcode CreateReaction delay so bots can add reactions 4 times faster -[MP2E](https://github.com/aquarial/discord-haskell/pull/14) Fixed parse error on GuildBanAdd + GuildBanRevoke: user\_object instead the whole object+[MP2E](https://github.com/discord-haskell/discord-haskell/pull/14) Fixed parse error on GuildBanAdd + GuildBanRevoke: user\_object instead the whole object  ### 0.8.1 -[MP2E](https://github.com/aquarial/discord-haskell/pull/11) Fixed parse error on GuildRoleDelete: role_id instead of role+[MP2E](https://github.com/discord-haskell/discord-haskell/pull/11) Fixed parse error on GuildRoleDelete: role_id instead of role  ### 0.8.0 @@ -236,13 +246,13 @@  ### 0.7.1 -[t1m0thyj](https://github.com/aquarial/discord-haskell/pull/6/files) Typo in RequestGuildMemberOpts fields fixed.+[t1m0thyj](https://github.com/discord-haskell/discord-haskell/pull/6/files) Typo in RequestGuildMemberOpts fields fixed. -[t1m0thyj](https://github.com/aquarial/discord-haskell/pull/6/files) Added Activity, ActivityType ADT+[t1m0thyj](https://github.com/discord-haskell/discord-haskell/pull/6/files) Added Activity, ActivityType ADT  UpdateStatusTypes became UpdateStatusType (singular ADT) -[t1m0thyj](https://github.com/aquarial/discord-haskell/pull/7) Retry connection on 1001 websocket close+[t1m0thyj](https://github.com/discord-haskell/discord-haskell/pull/7) Retry connection on 1001 websocket close  ### 0.7.0 

@@ -1,15 +1,15 @@ cabal-version:       2.0 name:                discord-haskell -- library version is also noted at src/Discord/Rest/Prelude.hs-version:             1.13.0+version:             1.14.0 description:         Functions and data types to write discord bots.                      Official discord docs <https://discord.com/developers/docs/reference>.                      .                      See the project readme for quickstart notes-                     <https://github.com/aquarial/discord-haskell#discord-haskell->+                     <https://github.com/discord-haskell/discord-haskell#discord-haskell-> synopsis:            Write bots for Discord in Haskell-homepage:            https://github.com/aquarial/discord-haskell-bug-reports:         https://github.com/aquarial/discord-haskell/issues+homepage:            https://github.com/discord-haskell/discord-haskell+bug-reports:         https://github.com/discord-haskell/discord-haskell/issues license:             MIT license-file:        LICENSE author:              Karl@@ -22,7 +22,7 @@  source-repository head   type:                git-  location:            https://github.com/aquarial/discord-haskell.git+  location:            https://github.com/discord-haskell/discord-haskell.git  executable ping-pong   main-is:             examples/ping-pong.hs@@ -52,60 +52,60 @@                        -fno-warn-type-defaults -fno-warn-unused-record-wildcards -Wunused-packages   hs-source-dirs:      src   default-language:    Haskell2010-  -- extensions:-  exposed-modules:     Discord-                     , Discord.Types-                     , Discord.Handle-                     , Discord.Interactions-                     , Discord.Requests-                     , Discord.Internal.Gateway-                     , Discord.Internal.Gateway.Cache-                     , Discord.Internal.Gateway.EventLoop-                     , Discord.Internal.Rest-                     , Discord.Internal.Rest.Prelude-                     , Discord.Internal.Rest.HTTP-                     , Discord.Internal.Rest.Invite-                     , Discord.Internal.Rest.Emoji-                     , Discord.Internal.Rest.User-                     , Discord.Internal.Rest.Guild-                     , Discord.Internal.Rest.Channel-                     , Discord.Internal.Rest.Voice-                     , Discord.Internal.Rest.Webhook-                     , Discord.Internal.Rest.ApplicationCommands-                     , Discord.Internal.Rest.Interactions-                     , Discord.Internal.Types-                     , Discord.Internal.Types.Prelude-                     , Discord.Internal.Types.Channel-                     , Discord.Internal.Types.Events-                     , Discord.Internal.Types.Gateway-                     , Discord.Internal.Types.Guild-                     , Discord.Internal.Types.User-                     , Discord.Internal.Types.Embed-                     , Discord.Internal.Types.ApplicationCommands-                     , Discord.Internal.Types.Interactions-                     , Discord.Internal.Types.Components-                     , Discord.Internal.Types.Color-                     , Discord.Internal.Types.Emoji-                     , Discord.Internal.Types.ScheduledEvents+  exposed-modules:   +      Discord+    , Discord.Types+    , Discord.Handle+    , Discord.Interactions+    , Discord.Requests+    , Discord.Internal.Gateway+    , Discord.Internal.Gateway.Cache+    , Discord.Internal.Gateway.EventLoop+    , Discord.Internal.Rest+    , Discord.Internal.Rest.Prelude+    , Discord.Internal.Rest.HTTP+    , Discord.Internal.Rest.Invite+    , Discord.Internal.Rest.Emoji+    , Discord.Internal.Rest.User+    , Discord.Internal.Rest.Guild+    , Discord.Internal.Rest.Channel+    , Discord.Internal.Rest.Voice+    , Discord.Internal.Rest.Webhook+    , Discord.Internal.Rest.ApplicationCommands+    , Discord.Internal.Rest.Interactions+    , Discord.Internal.Types+    , Discord.Internal.Types.Prelude+    , Discord.Internal.Types.Channel+    , Discord.Internal.Types.Events+    , Discord.Internal.Types.Gateway+    , Discord.Internal.Types.Guild+    , Discord.Internal.Types.User+    , Discord.Internal.Types.Embed+    , Discord.Internal.Types.ApplicationCommands+    , Discord.Internal.Types.Interactions+    , Discord.Internal.Types.Components+    , Discord.Internal.Types.Color+    , Discord.Internal.Types.Emoji+    , Discord.Internal.Types.ScheduledEvents   build-depends:-                       base >= 4 && <5-                     , aeson-                     , async-                     , bytestring-                     , base64-bytestring-                     , containers-                     , data-default-                     , emoji == 0.1.0.2-                     , http-client-                     , iso8601-time-                     , MonadRandom-                     , req-                     , JuicyPixels-                     , safe-exceptions-                     , text-                     , time-                     , websockets-                     , wuss-                     , mtl-                     , unliftio-                     , scientific+    base ==4.*,+    aeson >=1.5 && <1.6,+    async >=2.2 && <2.3,+    bytestring >=0.10 && <0.11,+    base64-bytestring >=1.1 && <1.2,+    containers >=0.6 && <0.7,+    data-default >=0.7 && <0.8,+    emoji ==0.1.*,+    http-client >=0.6 && <0.7,+    iso8601-time >=0.1 && <0.2,+    MonadRandom >=0.5 && <0.6,+    req >=3.9 && <3.10,+    safe-exceptions >=0.1 && <0.2,+    text >=1.2 && <1.3,+    time >=1.9 && <1.10,+    websockets >=0.12 && <0.13,+    wuss >=1.1 && <1.2,+    mtl >=2.2 && <2.3,+    unliftio >=0.2 && <0.3,+    scientific >=0.3 && <0.4,+    http-api-data >=0.4 && <0.5

@@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-}  -- allows "strings" to be Data.Text +import System.Exit (exitSuccess) import Control.Monad (when, forM_, void) import qualified Data.Text as T import qualified Data.Text.IO as TIO@@ -13,9 +14,7 @@  -- Allows this code to be an executable. See discord-haskell.cabal main :: IO ()-main = if testserverid == -1-       then TIO.putStrLn "ERROR: modify the source and set testserverid to your serverid"-       else pingpongExample+main = pingpongExample   @@ -28,6 +27,10 @@ -- | Replies "pong" to every message that starts with "ping" pingpongExample :: IO () pingpongExample = do+  when (testserverid == (-1 :: GuildId)) $ do+      TIO.putStrLn "ERROR: modify the source and set testserverid to your serverid"+      exitSuccess+   tok <- TIO.readFile "./examples/auth-token.secret"    -- open ghci and run  [[ :info RunDiscordOpts ]] to see available fields@@ -36,7 +39,7 @@                           , discordOnEnd = liftIO $ threadDelay (round (0.4 * 10^6)) >>  putStrLn "Ended"                           , discordOnEvent = eventHandler                           , discordOnLog = \s -> TIO.putStrLn s >> TIO.putStrLn ""-                          , discordGatewayIntent = def {gatewayIntentMembers = True, gatewayIntentPrecenses =True}+                          , discordGatewayIntent = def {gatewayIntentMembers = True, gatewayIntentPresences =True}                           }    -- only reached on an unrecoverable error

@@ -2,6 +2,8 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +-- | Main module of the library+-- Contains all the entrypoints module Discord   ( runDiscord   , restCall@@ -21,6 +23,7 @@   ) where  import Prelude hiding (log)+import Control.Exception (Exception) import Control.Monad.Reader (ReaderT, runReaderT, void, ask, liftIO, forever) import Data.Aeson (FromJSON) import Data.Default (Default, def)@@ -36,18 +39,36 @@ import Discord.Internal.Rest.User (UserRequest(GetCurrentUser)) import Discord.Internal.Gateway +-- | A `ReaderT` wrapper around `DiscordHandle` and `IO`. Most functions act in+-- this monad type DiscordHandler = ReaderT DiscordHandle IO +-- | Options for the connection.  data RunDiscordOpts = RunDiscordOpts-  { discordToken :: T.Text-  , discordOnStart :: DiscordHandler ()-  , discordOnEnd :: IO ()-  , discordOnEvent :: Event -> DiscordHandler ()-  , discordOnLog :: T.Text -> IO ()-  , discordForkThreadForEvents :: Bool-  , discordGatewayIntent :: GatewayIntent+  { -- | Token for the discord API+    discordToken :: T.Text+  , -- | Actions executed right after a connexion to discord's API is+    -- established+    discordOnStart :: DiscordHandler ()+  , -- | Actions executed at termination.+    --+    -- Note that this runs in plain `IO` and not in `DiscordHandler` as the+    -- connexion has been closed before this runs.+    --+    -- Useful for cleaning up.+    discordOnEnd :: IO ()+  , -- | Actions run upon the reception of an `Event`. This is here most of the+    -- code of the bot may get dispatched from.+    discordOnEvent :: Event -> DiscordHandler ()+  , -- | Dispatching on internal logs+    discordOnLog :: T.Text -> IO ()+  , -- | Fork a thread for every `Event` recived+    discordForkThreadForEvents :: Bool+  , -- | The gateway intents the bot is asking for+    discordGatewayIntent :: GatewayIntent   } +-- | Default values for `RunDiscordOpts` instance Default RunDiscordOpts where   def = RunDiscordOpts { discordToken = ""                        , discordOnStart = pure ()@@ -58,6 +79,7 @@                        , discordGatewayIntent = def                        } +-- | Entrypoint to the library  runDiscord :: RunDiscordOpts -> IO T.Text runDiscord opts = do   log <- newChan@@ -84,6 +106,7 @@   finally (runDiscordLoop handle opts)           (discordOnEnd opts >> runReaderT stopDiscord handle) +-- | Runs the main loop  runDiscordLoop :: DiscordHandle -> RunDiscordOpts -> IO T.Text runDiscordLoop handle opts = do   resp <- liftIO $ writeRestCall (discordHandleRestChan handle) GetCurrentUser@@ -119,10 +142,12 @@                                Right _ -> pure ()                  loop -+-- | A Error code following a rest call data RestCallErrorCode = RestCallErrorCode Int T.Text T.Text   deriving (Show, Read, Eq, Ord) +instance Exception RestCallErrorCode+ -- | Execute one http request and get a response restCall :: (Request (r a), FromJSON a) => r a -> DiscordHandler (Either RestCallErrorCode a) restCall r = do h <- ask@@ -174,6 +199,7 @@                    HandleThreadIdCache a -> a                    HandleThreadIdLogger a -> a +-- | Starts the internal logger startLogger :: (T.Text -> IO ()) -> Chan T.Text -> IO ThreadId startLogger handle logC = forkIO $ forever $   do me <- try $ readChan logC >>= handle

@@ -1,3 +1,4 @@+-- | The Discord Handle. Holds all the information related to the connection. module Discord.Handle   ( DiscordHandle(..)   , HandleThreadId(..)@@ -10,16 +11,28 @@ import Discord.Internal.Gateway (GatewayHandle(..), CacheHandle(..))  -- | Thread Ids marked by what type they are-data HandleThreadId = HandleThreadIdRest ThreadId-                      | HandleThreadIdCache ThreadId-                      | HandleThreadIdLogger ThreadId-                      | HandleThreadIdGateway ThreadId+data HandleThreadId+  = -- | A Rest API thread+    HandleThreadIdRest ThreadId+  | -- | A cache thread+  HandleThreadIdCache ThreadId+  | -- | A logger thread+  HandleThreadIdLogger ThreadId+  | -- | A gateway thread +  HandleThreadIdGateway ThreadId +-- | The main Handle structure data DiscordHandle = DiscordHandle-  { discordHandleRestChan :: RestChanHandle-  , discordHandleGateway :: GatewayHandle-  , discordHandleCache :: CacheHandle-  , discordHandleThreads :: [HandleThreadId]-  , discordHandleLog :: Chan T.Text-  , discordHandleLibraryError :: MVar T.Text+  { -- | Handle to the Rest loop+    discordHandleRestChan :: RestChanHandle+  , -- | Handle to the Websocket gateway event loop+    discordHandleGateway :: GatewayHandle+  , -- | Handle to the cache+    discordHandleCache :: CacheHandle+  , -- | List of the threads currently in use by the library+    discordHandleThreads :: [HandleThreadId]+  , -- | `Chan` used to send messages to the internal logger+    discordHandleLog :: Chan T.Text+  , -- | `MVar` containing a description of the latest library error+    discordHandleLibraryError :: MVar T.Text   }

@@ -22,6 +22,7 @@ import Discord.Internal.Gateway.EventLoop (connectionLoop, GatewayHandle(..), GatewayException(..)) import Discord.Internal.Gateway.Cache (cacheLoop, Cache(..), CacheHandle(..)) +-- | Starts a thread for the cache startCacheThread :: Chan T.Text -> IO (CacheHandle, ThreadId) startCacheThread log = do   events <- newChan :: IO (Chan (Either GatewayException EventInternalParse))

@@ -27,28 +27,32 @@ import Discord.Internal.Rest.Prelude (apiVersion)  +-- | Info the event processing loop needs to data GatewayHandle = GatewayHandle-  { gatewayHandleEvents         :: Chan (Either GatewayException EventInternalParse)-  , gatewayHandleUserSendables  :: Chan GatewaySendable-  , gatewayHandleLastStatus     :: IORef (Maybe UpdateStatusOpts)-  , gatewayHandleLastSequenceId :: IORef Integer-  , gatewayHandleSessionId      :: IORef T.Text+  { -- | Realtime events from discord+    gatewayHandleEvents         :: Chan (Either GatewayException EventInternalParse),+    -- | Events the user sends to discord+    gatewayHandleUserSendables  :: Chan GatewaySendable,+    -- | Recent set status (resent to discord on reconnect)+    gatewayHandleLastStatus     :: IORef (Maybe UpdateStatusOpts),+    -- | Recent sent event sequence (used to reconnect)+    gatewayHandleLastSequenceId :: IORef Integer,+    -- | Which discord server session (used to reconnect)+    gatewayHandleSessionId      :: IORef T.Text   } -data GatewayException = GatewayExceptionCouldNotConnect T.Text-                      | GatewayExceptionEventParseError T.Text T.Text-                      | GatewayExceptionUnexpected GatewayReceivable T.Text-                      | GatewayExceptionConnection ConnectionException T.Text+-- | Ways the gateway connection can fail with no possibility of recovery.+data GatewayException = GatewayExceptionIntent T.Text   deriving (Show) -+  -- | State of the eventloop data LoopState = LoopStart                | LoopClosed                | LoopReconnect   deriving Show --- | Enough info for library to send info to discord.+-- | Info the sendableLoop reads when it writes to the websocket data SendablesData = SendablesData   { sendableConnection :: Connection   , librarySendables :: Chan GatewaySendableInternal@@ -56,104 +60,118 @@   , heartbeatInterval :: Integer   } -{--Some quick documentation for some of the variables passed around: -Auth                                                         needed to connect-GatewayIntent                                                needed to connect-GatewayHandle (eventsGifts,status,usersends,seq,sesh)        needed all over-log :: Chan (T.Text)                                         needed all over--sendableConnection                                 set by setup,  need sendableLoop-librarySendables :: Chan (GatewaySendableInternal) set by setup,  need heartbeat-heartbeatInterval :: Int                           set by Hello,  need heartbeat--sequenceId :: Int id of last event received        set by Resume, need heartbeat and reconnect-sessionId :: Text                                  set by Ready,  need reconnect--}-+-- | Gateway connection infinite loop. Get events from websocket and send them to the library user+--+-- @+--  Auth                                                         needed to connect+--  GatewayIntent                                                needed to connect+--  GatewayHandle (eventsGives,status,usersends,seq,sesh)        needed all over+--  log :: Chan (T.Text)                                         needed all over+--+--  sendableConnection                                 set by setup,  need sendableLoop+--  librarySendables :: Chan (GatewaySendableInternal) set by setup,  need heartbeat+--  heartbeatInterval :: Int                           set by Hello,  need heartbeat+--+--  sequenceId :: Int id of last event received        set by Resume, need heartbeat and reconnect+--  sessionId :: Text                                  set by Ready,  need reconnect+-- @ connectionLoop :: Auth -> GatewayIntent -> GatewayHandle -> Chan T.Text -> IO () connectionLoop auth intent gatewayHandle log = outerloop LoopStart-  where+    where -  outerloop :: LoopState -> IO ()-  outerloop state = do-      mfirst <- firstmessage state-      case mfirst of-        Nothing -> pure ()-        Just first -> do-            next <- try (startconnectionpls first)-            case next :: Either SomeException LoopState of-              Left _ -> do t <- getRandomR (3,20)-                           threadDelay (t * (10^(6 :: Int)))-                           writeChan log ("gateway - trying to reconnect after failure(s)")-                           outerloop LoopReconnect-              Right n -> outerloop n+    -- | Main connection loop. Catch exceptions and reconnect.+    outerloop :: LoopState -> IO ()+    outerloop state = do+        mfirst <- firstmessage state -- construct first message+        case mfirst of+          Nothing -> pure () -- close -  firstmessage :: LoopState -> IO (Maybe GatewaySendableInternal)-  firstmessage state =-    case state of-      LoopStart -> pure $ Just $ Identify auth intent (0, 1)-      LoopReconnect -> do seqId  <- readIORef (gatewayHandleLastSequenceId gatewayHandle)-                          seshId <- readIORef (gatewayHandleSessionId gatewayHandle)-                          if seshId == ""-                          then do writeChan log ("gateway - WARNING seshID was not set by READY?")-                                  pure $ Just $ Identify auth intent (0, 1)-                          else pure $ Just $ Resume auth seshId seqId-      LoopClosed -> pure Nothing+          Just message -> do+              nextstate <- try (startOneConnection message)  -- connection+              case nextstate :: Either SomeException LoopState of+                Left _ -> do t <- getRandomR (3,20)+                             threadDelay (t * (10^(6 :: Int)))+                             writeChan log ("gateway - trying to reconnect after failure(s)")+                             outerloop LoopReconnect+                Right n -> outerloop n -  startconnectionpls :: GatewaySendableInternal -> IO LoopState-  startconnectionpls first = runSecureClient "gateway.discord.gg" 443 ("/?v=" <> T.unpack apiVersion <>"&encoding=json") $ \conn -> do-                      msg <- getPayload conn log-                      case msg of-                        Right (Hello interval) -> do+    -- | Construct the initial websocket message to send based on which state of the loop.+    --   Fresh start is Identify and a reconnect is Resume+    firstmessage :: LoopState -> IO (Maybe GatewaySendableInternal)+    firstmessage state =+      case state of+        LoopStart -> pure $ Just $ Identify auth intent (0, 1)+        LoopReconnect -> do seqId  <- readIORef (gatewayHandleLastSequenceId gatewayHandle)+                            seshId <- readIORef (gatewayHandleSessionId gatewayHandle)+                            if seshId == ""+                            then do writeChan log ("gateway - WARNING seshID was not set by READY?")+                                    pure $ Just $ Identify auth intent (0, 1)+                            else pure $ Just $ Resume auth seshId seqId+        LoopClosed -> pure Nothing -                          internal <- newChan :: IO (Chan GatewaySendableInternal)-                          us <- newIORef False-                          -- start event loop-                          let sending = SendablesData conn internal us interval-                          sendsId <- forkIO $ sendableLoop conn gatewayHandle sending log-                          heart <- forkIO $ heartbeat sending (gatewayHandleLastSequenceId gatewayHandle)+    startOneConnection :: GatewaySendableInternal -> IO LoopState+    startOneConnection message = runSecureClient "gateway.discord.gg" 443 ("/?v=" <> T.unpack apiVersion <>"&encoding=json") $ \conn -> do+                        msg <- getPayload conn log+                        case msg of+                            Right (Hello interval) -> do+                                -- setup sendables data+                                internal <- newChan :: IO (Chan GatewaySendableInternal)+                                sendingUser <- newIORef False+                                let sending = SendablesData { sendableConnection = conn+                                                            , librarySendables = internal+                                                            , startsendingUsers = sendingUser+                                                            , heartbeatInterval = interval+                                                            }+                                -- start websocket sending loop+                                sendsId <- forkIO $ sendableLoop conn gatewayHandle sending log+                                heart <- forkIO $ heartbeat sending (gatewayHandleLastSequenceId gatewayHandle)+                                writeChan internal message -                          writeChan internal first-                          finally (runEventLoop gatewayHandle sending log)-                                  (killThread heart >> killThread sendsId)-                        _ -> do-                          writeChan log "gateway - WARNING could not connect. Expected hello"-                          sendClose conn ("expected hello" :: BL.ByteString)-                          void $ forever $ void (receiveData conn :: IO BL.ByteString)-                          -- > after sendClose you should call receiveDataMessage until-                          -- > it throws an exception-                          -- haskell websockets documentation-                          threadDelay (3 * (10^(6 :: Int)))-                          pure LoopStart+                                -- run connection eventloop+                                finally (runEventLoop gatewayHandle sending log)+                                        (killThread heart >> killThread sendsId) +                            _ -> do+                                writeChan log "gateway - WARNING could not connect. Expected hello"+                                sendClose conn ("expected hello" :: BL.ByteString)+                                void $ forever $ void (receiveData conn :: IO BL.ByteString)+                                -- > after sendClose you should call receiveDataMessage until+                                -- > it throws an exception+                                -- haskell websockets documentation+                                threadDelay (3 * (10^(6 :: Int)))+                                pure LoopStart ++-- | Process events from discord and write them to the onDiscordEvent Channel runEventLoop :: GatewayHandle -> SendablesData -> Chan T.Text -> IO LoopState runEventLoop thehandle sendablesData log = do loop   where+  eventChan :: Chan (Either GatewayException EventInternalParse)   eventChan = gatewayHandleEvents thehandle +  -- | Keep receiving Dispatch events until a reconnect or a restart   loop = do     eitherPayload <- getPayloadTimeout sendablesData log     case eitherPayload :: Either ConnectionException GatewayReceivable of-      Right (Hello _interval) -> do writeChan log ("eventloop - unexpected hello")-                                    loop-      Right (Dispatch event sq) -> do writeIORef (gatewayHandleLastSequenceId thehandle) sq-                                      writeChan eventChan (Right event)++      Right (Dispatch event sq) -> do -- GOT AN EVENT:+                                      writeIORef (gatewayHandleLastSequenceId thehandle) sq+                                      writeChan eventChan (Right event) -- send the event to user                                       case event of                                         (InternalReady _ _ _ _ seshID _ _) ->                                             writeIORef (gatewayHandleSessionId thehandle) seshID                                         _ -> writeIORef (startsendingUsers sendablesData) True                                       loop+      Right (Hello _interval) -> do writeChan log ("eventloop - unexpected hello")+                                    loop       Right (HeartbeatRequest sq) -> do writeIORef (gatewayHandleLastSequenceId thehandle) sq                                         writeChan (librarySendables sendablesData) (Heartbeat sq)                                         loop-      Right (Reconnect)      -> pure LoopReconnect       Right (InvalidSession retry) -> pure $ if retry then LoopReconnect else LoopStart+      Right (Reconnect)      -> pure LoopReconnect       Right (HeartbeatAck)   -> loop-      Right (ParseError _e) ->  -- getPayload logs the parse error. nothing to do here-                                loop+      Right (ParseError _e)  -> loop  -- getPayload logs the parse error. nothing to do here        Left (CloseRequest code str) -> case code of           -- see Discord and MDN documentation on gateway close event codes@@ -164,26 +182,19 @@           4000 -> pure LoopReconnect           4006 -> pure LoopStart           4007 -> pure LoopStart-          4014 -> do writeChan eventChan (Left (GatewayExceptionUnexpected (Hello 0) $+          4014 -> do writeChan eventChan (Left (GatewayExceptionIntent $                            "Tried to declare an unauthorized GatewayIntent. " <>                            "Use the discord app manager to authorize by following: " <>-                           "https://github.com/aquarial/discord-haskell/blob/master/docs/intents.md"))+                           "https://github.com/discord-haskell/discord-haskell/blob/master/docs/intents.md"))                      pure LoopClosed           _ -> do writeChan log ("gateway - unknown websocket close code " <> T.pack (show code)                                   <> " [" <> TE.decodeUtf8 (BL.toStrict str) <> "]. Consider opening an issue "-                                  <> "https://github.com/aquarial/discord-haskell/issues")+                                  <> "https://github.com/discord-haskell/discord-haskell/issues")                   pure LoopStart       Left _ -> pure LoopReconnect  -heartbeat :: SendablesData -> IORef Integer -> IO ()-heartbeat sendablesData seqKey = do-  threadDelay (3 * 10^(6 :: Int))-  forever $ do-    num <- readIORef seqKey-    writeChan (librarySendables sendablesData) (Heartbeat num)-    threadDelay (fromInteger (heartbeatInterval sendablesData * 1000))-+-- | Blocking wait for next payload from the websocket (returns "Reconnect" after 1.5*heartbeatInterval seconds) getPayloadTimeout :: SendablesData -> Chan T.Text -> IO (Either ConnectionException GatewayReceivable) getPayloadTimeout sendablesData log = do   let interval = heartbeatInterval sendablesData@@ -193,6 +204,7 @@     Left () -> pure (Right Reconnect)     Right other -> pure other +-- | Blocking wait for next payload from the websocket getPayload :: Connection -> Chan T.Text -> IO (Either ConnectionException GatewayReceivable) getPayload conn log = try $ do   msg' <- receiveData conn@@ -202,30 +214,38 @@                                       <> " while decoding " <> TE.decodeUtf8 (BL.toStrict msg'))                     pure (ParseError (T.pack err)) +-- | Infinite loop to send heartbeats to the chan+heartbeat :: SendablesData -> IORef Integer -> IO ()+heartbeat sendablesData seqKey = do+  threadDelay (3 * 10^(6 :: Int))+  forever $ do+    num <- readIORef seqKey+    writeChan (librarySendables sendablesData) (Heartbeat num)+    threadDelay (fromInteger (heartbeatInterval sendablesData * 1000)) --- simple idea: send payloads from user/sys to connection--- has to be complicated though++-- | Infinite loop to send library/user events to discord with the actual websocket connection sendableLoop :: Connection -> GatewayHandle -> SendablesData -> Chan T.Text -> IO ()-sendableLoop conn ghandle sendablesData _log = sendSysLoop+sendableLoop conn ghandle sendablesData _log = sendLoop   where-  sendSysLoop = do-      threadDelay $ round ((10^(6 :: Int)) * (62 / 120) :: Double)-      payload <- readChan (librarySendables sendablesData)-      sendTextData conn (encode payload)-   -- writeChan _log ("gateway - sending " <> TE.decodeUtf8 (BL.toStrict (encode payload)))-      usersending <- readIORef (startsendingUsers sendablesData)-      if not usersending-      then sendSysLoop-      else do act <- readIORef (gatewayHandleLastStatus ghandle)-              case act of Nothing -> pure ()-                          Just opts -> sendTextData conn (encode (UpdateStatus opts))-              sendUserLoop--  sendUserLoop = do+  sendLoop = do    -- send a ~120 events a min by delaying       threadDelay $ round ((10^(6 :: Int)) * (62 / 120) :: Double)    -- payload :: Either GatewaySendableInternal GatewaySendable-      payload <- race (readChan (gatewayHandleUserSendables ghandle)) (readChan (librarySendables sendablesData))-      sendTextData conn (either encode encode payload)+      payload <- race nextLibrary nextUser    -- writeChan _log ("gateway - sending " <> TE.decodeUtf8 (BL.toStrict (either encode encode payload)))-      sendUserLoop+      sendTextData conn (either encode encode payload)+      sendLoop++  -- | next event sent by library+  nextLibrary :: IO GatewaySendableInternal+  nextLibrary = readChan (librarySendables sendablesData)++  -- | next event sent by user (once startsendingUsers is set)+  nextUser :: IO GatewaySendable+  nextUser = do usersending <- readIORef (startsendingUsers sendablesData)+                if usersending+                then readChan (gatewayHandleUserSendables ghandle)+                else threadDelay (4 * (10^(6::Int))) >> nextUser++

@@ -25,6 +25,7 @@ import Discord.Internal.Types import Discord.Internal.Rest.HTTP +-- | Handle to the Rest 'Chan' data RestChanHandle = RestChanHandle       { restHandleChan :: Chan (String, JsonRequest, MVar (Either RestCallInternalException BL.ByteString))       }

@@ -20,29 +20,102 @@   jsonRequest = applicationCommandJsonRequest   majorRoute = applicationCommandMajorRoute +-- | Requests related to application commands data ApplicationCommandRequest a where-  GetGlobalApplicationCommands :: ApplicationId -> ApplicationCommandRequest [ApplicationCommand]-  CreateGlobalApplicationCommand :: ApplicationId -> CreateApplicationCommand -> ApplicationCommandRequest ApplicationCommand-  GetGlobalApplicationCommand :: ApplicationId -> ApplicationCommandId -> ApplicationCommandRequest ApplicationCommand-  EditGlobalApplicationCommand :: ApplicationId -> ApplicationCommandId -> EditApplicationCommand -> ApplicationCommandRequest ApplicationCommand-  DeleteGlobalApplicationCommand :: ApplicationId -> ApplicationCommandId -> ApplicationCommandRequest ()-  BulkOverWriteGlobalApplicationCommand :: ApplicationId -> [CreateApplicationCommand] -> ApplicationCommandRequest ()-  GetGuildApplicationCommands :: ApplicationId -> GuildId -> ApplicationCommandRequest [ApplicationCommand]-  CreateGuildApplicationCommand :: ApplicationId -> GuildId -> CreateApplicationCommand -> ApplicationCommandRequest ApplicationCommand-  GetGuildApplicationCommand :: ApplicationId -> GuildId -> ApplicationCommandId -> ApplicationCommandRequest ApplicationCommand-  EditGuildApplicationCommand :: ApplicationId -> GuildId -> ApplicationCommandId -> CreateApplicationCommand -> ApplicationCommandRequest ApplicationCommand-  DeleteGuildApplicationCommand :: ApplicationId -> GuildId -> ApplicationCommandId -> ApplicationCommandRequest ()-  BulkOverWriteGuildApplicationCommand :: ApplicationId -> GuildId -> [CreateApplicationCommand] -> ApplicationCommandRequest ()-  GetGuildApplicationCommandPermissions :: ApplicationId -> GuildId -> ApplicationCommandRequest GuildApplicationCommandPermissions-  GetApplicationCommandPermissions :: ApplicationId -> GuildId -> ApplicationCommandId -> ApplicationCommandRequest GuildApplicationCommandPermissions-  EditApplicationCommandPermissions :: ApplicationId -> GuildId -> ApplicationCommandId -> [ApplicationCommandPermissions] -> ApplicationCommandRequest GuildApplicationCommandPermissions-  -- | The only parameters needed in the GuildApplicationCommandPermissions-  -- objects are id and permissions.-  BatchEditApplicationCommandPermissions :: ApplicationId -> GuildId -> [GuildApplicationCommandPermissions] -> ApplicationCommandRequest [GuildApplicationCommandPermissions]+  -- | Fetch all of the global commands for your application. Returns an list of 'ApplicationCommand's.+  GetGlobalApplicationCommands :: ApplicationId+                               -> ApplicationCommandRequest [ApplicationCommand]+  -- | Create a new global command. Returns an 'ApplicationCommand'.+  --+  -- __Note__: Creating a command with the same name as an existing command for your application will overwrite the old command.+  CreateGlobalApplicationCommand :: ApplicationId+                                 -> CreateApplicationCommand+                                 -> ApplicationCommandRequest ApplicationCommand+  -- | Fetch a global command for your application. Returns an 'ApplicationCommand'.+  GetGlobalApplicationCommand :: ApplicationId+                              -> ApplicationCommandId+                              -> ApplicationCommandRequest ApplicationCommand+  -- | Edit a global command. Returns an 'ApplicationCommand'.+  --+  -- All fields are optional, but any fields provided will entirely overwrite the existing values of those fields.+  EditGlobalApplicationCommand :: ApplicationId+                               -> ApplicationCommandId+                               -> EditApplicationCommand+                               -> ApplicationCommandRequest ApplicationCommand+  -- | Delete a global command.+  DeleteGlobalApplicationCommand :: ApplicationId+                                 -> ApplicationCommandId+                                 -> ApplicationCommandRequest ()+  -- | Takes a list of 'CreateApplicationCommand', overwriting the existing global command list for this application.+  --+  -- __Note__: This will overwrite __all__ types of application commands: slash commands, user commands, and message commands.+  BulkOverWriteGlobalApplicationCommand :: ApplicationId+                                        -> [CreateApplicationCommand]+                                        -> ApplicationCommandRequest ()+  -- | Fetch all of the guild commands for your application for a specific guild. Returns an list of 'ApplicationCommands'.+  GetGuildApplicationCommands :: ApplicationId+                              -> GuildId+                              -> ApplicationCommandRequest [ApplicationCommand]+  -- | Create a new guild command. New guild commands will be available in the guild immediately.+  -- Returns an 'ApplicationCommand'.+  -- If the command did not already exist, it will count toward daily application command create limits.+  --+  -- __Note__: Creating a command with the same name as an existing command for your application will overwrite the old command.+  CreateGuildApplicationCommand :: ApplicationId+                                -> GuildId+                                -> CreateApplicationCommand+                                -> ApplicationCommandRequest ApplicationCommand+  -- | Fetch a guild command for your application. Returns an 'ApplicationCommand'+  GetGuildApplicationCommand :: ApplicationId+                             -> GuildId+                             -> ApplicationCommandId+                             -> ApplicationCommandRequest ApplicationCommand+  -- | Edit a guild command. Updates for guild commands will be available immediately. Returns an 'ApplicationCommand'.+  -- All fields are optional, but any fields provided will entirely overwrite the existing values of those fields.+  EditGuildApplicationCommand :: ApplicationId+                              -> GuildId+                              -> ApplicationCommandId+                              -> CreateApplicationCommand+                              -> ApplicationCommandRequest ApplicationCommand+  -- | Delete a guild command.+  DeleteGuildApplicationCommand :: ApplicationId+                                -> GuildId+                                -> ApplicationCommandId+                                -> ApplicationCommandRequest ()+  -- | Takes a list of `CreateApplicationCommand`, overwriting the existing command list for this application for the targeted guild.+  --+  -- __Note__: This will overwrite __all__ types of application commands: slash commands, user commands, and message commands.+  BulkOverWriteGuildApplicationCommand :: ApplicationId+                                       -> GuildId+                                       -> [CreateApplicationCommand]+                                       -> ApplicationCommandRequest ()+  -- | Fetches permissions for all commands for your application in a guild. +  GetGuildApplicationCommandPermissions :: ApplicationId+                                        -> GuildId+                                        -> ApplicationCommandRequest GuildApplicationCommandPermissions+  -- | Fetches permissions for a specific command for your application in a guild.+  GetApplicationCommandPermissions :: ApplicationId+                                   -> GuildId+                                   -> ApplicationCommandId+                                   -> ApplicationCommandRequest GuildApplicationCommandPermissions+  -- | Edits command permissions for a specific command for your application.+  -- You can add up to 100 permission overwrites for a command.+  -- __Notes__:+  --+  --   * This endpoint will overwrite existing permissions for the command in that guild+  --   * This endpoint requires authentication with a Bearer token that has permission to manage the guild and its roles.+  --   * Deleting or renaming a command will permanently delete all permissions for the command+  EditApplicationCommandPermissions :: ApplicationId+                                    -> GuildId+                                    -> ApplicationCommandId+                                    -> [ApplicationCommandPermissions]+                                    -> ApplicationCommandRequest GuildApplicationCommandPermissions +-- | The base url for application commands applications :: ApplicationId -> R.Url 'R.Https-applications s = baseUrl /: "applications" // s+applications s = baseUrl /: "applications" /~ s +-- | The major routes identifiers for `ApplicationCommandRequest`s applicationCommandMajorRoute :: ApplicationCommandRequest a -> String applicationCommandMajorRoute a = case a of   (GetGlobalApplicationCommands aid) -> "get_glob_appcomm" <> show aid@@ -60,8 +133,8 @@   (GetGuildApplicationCommandPermissions aid _) -> "appcom_perm " <> show aid   (GetApplicationCommandPermissions aid _ _) -> "appcom_perm " <> show aid   (EditApplicationCommandPermissions aid _ _ _) -> "appcom_perm " <> show aid-  (BatchEditApplicationCommandPermissions aid _ _) -> "appcom_perm " <> show aid +-- | The `JsonRequest`s for `ApplicationCommandRequest`s applicationCommandJsonRequest :: ApplicationCommandRequest a -> JsonRequest applicationCommandJsonRequest a = case a of   (GetGlobalApplicationCommands aid) ->@@ -69,33 +142,31 @@   (CreateGlobalApplicationCommand aid cac) ->     Post (applications aid /: "commands") (convert cac) mempty   (GetGlobalApplicationCommand aid aci) ->-    Get (applications aid /: "commands" // aci) mempty+    Get (applications aid /: "commands" /~ aci) mempty   (EditGlobalApplicationCommand aid aci eac) ->-    Patch (applications aid /: "commands" // aci) (convert eac) mempty+    Patch (applications aid /: "commands" /~ aci) (convert eac) mempty   (DeleteGlobalApplicationCommand aid aci) ->-    Delete (applications aid /: "commands" // aci) mempty+    Delete (applications aid /: "commands" /~ aci) mempty   (BulkOverWriteGlobalApplicationCommand aid cacs) ->     Put (applications aid /: "commands") (R.ReqBodyJson $ toJSON cacs) mempty   (GetGuildApplicationCommands aid gid) ->-    Get (applications aid /: "guilds" // gid /: "commands") mempty+    Get (applications aid /: "guilds" /~ gid /: "commands") mempty   (CreateGuildApplicationCommand aid gid cac) ->-    Post (applications aid /: "guilds" // gid /: "commands") (convert cac) mempty+    Post (applications aid /: "guilds" /~ gid /: "commands") (convert cac) mempty   (GetGuildApplicationCommand aid gid aci) ->-    Get (applications aid /: "guilds" // gid /: "commands" // aci) mempty+    Get (applications aid /: "guilds" /~ gid /: "commands" /~ aci) mempty   (EditGuildApplicationCommand aid gid aci eac) ->-    Patch (applications aid /: "guilds" // gid /: "commands" // aci) (convert eac) mempty+    Patch (applications aid /: "guilds" /~ gid /: "commands" /~ aci) (convert eac) mempty   (DeleteGuildApplicationCommand aid gid aci) ->-    Delete (applications aid /: "guilds" // gid /: "commands" // aci) mempty+    Delete (applications aid /: "guilds" /~ gid /: "commands" /~ aci) mempty   (BulkOverWriteGuildApplicationCommand aid gid cacs) ->-    Put (applications aid /: "guilds" // gid /: "commands") (R.ReqBodyJson $ toJSON cacs) mempty+    Put (applications aid /: "guilds" /~ gid /: "commands") (R.ReqBodyJson $ toJSON cacs) mempty   (GetGuildApplicationCommandPermissions aid gid) ->-    Get (applications aid /: "guilds" // gid /: "commands" /: "permissions") mempty+    Get (applications aid /: "guilds" /~ gid /: "commands" /: "permissions") mempty   (GetApplicationCommandPermissions aid gid cid) ->-    Get (applications aid /: "guilds" // gid /: "commands" // cid /: "permissions") mempty+    Get (applications aid /: "guilds" /~ gid /: "commands" /~ cid /: "permissions") mempty   (EditApplicationCommandPermissions aid gid cid ps) ->-    Put (applications aid /: "guilds" // gid /: "commands" // cid /: "permissions") (R.ReqBodyJson $ toJSON (GuildApplicationCommandPermissions cid aid gid ps)) mempty-  (BatchEditApplicationCommandPermissions aid gid ps) ->-    Put (applications aid /: "guilds" // gid /: "commands" /: "permissions") (R.ReqBodyJson $ toJSON ps) mempty+    Put (applications aid /: "guilds" /~ gid /: "commands" /~ cid /: "permissions") (R.ReqBodyJson $ toJSON (GuildApplicationCommandPermissions cid aid gid ps)) mempty   where     convert :: (ToJSON a) => a -> RestIO (ReqBodyJson Value)     convert = (pure @RestIO) . R.ReqBodyJson . toJSON

@@ -15,7 +15,6 @@   , ModifyChannelOpts(..)   , ChannelPermissionsOpts(..)   , GroupDMAddRecipientOpts(..)-  , ChannelPermissionsOptsType(..)   , StartThreadOpts(..)   , StartThreadNoMessageOpts(..)   , ListThreads(..)@@ -30,7 +29,7 @@ import qualified Data.ByteString.Lazy as BL import Network.HTTP.Client (RequestBody (RequestBodyBS)) import Network.HTTP.Client.MultipartFormData (partFileRequestBody, partBS)-import Network.HTTP.Req ((/:))+import Network.HTTP.Req ((/:), (/~)) import qualified Network.HTTP.Req as R  import Discord.Internal.Rest.Prelude@@ -77,13 +76,13 @@   -- | Deletes a group of messages.   BulkDeleteMessage         :: (ChannelId, [MessageId]) -> ChannelRequest ()   -- | Edits a permission overrides for a channel.-  EditChannelPermissions    :: ChannelId -> OverwriteId -> ChannelPermissionsOpts -> ChannelRequest ()+  EditChannelPermissions    :: ChannelId -> Either RoleId UserId -> ChannelPermissionsOpts -> ChannelRequest ()   -- | Gets all instant invites to a channel.   GetChannelInvites         :: ChannelId -> ChannelRequest Object   -- | Creates an instant invite to a channel.   CreateChannelInvite       :: ChannelId -> ChannelInviteOpts -> ChannelRequest Invite   -- | Deletes a permission override from a channel.-  DeleteChannelPermission   :: ChannelId -> OverwriteId -> ChannelRequest ()+  DeleteChannelPermission   :: ChannelId -> Either RoleId UserId -> ChannelRequest ()   -- | Sends a typing indicator a channel which lasts 10 seconds.   TriggerTypingIndicator    :: ChannelId -> ChannelRequest ()   -- | Gets all pinned messages of a channel.@@ -129,16 +128,24 @@   ListJoinedPrivateArchivedThreads :: ChannelId -> (Maybe UTCTime, Maybe Integer) -> ChannelRequest ListThreads  --- | Data constructor for CreateMessageDetailed requests.+-- | Options for `CreateMessageDetailed` requests. data MessageDetailedOpts = MessageDetailedOpts-  { messageDetailedContent                  :: T.Text-  , messageDetailedTTS                      :: Bool-  , messageDetailedEmbeds                   :: Maybe [CreateEmbed]-  , messageDetailedFile                     :: Maybe (T.Text, B.ByteString)-  , messageDetailedAllowedMentions          :: Maybe AllowedMentions-  , messageDetailedReference                :: Maybe MessageReference-  , messageDetailedComponents               :: Maybe [ActionRow]-  , messageDetailedStickerIds               :: Maybe [StickerId]+  { -- | The message contents (up to 2000 characters)+    messageDetailedContent                  :: T.Text+  , -- | `True` if this is a TTS message+    messageDetailedTTS                      :: Bool+  , -- | embedded rich content (up to 6000 characters)+    messageDetailedEmbeds                   :: Maybe [CreateEmbed]+  , -- | the contents of the file being sent+    messageDetailedFile                     :: Maybe (T.Text, B.ByteString)+  , -- | allowed mentions for the message+    messageDetailedAllowedMentions          :: Maybe AllowedMentions+  , -- | If `Just`, reply to the message referenced+    messageDetailedReference                :: Maybe MessageReference+  , -- | Message components for the message+    messageDetailedComponents               :: Maybe [ActionRow]+  , -- | IDs of up to 3 `Sticker` in the server to send with the message+    messageDetailedStickerIds               :: Maybe [StickerId]   } deriving (Show, Read, Eq, Ord)  instance Default MessageDetailedOpts where@@ -152,7 +159,7 @@                             , messageDetailedStickerIds      = Nothing                             } --- | Data constructor for GetReaction requests+-- | Data constructor for `GetReactions` requests data ReactionTiming = BeforeReaction MessageId                     | AfterReaction MessageId                     | LatestReaction@@ -164,7 +171,9 @@   (AfterReaction snow) -> "after"  R.=: show snow   (LatestReaction) -> mempty --- | Data constructor for GetChannelMessages requests. See <https://discord.com/developers/docs/resources/channel#get-channel-messages>+-- | Data constructor for `GetChannelMessages` requests.+-- +-- See <https://discord.com/developers/docs/resources/channel#get-channel-messages> data MessageTiming = AroundMessage MessageId                    | BeforeMessage MessageId                    | AfterMessage MessageId@@ -178,11 +187,17 @@   (AfterMessage snow) -> "after"  R.=: show snow   (LatestMessages) -> mempty +-- | Options for `CreateChannelInvite` requests data ChannelInviteOpts = ChannelInviteOpts-  { channelInviteOptsMaxAgeSeconds          :: Maybe Integer-  , channelInviteOptsMaxUsages              :: Maybe Integer-  , channelInviteOptsIsTemporary            :: Maybe Bool-  , channelInviteOptsDontReuseSimilarInvite :: Maybe Bool+  { -- | How long the invite is valid for (in seconds)+    channelInviteOptsMaxAgeSeconds          :: Maybe Integer+  , -- | How many uses the invite is valid for+    channelInviteOptsMaxUsages              :: Maybe Integer+  , -- | Whether this invite only grants temporary membership+    channelInviteOptsIsTemporary            :: Maybe Bool+  , -- | Don't reuse a similar invite. Useful for creating many unique one time+    -- use invites+    channelInviteOptsDontReuseSimilarInvite :: Maybe Bool   } deriving (Show, Read, Eq, Ord)  instance ToJSON ChannelInviteOpts where@@ -192,24 +207,46 @@                           ("temporary", toJSON <$> channelInviteOptsIsTemporary),                           ("unique",    toJSON <$> channelInviteOptsDontReuseSimilarInvite) ] ] +-- | Options for `ModifyChannel` requests data ModifyChannelOpts = ModifyChannelOpts-  { modifyChannelName                 :: Maybe T.Text-  , modifyChannelPosition             :: Maybe Integer-  , modifyChannelTopic                :: Maybe T.Text-  , modifyChannelNSFW                 :: Maybe Bool-  , modifyChannelBitrate              :: Maybe Integer-  , modifyChannelUserRateLimit        :: Maybe Integer-  , modifyChannelPermissionOverwrites :: Maybe [Overwrite]-  , modifyChannelParentId             :: Maybe ChannelId-  , modifyChannelDefaultAutoArchive   :: Maybe Integer-  , modifyChannelThreadArchived       :: Maybe Bool-  , modifyChannelThreadAutoArchive    :: Maybe Integer-  , modifyChannelThreadLocked         :: Maybe Bool-  , modifyChannelThreadInvitiable     :: Maybe Bool+  { -- | (All) The name of the channel (max 100 characters)+    modifyChannelName                 :: Maybe T.Text+  , -- | (All) Position of the channel in the listing+    modifyChannelPosition             :: Maybe Integer+  , -- | (Text) The channel topic text (max 1024 characters)+    modifyChannelTopic                :: Maybe T.Text+  , -- | (Text) Wether the channel is tagged as NSFW+    modifyChannelNSFW                 :: Maybe Bool+  , -- | (Voice) Bitrate (in bps) of a voice channel. Min 8000, max 96000+    -- (128000 for boosted servers)+    modifyChannelBitrate              :: Maybe Integer+  , -- | (Text) The rate limit of the channel, in seconds (0-21600), does not+    -- affect bots and users with @manage_channel@ or @manage_messages@+    -- permissons+    modifyChannelUserRateLimit        :: Maybe Integer+  , -- | (Voice) the user limit of the voice channel, max 99+    modifyChannelUserLimit            :: Maybe Integer+  , -- | (All) The channel permissions+    modifyChannelPermissionOverwrites :: Maybe [Overwrite]+  , -- | (All) The parent category of the channel+    modifyChannelParentId             :: Maybe ChannelId+  , -- | (Text) Auto-archive duration for Threads+    modifyChannelDefaultAutoArchive   :: Maybe Integer+  , -- | (Thread) Whether the thread is archived+    modifyChannelThreadArchived       :: Maybe Bool+  , -- | (Thread) duration in minutes to automatically archive the thread after+    -- recent activity, can be set to: 60, 1440, 4320 or 10080+    modifyChannelThreadAutoArchive    :: Maybe Integer+  , -- | (Thread) Whether the thread is locked. When a thread is locked, only+    -- users with @manage_threads@ can unarchive it+    modifyChannelThreadLocked         :: Maybe Bool+  , -- | (Thread) Whether non-moderators can add other non-moderators to a+    -- thread. Only available on private threads+    modifyChannelThreadInvitable     :: Maybe Bool   } deriving (Show, Read, Eq, Ord)  instance Default ModifyChannelOpts where-  def = ModifyChannelOpts Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing+  def = ModifyChannelOpts Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing  instance ToJSON ModifyChannelOpts where   toJSON ModifyChannelOpts{..} = object [(name, val) | (name, Just val) <-@@ -218,45 +255,53 @@                 ("topic",      toJSON <$> modifyChannelTopic),                 ("nsfw",       toJSON <$> modifyChannelNSFW),                 ("bitrate",    toJSON <$> modifyChannelBitrate),-                ("user_limit", toJSON <$> modifyChannelUserRateLimit),+                ("rate_limit_per_user", toJSON <$> modifyChannelUserRateLimit),+                ("user_limit", toJSON <$> modifyChannelUserLimit),                 ("permission_overwrites",  toJSON <$> modifyChannelPermissionOverwrites),                 ("parent_id",  toJSON <$> modifyChannelParentId),                 ("default_auto_archive_duration",  toJSON <$> modifyChannelDefaultAutoArchive),                 ("archived",  toJSON <$> modifyChannelThreadArchived),                 ("auto_archive_duration",  toJSON <$> modifyChannelThreadAutoArchive),                 ("locked",  toJSON <$> modifyChannelThreadLocked),-                ("invitable",  toJSON <$> modifyChannelThreadInvitiable) ] ]+                ("invitable",  toJSON <$> modifyChannelThreadInvitable) ] ] +-- | Options for The `EditChannelPermissions` request+--+-- Since the JSON encoding of this datatype will require information in the+-- route (the Either decides whether the overwrite is for a user or a role), we+-- do not provide a ToJSON instance. Instead, the JSON is manually constructed+-- in the 'channelJsonRequest' function. data ChannelPermissionsOpts = ChannelPermissionsOpts-  { channelPermissionsOptsAllow :: Integer-  , channelPermissionsOptsDeny :: Integer-  , channelPermissionsOptsType :: ChannelPermissionsOptsType+  { -- | The permission integer for the explicitly allowed permissions+    channelPermissionsOptsAllow :: Integer+  , -- | The permission integer for the explicitly denied permissions+    channelPermissionsOptsDeny :: Integer   } deriving (Show, Read, Eq, Ord) -data ChannelPermissionsOptsType = ChannelPermissionsOptsUser-                                | ChannelPermissionsOptsRole-  deriving (Show, Read, Eq, Ord)--instance ToJSON ChannelPermissionsOptsType where-  toJSON t = case t of ChannelPermissionsOptsUser -> String "member"-                       ChannelPermissionsOptsRole -> String "role"--instance ToJSON ChannelPermissionsOpts where-  toJSON (ChannelPermissionsOpts a d t) = object [ ("allow", toJSON a )-                                                 , ("deny", toJSON d)-                                                 , ("type", toJSON t)]---- | https://discord.com/developers/docs/resources/channel#group-dm-add-recipient+-- | Options for `GroupDMAddRecipient` request+--+-- See <https://discord.com/developers/docs/resources/channel#group-dm-add-recipient> data GroupDMAddRecipientOpts = GroupDMAddRecipientOpts-  { groupDMAddRecipientUserToAdd :: UserId-  , groupDMAddRecipientUserToAddNickName :: T.Text-  , groupDMAddRecipientGDMJoinAccessToken :: T.Text+  { -- | The id of the user to add to the Group DM+    groupDMAddRecipientUserToAdd :: UserId+  , -- | The nickname given to the user being added+    groupDMAddRecipientUserToAddNickName :: T.Text+  , -- | Access token of the user. That user must have granted your app the+    -- @gdm.join@ scope.+    groupDMAddRecipientGDMJoinAccessToken :: T.Text   } deriving (Show, Read, Eq, Ord) +-- | Options for `StartThreadFromMessage` request data StartThreadOpts = StartThreadOpts -  { startThreadName :: T.Text-  , startThreadAutoArchive :: Maybe Integer -- ^ can be one of 60, 1440, 4320, 10080-  , startThreadRateLimit :: Maybe Integer+  { -- | Name of the thread+    startThreadName :: T.Text+  , -- | Period of innactivity after which the thread gets archived in minutes.+    -- +    -- Can be one of 60, 1440, 4320, 10080+    startThreadAutoArchive :: Maybe Integer+  , -- | Amount of seconds a user has to wait before sending another message+    -- (0-21600)+    startThreadRateLimit :: Maybe Integer   } deriving (Show, Read, Eq, Ord)  instance ToJSON StartThreadOpts where@@ -267,10 +312,18 @@       ]     ] +-- | Options for `StartThreadNoMessage` request data StartThreadNoMessageOpts = StartThreadNoMessageOpts-  { startThreadNoMessageBaseOpts :: StartThreadOpts-  , startThreadNoMessageType :: Integer -- ^ 10, 11, or 12 (https://discord.com/developers/docs/resources/channel#channel-object-channel-types)-  , startThreadNoMessageInvitable :: Maybe Bool+  { -- | Base options for the thread+    startThreadNoMessageBaseOpts :: StartThreadOpts+  , -- | The type of thread to create+    --+    -- Can be @10@, @11@, or @12@. See+    -- <https://discord.com/developers/docs/resources/channel#channel-object-channel-types>+    startThreadNoMessageType :: Integer+  , -- | Whether non-moderators can add other non-moderators to a thread. Only+    -- available when creating a private thread.+    startThreadNoMessageInvitable :: Maybe Bool   } deriving (Show, Read, Eq, Ord)  instance ToJSON StartThreadNoMessageOpts where@@ -283,10 +336,16 @@       ]     ] +-- | Result type of `ListJoinedPrivateArchivedThreads`,+-- `ListPrivateArchivedThreads` and `ListPublicArchivedThreads` data ListThreads = ListThreads -  { listThreadsThreads :: [Channel]-  , listThreadsMembers :: [ThreadMember]-  , listThreadsHasMore :: Bool -- ^ whether there is more data to retrieve+  { -- | The returned threads+    listThreadsThreads :: [Channel]+  , -- | A thread member object for each returned thread the current user has+    -- joined+    listThreadsMembers :: [ThreadMember]+  ,  -- | Whether there is more data to retrieve+    listThreadsHasMore :: Bool   } deriving (Show, Read, Eq, Ord)  instance ToJSON ListThreads where@@ -357,26 +416,26 @@ channelJsonRequest :: ChannelRequest r -> JsonRequest channelJsonRequest c = case c of   (GetChannel chan) ->-      Get (channels // chan) mempty+      Get (channels /~ chan) mempty    (ModifyChannel chan patch) ->-      Patch (channels // chan) (pure (R.ReqBodyJson patch)) mempty+      Patch (channels /~ chan) (pure (R.ReqBodyJson patch)) mempty    (DeleteChannel chan) ->-      Delete (channels // chan) mempty+      Delete (channels /~ chan) mempty    (GetChannelMessages chan (n,timing)) ->       let n' = max 1 (min 100 n)           options = "limit" R.=: n' <> messageTimingToQuery timing-      in Get (channels // chan /: "messages") options+      in Get (channels /~ chan /: "messages") options    (GetChannelMessage (chan, msg)) ->-      Get (channels // chan /: "messages" // msg) mempty+      Get (channels /~ chan /: "messages" /~ msg) mempty    (CreateMessage chan msg) ->       let content = ["content" .= msg]           body = pure $ R.ReqBodyJson $ object content-      in Post (channels // chan /: "messages") body mempty+      in Post (channels /~ chan /: "messages") body mempty    (CreateMessageDetailed chan msgOpts) ->     let fileUpload = messageDetailedFile msgOpts@@ -404,33 +463,33 @@         payloadPart = partBS "payload_json" $ BL.toStrict $ encode payloadData          body = R.reqBodyMultipart (payloadPart : filePart)-      in Post (channels // chan /: "messages") body mempty+      in Post (channels /~ chan /: "messages") body mempty    (CreateReaction (chan, msgid) emoji) ->       let e = cleanupEmoji emoji-      in Put (channels // chan /: "messages" // msgid /: "reactions" /: e /: "@me" )+      in Put (channels /~ chan /: "messages" /~ msgid /: "reactions" /: e /: "@me" )              R.NoReqBody mempty    (DeleteOwnReaction (chan, msgid) emoji) ->       let e = cleanupEmoji emoji-      in Delete (channels // chan /: "messages" // msgid /: "reactions" /: e /: "@me" ) mempty+      in Delete (channels /~ chan /: "messages" /~ msgid /: "reactions" /: e /: "@me" ) mempty    (DeleteUserReaction (chan, msgid) uID emoji) ->       let e = cleanupEmoji emoji-      in Delete (channels // chan /: "messages" // msgid /: "reactions" /: e // uID ) mempty+      in Delete (channels /~ chan /: "messages" /~ msgid /: "reactions" /: e /~ uID ) mempty    (DeleteSingleReaction (chan, msgid) emoji) ->     let e = cleanupEmoji emoji-    in Delete (channels // chan /: "messages" // msgid /: "reactions" /: e) mempty+    in Delete (channels /~ chan /: "messages" /~ msgid /: "reactions" /: e) mempty    (GetReactions (chan, msgid) emoji (n, timing)) ->       let e = cleanupEmoji emoji           n' = max 1 (min 100 n)           options = "limit" R.=: n' <> reactionTimingToQuery timing-      in Get (channels // chan /: "messages" // msgid /: "reactions" /: e) options+      in Get (channels /~ chan /: "messages" /~ msgid /: "reactions" /: e) options    (DeleteAllReactions (chan, msgid)) ->-      Delete (channels // chan /: "messages" // msgid /: "reactions" ) mempty+      Delete (channels /~ chan /: "messages" /~ msgid /: "reactions" ) mempty    -- copied from CreateMessageDetailed, should be outsourced to function probably   (EditMessage (chan, msg) msgOpts) ->      @@ -459,90 +518,93 @@         payloadPart = partBS "payload_json" $ BL.toStrict $ encode payloadData          body = R.reqBodyMultipart (payloadPart : filePart)-      in Patch (channels // chan /: "messages" // msg) body mempty+      in Patch (channels /~ chan /: "messages" /~ msg) body mempty    (DeleteMessage (chan, msg)) ->-      Delete (channels // chan /: "messages" // msg) mempty+      Delete (channels /~ chan /: "messages" /~ msg) mempty    (BulkDeleteMessage (chan, msgs)) ->       let body = pure . R.ReqBodyJson $ object ["messages" .= msgs]-      in Post (channels // chan /: "messages" /: "bulk-delete") body mempty+      in Post (channels /~ chan /: "messages" /: "bulk-delete") body mempty -  (EditChannelPermissions chan perm patch) ->-      Put (channels // chan /: "permissions" // perm) (R.ReqBodyJson patch) mempty+  (EditChannelPermissions chan overwriteId (ChannelPermissionsOpts a d)) ->+      let body = R.ReqBodyJson $ object [("type", toJSON $ (either (const 0) (const 1) overwriteId :: Int))+                                        ,("allow", toJSON a)+                                        ,("deny", toJSON d)]+      in Put (channels /~ chan /: "permissions" /~ either unId unId overwriteId) body mempty    (GetChannelInvites chan) ->-      Get (channels // chan /: "invites") mempty+      Get (channels /~ chan /: "invites") mempty    (CreateChannelInvite chan patch) ->-      Post (channels // chan /: "invites") (pure (R.ReqBodyJson patch)) mempty+      Post (channels /~ chan /: "invites") (pure (R.ReqBodyJson patch)) mempty -  (DeleteChannelPermission chan perm) ->-      Delete (channels // chan /: "permissions" // perm) mempty+  (DeleteChannelPermission chan overwriteId) ->+      Delete (channels /~ chan /: "permissions" /~ either unId unId overwriteId) mempty    (TriggerTypingIndicator chan) ->-      Post (channels // chan /: "typing") (pure R.NoReqBody) mempty+      Post (channels /~ chan /: "typing") (pure R.NoReqBody) mempty    (GetPinnedMessages chan) ->-      Get (channels // chan /: "pins") mempty+      Get (channels /~ chan /: "pins") mempty    (AddPinnedMessage (chan, msg)) ->-      Put (channels // chan /: "pins" // msg) R.NoReqBody mempty+      Put (channels /~ chan /: "pins" /~ msg) R.NoReqBody mempty    (DeletePinnedMessage (chan, msg)) ->-      Delete (channels // chan /: "pins" // msg) mempty+      Delete (channels /~ chan /: "pins" /~ msg) mempty    (GroupDMAddRecipient chan (GroupDMAddRecipientOpts uid nick tok)) ->-      Put (channels // chan // chan /: "recipients" // uid)+      Put (channels /~ chan /~ chan /: "recipients" /~ uid)           (R.ReqBodyJson (object [ ("access_token", toJSON tok)                                  , ("nick", toJSON nick)]))           mempty    (GroupDMRemoveRecipient chan userid) ->-      Delete (channels // chan // chan /: "recipients" // userid) mempty+      Delete (channels /~ chan /~ chan /: "recipients" /~ userid) mempty    (StartThreadFromMessage chan mid sto) ->-      Post (channels // chan /: "messages" // mid /: "threads")+      Post (channels /~ chan /: "messages" /~ mid /: "threads")            (pure $ R.ReqBodyJson $ toJSON sto)            mempty    (StartThreadNoMessage chan sto) ->-      Post (channels // chan /: "messages" /: "threads")+      Post (channels /~ chan /: "messages" /: "threads")            (pure $ R.ReqBodyJson $ toJSON sto)            mempty    (JoinThread chan) ->-      Put (channels // chan /: "thread-members" /: "@me")+      Put (channels /~ chan /: "thread-members" /: "@me")           R.NoReqBody mempty    (AddThreadMember chan uid) ->-      Put (channels // chan /: "thread-members" // uid)+      Put (channels /~ chan /: "thread-members" /~ uid)           R.NoReqBody mempty    (LeaveThread chan) ->-      Delete (channels // chan /: "thread-members" /: "@me")+      Delete (channels /~ chan /: "thread-members" /: "@me")           mempty    (RemoveThreadMember chan uid) ->-      Delete (channels // chan /: "thread-members" // uid)+      Delete (channels /~ chan /: "thread-members" /~ uid)           mempty    (GetThreadMember chan uid) ->-      Get (channels // chan /: "thread-members" // uid)+      Get (channels /~ chan /: "thread-members" /~ uid)           mempty    (ListThreadMembers chan) ->-      Get (channels // chan /: "thread-members")+      Get (channels /~ chan /: "thread-members")           mempty    (ListPublicArchivedThreads chan (time, lim)) ->-      Get (channels // chan /: "threads" /: "archived" /: "public")+      Get (channels /~ chan /: "threads" /: "archived" /: "public")           (maybe mempty ("limit" R.=:) lim <> maybe mempty ("before" R.=:) time)    (ListPrivateArchivedThreads chan (time, lim)) ->-      Get (channels // chan /: "threads" /: "archived" /: "private")+      Get (channels /~ chan /: "threads" /: "archived" /: "private")           (maybe mempty ("limit" R.=:) lim <> maybe mempty ("before" R.=:) time)    (ListJoinedPrivateArchivedThreads chan (time, lim)) ->-      Get (channels // chan /: "users" /: "@me" /: "threads" /: "archived" /: "private")+      Get (channels /~ chan /: "users" /: "@me" /: "threads" /: "archived" /: "private")           (maybe mempty ("limit" R.=:) lim <> maybe mempty ("before" R.=:) time)

@@ -9,13 +9,13 @@   ( EmojiRequest (..),     ModifyGuildEmojiOpts (..),     parseEmojiImage,+    parseStickerImage,     StickerRequest (..),     CreateGuildStickerOpts (..),     EditGuildStickerOpts (..)   ) where -import Codec.Picture import Data.Aeson import qualified Data.ByteString as B import qualified Data.ByteString.Base64 as B64@@ -23,7 +23,7 @@ import qualified Data.Text.Encoding as TE import Discord.Internal.Rest.Prelude import Discord.Internal.Types-import Network.HTTP.Req ((/:))+import Network.HTTP.Req ((/:), (/~)) import qualified Network.HTTP.Req as R  instance Request (EmojiRequest a) where@@ -37,7 +37,7 @@   -- | Emoji object for the given guild and emoji ID   GetGuildEmoji :: GuildId -> EmojiId -> EmojiRequest Emoji   -- | Create a new guild emoji (static&animated). Requires MANAGE_EMOJIS permission.-  CreateGuildEmoji :: GuildId -> T.Text -> EmojiImageParsed -> EmojiRequest Emoji+  CreateGuildEmoji :: GuildId -> T.Text -> Base64Image Emoji -> EmojiRequest Emoji   -- | Requires MANAGE_EMOJIS permission   ModifyGuildEmoji :: GuildId -> EmojiId -> ModifyGuildEmojiOpts -> EmojiRequest Emoji   -- | Requires MANAGE_EMOJIS permission@@ -53,46 +53,20 @@   toJSON (ModifyGuildEmojiOpts name roles) =     object ["name" .= name, "roles" .= roles] -newtype EmojiImageParsed = EmojiImageParsed T.Text-  deriving (Show, Read, Eq, Ord) -parseEmojiImage :: B.ByteString -> Either T.Text EmojiImageParsed-parseEmojiImage bs =-  if B.length bs > 256000-    then Left "Cannot create emoji - File is larger than 256kb"-    else case (decodeGifImages bs, decodeImage bs) of-      (Left e1, Left e2) ->-        Left-          ( "Could not parse image or gif: " <> T.pack e1-              <> " and "-              <> T.pack e2-          )-      (Right ims, _) ->-        if all is128 ims-          then-            Right-              ( EmojiImageParsed-                  ( "data:text/plain;"-                      <> "base64,"-                      <> TE.decodeUtf8 (B64.encode bs)-                  )-              )-          else Left "The frames are not all 128x128"-      (_, Right im) ->-        if is128 im-          then-            Right-              ( EmojiImageParsed-                  ( "data:text/plain;"-                      <> "base64,"-                      <> TE.decodeUtf8 (B64.encode bs)-                  )-              )-          else Left "Image is not 128x128"-  where-    is128 im =-      let i = convertRGB8 im-       in imageWidth i == 128 && imageHeight i == 128+-- | @parseEmojiImage bs@ will attempt to convert the given image bytestring @bs@+-- to the base64 format expected by the Discord API. It may return Left with an+-- error reason if either the bytestring is too large, or if the image format+-- could not be predetermined from the opening few bytes. This function does+-- /not/ validate the rest of the image, nor check that its dimensions are+-- 128x128 as required by Discord. This is up to the library user to check.+--+-- This function accepts all file types accepted by 'getMimeType'.+parseEmojiImage :: B.ByteString -> Either T.Text (Base64Image Emoji)+parseEmojiImage bs+  | B.length bs > 256000        = Left "Cannot create emoji - File is larger than 256kb"+  | Just mime <- getMimeType bs = Right (Base64Image mime (TE.decodeUtf8 (B64.encode bs)))+  | otherwise                   = Left "Unsupported image format provided"  emojiMajorRoute :: EmojiRequest a -> String emojiMajorRoute c = case c of@@ -107,16 +81,16 @@  emojiJsonRequest :: EmojiRequest r -> JsonRequest emojiJsonRequest c = case c of-  (ListGuildEmojis g) -> Get (guilds // g /: "emojis") mempty-  (GetGuildEmoji g e) -> Get (guilds // g /: "emojis" // e) mempty-  (CreateGuildEmoji g name (EmojiImageParsed im)) ->+  (ListGuildEmojis g) -> Get (guilds /~ g /: "emojis") mempty+  (GetGuildEmoji g e) -> Get (guilds /~ g /: "emojis" /~ e) mempty+  (CreateGuildEmoji g name b64im) ->     Post-      (guilds // g /: "emojis")+      (guilds /~ g /: "emojis")       ( pure           ( R.ReqBodyJson               ( object                   [ "name" .= name,-                    "image" .= im+                    "image" .= b64im                     -- todo , "roles" .= ...                   ]               )@@ -125,39 +99,46 @@       mempty   (ModifyGuildEmoji g e o) ->     Patch-      (guilds // g /: "emojis" // e)+      (guilds /~ g /: "emojis" /~ e)       (pure (R.ReqBodyJson o))       mempty-  (DeleteGuildEmoji g e) -> Delete (guilds // g /: "emojis" // e) mempty--data StickerData = StickerDataPNG {stickerData :: B.ByteString} | StickerDataAPNG {stickerData :: B.ByteString} | StickerDataLOTTIE {stickerData :: B.ByteString}-  deriving (Show, Read, Eq, Ord)+  (DeleteGuildEmoji g e) -> Delete (guilds /~ g /: "emojis" /~ e) mempty -instance ToJSON StickerData where-  toJSON sd = String $ "data:image/" <> sdt <> ";base64," <> TE.decodeUtf8 (B64.encode (stickerData sd))-    where-      sdt = case sd of-        StickerDataPNG _ -> "png"-        StickerDataAPNG _ -> "apng"-        StickerDataLOTTIE _ -> "lottie"+-- | @parseStickerImage bs@ accepts PNG, APNG, or Lottie JSON bytestring @bs@ and+-- will attempt to convert it to the base64 format expected by the Discord API.+-- It may return Left with an error reason if the image format is unexpected.+-- This function does /not/ validate the contents of the image, this is up to+-- the library user to check.+parseStickerImage :: B.ByteString -> Either T.Text (Base64Image Sticker)+parseStickerImage bs+  | B.length bs > 512000+  = Left "Cannot create sticker - File is larger than 512kb"+  | Just "image/png" <- getMimeType bs+  = Right (Base64Image "image/png" (TE.decodeUtf8 (B64.encode bs)))+  | not (B.null bs) && B.head bs == 0x7b -- '{'+  = Right (Base64Image "application/json" (TE.decodeUtf8 (B64.encode bs)))+  | otherwise+  = Left "Unsupported image format provided" +-- | Options for `CreateGuildSticker` data CreateGuildStickerOpts = CreateGuildStickerOpts   { guildStickerName :: T.Text,     guildStickerDescription :: T.Text,     guildStickerTags :: [T.Text],-    guildStickerFile :: StickerData+    guildStickerFile :: Base64Image Sticker   }   deriving (Show, Read, Eq, Ord)  instance ToJSON CreateGuildStickerOpts where-  toJSON CreateGuildStickerOpts {..} =+  toJSON (CreateGuildStickerOpts name desc tags b64im) =     object-      [ ("name", toJSON guildStickerName),-        ("description", toJSON guildStickerDescription),-        ("tags", toJSON . T.intercalate "," $ guildStickerTags),-        ("file", toJSON guildStickerFile)+      [ ("name", toJSON name),+        ("description", toJSON desc),+        ("tags", toJSON $ T.intercalate "," tags),+        ("file", toJSON b64im)       ] +-- | Options for `ModifyGuildSticker` data EditGuildStickerOpts = EditGuildStickerOpts   { editGuildStickerName :: Maybe T.Text,     editGuildStickerDescription :: Maybe T.Text,@@ -212,12 +193,12 @@  stickerJsonRequest :: StickerRequest a -> JsonRequest stickerJsonRequest = \case-  GetSticker gid -> Get (baseUrl /: "stickers" // gid) mempty+  GetSticker gid -> Get (baseUrl /: "stickers" /~ gid) mempty   ListNitroStickerPacks -> Get (baseUrl /: "sticker-packs") mempty   ListGuildStickers gid -> Get (stickersGuild gid) mempty-  GetGuildSticker gid sid -> Get (stickersGuild gid // sid) mempty+  GetGuildSticker gid sid -> Get (stickersGuild gid /~ sid) mempty   CreateGuildSticker gid cgso -> Post (stickersGuild gid) (pure $ R.ReqBodyJson $ toJSON cgso) mempty-  ModifyGuildSticker gid sid egso -> Patch (stickersGuild gid // sid) (pure $ R.ReqBodyJson egso) mempty-  DeleteGuildSticker gid sid -> Delete (stickersGuild gid // sid) mempty+  ModifyGuildSticker gid sid egso -> Patch (stickersGuild gid /~ sid) (pure $ R.ReqBodyJson egso) mempty+  DeleteGuildSticker gid sid -> Delete (stickersGuild gid /~ sid) mempty   where-    stickersGuild gid = baseUrl /: "guilds" // gid /: "stickers"+    stickersGuild gid = baseUrl /: "guilds" /~ gid /: "stickers"

@@ -20,7 +20,7 @@   import Data.Aeson-import Network.HTTP.Req ((/:))+import Network.HTTP.Req ((/:), (/~)) import qualified Network.HTTP.Req as R import qualified Data.Text as T @@ -141,6 +141,7 @@   -- | Vanity URL   GetGuildVanityURL        :: GuildId -> GuildRequest T.Text +-- | Options for `ModifyGuildIntegration` data ModifyGuildIntegrationOpts = ModifyGuildIntegrationOpts   { modifyGuildIntegrationOptsExpireBehavior :: Integer   , modifyGuildIntegrationOptsExpireGraceSeconds :: Integer@@ -153,6 +154,7 @@          , ("expire_behavior", toJSON <$> pure modifyGuildIntegrationOptsExpireBehavior )          , ("enable_emoticons", toJSON <$> pure modifyGuildIntegrationOptsEmoticonsEnabled ) ]] +-- | Options for `CreateGuildIntegration` data CreateGuildIntegrationOpts = CreateGuildIntegrationOpts   { createGuildIntegrationOptsType :: T.Text   } deriving (Show, Read, Eq, Ord)@@ -161,6 +163,7 @@   toJSON CreateGuildIntegrationOpts{..} =  object [(name, val) | (name, Just val) <-                        [("type", toJSON <$> pure createGuildIntegrationOptsType ) ]] +-- | Options for `CreateGuildBan` data CreateGuildBanOpts = CreateGuildBanOpts   { createGuildBanOptsDeleteLastNMessages :: Maybe Int   , createGuildBanOptsReason              :: Maybe T.Text@@ -172,6 +175,7 @@                              toJSON <$> createGuildBanOptsDeleteLastNMessages ),                         ("reason", toJSON <$> createGuildBanOptsReason )]] +-- | Options for `ModifyGuildRole` data ModifyGuildRoleOpts = ModifyGuildRoleOpts   { modifyGuildRoleOptsName            :: Maybe T.Text   , modifyGuildRoleOptsPermissions     :: Maybe T.Text@@ -188,6 +192,7 @@                         ("hoist",       toJSON <$> modifyGuildRoleOptsSeparateSidebar ),                         ("mentionable", toJSON <$> modifyGuildRoleOptsMentionable )]] +-- | Options for `AddGuildMember` data AddGuildMemberOpts = AddGuildMemberOpts   { addGuildMemberOptsAccessToken :: T.Text   , addGuildMemberOptsNickname    :: Maybe T.Text@@ -204,6 +209,7 @@                                    ("mute",   toJSON <$> addGuildMemberOptsIsMuted ),                                    ("deaf",   toJSON <$> addGuildMemberOptsIsDeafened )]] +-- | Options for `ModifyGuildMember` data ModifyGuildMemberOpts = ModifyGuildMemberOpts   { modifyGuildMemberOptsNickname      :: Maybe T.Text   , modifyGuildMemberOptsRoles         :: Maybe [RoleId]@@ -225,19 +231,24 @@                                    ("channel_id", toJSON <$> modifyGuildMemberOptsMoveToChannel),                                    ("communication_disabled_until", toJSON <$> modifyGuildMemberOptsTimeoutUntil)]] +-- | Options for `CreateGuildChannel` data CreateGuildChannelOpts+  -- | Create a text channel   = CreateGuildChannelOptsText {     createGuildChannelOptsTopic :: Maybe T.Text   , createGuildChannelOptsUserMessageRateDelay :: Maybe Integer   , createGuildChannelOptsIsNSFW :: Maybe Bool   , createGuildChannelOptsCategoryId :: Maybe ChannelId }+  -- | Create a voice channel   | CreateGuildChannelOptsVoice {     createGuildChannelOptsBitrate :: Maybe Integer   , createGuildChannelOptsMaxUsers :: Maybe Integer   , createGuildChannelOptsCategoryId :: Maybe ChannelId }+  -- | Create a category   | CreateGuildChannelOptsCategory   deriving (Show, Read, Eq, Ord) +-- | Converts a channel name, a list of permissions and other channel options into a JSON Value  createChannelOptsToJSON :: T.Text -> [Overwrite] -> CreateGuildChannelOpts -> Value createChannelOptsToJSON name perms opts = object [(key, val) | (key, Just val) <- optsJSON]   where@@ -263,7 +274,9 @@                           ,("permission_overwrites", toJSON <$> Just perms)]  --- | https://discord.com/developers/docs/resources/guild#modify-guild+-- | Options for `ModifyGuild`+--+-- See <https://discord.com/developers/docs/resources/guild#modify-guild> data ModifyGuildOpts = ModifyGuildOpts   { modifyGuildOptsName         :: Maybe T.Text   , modifyGuildOptsAFKChannelId :: Maybe ChannelId@@ -342,113 +355,113 @@ guildJsonRequest :: GuildRequest r -> JsonRequest guildJsonRequest c = case c of   (GetGuild guild) ->-      Get (guilds // guild) mempty+      Get (guilds /~ guild) mempty    (ModifyGuild guild patch) ->-      Patch (guilds // guild) (pure (R.ReqBodyJson patch)) mempty+      Patch (guilds /~ guild) (pure (R.ReqBodyJson patch)) mempty    (DeleteGuild guild) ->-      Delete (guilds // guild) mempty+      Delete (guilds /~ guild) mempty    (GetGuildChannels guild) ->-      Get (guilds // guild /: "channels") mempty+      Get (guilds /~ guild /: "channels") mempty    (CreateGuildChannel guild name perms patch) ->-      Post (guilds // guild /: "channels")+      Post (guilds /~ guild /: "channels")            (pure (R.ReqBodyJson (createChannelOptsToJSON name perms patch))) mempty    (ModifyGuildChannelPositions guild newlocs) ->       let patch = map (\(a, b) -> object [("id", toJSON a)                                          ,("position", toJSON b)]) newlocs-      in Patch (guilds // guild /: "channels") (pure (R.ReqBodyJson patch)) mempty+      in Patch (guilds /~ guild /: "channels") (pure (R.ReqBodyJson patch)) mempty    (GetGuildMember guild member) ->-      Get (guilds // guild /: "members" // member) mempty+      Get (guilds /~ guild /: "members" /~ member) mempty    (ListGuildMembers guild range) ->-      Get (guilds // guild /: "members") (guildMembersTimingToQuery range)+      Get (guilds /~ guild /: "members") (guildMembersTimingToQuery range)    (AddGuildMember guild user patch) ->-      Put (guilds // guild /: "members" // user) (R.ReqBodyJson patch) mempty+      Put (guilds /~ guild /: "members" /~ user) (R.ReqBodyJson patch) mempty    (ModifyGuildMember guild member patch) ->-      Patch (guilds // guild /: "members" // member) (pure (R.ReqBodyJson patch)) mempty+      Patch (guilds /~ guild /: "members" /~ member) (pure (R.ReqBodyJson patch)) mempty    (ModifyCurrentUserNick guild name) ->       let patch = object ["nick" .= name]-      in Patch (guilds // guild /: "members/@me/nick") (pure (R.ReqBodyJson patch)) mempty+      in Patch (guilds /~ guild /: "members/@me/nick") (pure (R.ReqBodyJson patch)) mempty    (AddGuildMemberRole guild user role) ->       let body = R.ReqBodyJson (object [])-      in Put (guilds // guild /: "members" // user /: "roles" // role) body mempty+      in Put (guilds /~ guild /: "members" /~ user /: "roles" /~ role) body mempty    (RemoveGuildMemberRole guild user role) ->-      Delete (guilds // guild /: "members" // user /: "roles" // role) mempty+      Delete (guilds /~ guild /: "members" /~ user /: "roles" /~ role) mempty    (RemoveGuildMember guild user) ->-      Delete (guilds // guild /: "members" // user) mempty+      Delete (guilds /~ guild /: "members" /~ user) mempty -  (GetGuildBan guild user) -> Get (guilds // guild /: "bans" // user) mempty+  (GetGuildBan guild user) -> Get (guilds /~ guild /: "bans" /~ user) mempty -  (GetGuildBans guild) -> Get (guilds // guild /: "bans") mempty+  (GetGuildBans guild) -> Get (guilds /~ guild /: "bans") mempty    (CreateGuildBan guild user patch) ->-      Put (guilds // guild /: "bans" // user) (R.ReqBodyJson patch) mempty+      Put (guilds /~ guild /: "bans" /~ user) (R.ReqBodyJson patch) mempty    (RemoveGuildBan guild ban) ->-      Delete (guilds // guild /: "bans" // ban) mempty+      Delete (guilds /~ guild /: "bans" /~ ban) mempty    (GetGuildRoles guild) ->-      Get (guilds // guild /: "roles") mempty+      Get (guilds /~ guild /: "roles") mempty    (CreateGuildRole guild patch) ->-      Post (guilds // guild /: "roles") (pure (R.ReqBodyJson patch)) mempty+      Post (guilds /~ guild /: "roles") (pure (R.ReqBodyJson patch)) mempty    (ModifyGuildRolePositions guild patch) ->       let body = map (\(role, pos) -> object ["id".=role, "position".=pos]) patch-      in Patch (guilds // guild /: "roles") (pure (R.ReqBodyJson body)) mempty+      in Patch (guilds /~ guild /: "roles") (pure (R.ReqBodyJson body)) mempty    (ModifyGuildRole guild role patch) ->-      Patch (guilds // guild /: "roles" // role) (pure (R.ReqBodyJson patch)) mempty+      Patch (guilds /~ guild /: "roles" /~ role) (pure (R.ReqBodyJson patch)) mempty    (DeleteGuildRole guild role) ->-      Delete (guilds // guild /: "roles" // role) mempty+      Delete (guilds /~ guild /: "roles" /~ role) mempty    (GetGuildPruneCount guild days) ->-      Get (guilds // guild /: "prune") ("days" R.=: days)+      Get (guilds /~ guild /: "prune") ("days" R.=: days)    (BeginGuildPrune guild days) ->-      Post (guilds // guild /: "prune") (pure R.NoReqBody) ("days" R.=: days)+      Post (guilds /~ guild /: "prune") (pure R.NoReqBody) ("days" R.=: days)    (GetGuildVoiceRegions guild) ->-      Get (guilds // guild /: "regions") mempty+      Get (guilds /~ guild /: "regions") mempty    (GetGuildInvites guild) ->-      Get (guilds // guild /: "invites") mempty+      Get (guilds /~ guild /: "invites") mempty    (GetGuildIntegrations guild) ->-      Get (guilds // guild /: "integrations") mempty+      Get (guilds /~ guild /: "integrations") mempty    (CreateGuildIntegration guild iid opts) ->       let patch = object [("type" .= createGuildIntegrationOptsType opts) ,("id"   .= iid)]-      in Post (guilds // guild /: "integrations") (pure (R.ReqBodyJson patch)) mempty+      in Post (guilds /~ guild /: "integrations") (pure (R.ReqBodyJson patch)) mempty    (ModifyGuildIntegration guild iid patch) ->       let body = pure (R.ReqBodyJson patch)-      in Patch (guilds // guild /: "integrations" // iid) body mempty+      in Patch (guilds /~ guild /: "integrations" /~ iid) body mempty    (DeleteGuildIntegration guild integ) ->-      Delete (guilds // guild /: "integrations" // integ) mempty+      Delete (guilds /~ guild /: "integrations" /~ integ) mempty    (SyncGuildIntegration guild integ) ->-      Post (guilds // guild /: "integrations" // integ) (pure R.NoReqBody) mempty+      Post (guilds /~ guild /: "integrations" /~ integ) (pure R.NoReqBody) mempty    (GetGuildWidget guild) ->-      Get (guilds // guild /: "integrations") mempty+      Get (guilds /~ guild /: "integrations") mempty    (ModifyGuildWidget guild patch) ->-      Patch (guilds // guild /: "widget") (pure (R.ReqBodyJson patch)) mempty+      Patch (guilds /~ guild /: "widget") (pure (R.ReqBodyJson patch)) mempty    (GetGuildVanityURL guild) ->-      Get (guilds // guild /: "vanity-url") mempty+      Get (guilds /~ guild /: "vanity-url") mempty 

@@ -31,11 +31,17 @@ import Discord.Internal.Types import Discord.Internal.Rest.Prelude -data RestCallInternalException = RestCallInternalErrorCode Int B.ByteString B.ByteString-                               | RestCallInternalNoParse String BL.ByteString-                               | RestCallInternalHttpException R.HttpException+-- | An exception in a Rest call+data RestCallInternalException+  -- | Error code from Discord+  = RestCallInternalErrorCode Int B.ByteString B.ByteString+  -- | Couldn't parse the response+  | RestCallInternalNoParse String BL.ByteString+  -- | Something went bad in the HTTP process+  | RestCallInternalHttpException R.HttpException   deriving (Show) +-- | Rest event loop restLoop :: Auth -> Chan (String, JsonRequest, MVar (Either RestCallInternalException BL.ByteString))                  -> Chan T.Text -> IO () restLoop auth urls log = loop M.empty

@@ -3,26 +3,42 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -module Discord.Internal.Rest.Interactions where+module Discord.Internal.Rest.Interactions (InteractionResponseRequest(..)) where  import Data.Aeson (encode) import qualified Data.ByteString.Lazy as BL import Discord.Internal.Rest.Prelude+    ( RestIO,+      Request(..),+      JsonRequest(Delete, Post, Get, Patch),+      baseUrl) import Discord.Internal.Types import Discord.Internal.Types.Interactions import Network.HTTP.Client.MultipartFormData (PartM, partBS)-import Network.HTTP.Req ((/:))+import Network.HTTP.Req ((/:), (/~)) import qualified Network.HTTP.Req as R-import qualified Data.Text as T +-- | Data constructor for Interaction response requests data InteractionResponseRequest a where+  -- | Create a response to an Interaction from the gateway.+  --+  -- This endpoint also supports file attachments similar to the webhook endpoints.+  -- Refer to [Uploading files](https://discord.com/developers/docs/reference#uploading-files)+  -- for details on uploading files and @multipart/form-data@ requests.   CreateInteractionResponse :: InteractionId -> InteractionToken -> InteractionResponse -> InteractionResponseRequest ()+  -- | Returns the initial Interaction response.   GetOriginalInteractionResponse :: ApplicationId -> InteractionToken -> InteractionResponseRequest Message+  -- | Edits the initial Interaction response.   EditOriginalInteractionResponse :: ApplicationId -> InteractionToken -> InteractionResponseMessage -> InteractionResponseRequest Message+  -- | Deletes the initial Interaction response.   DeleteOriginalInteractionResponse :: ApplicationId -> InteractionToken -> InteractionResponseRequest ()+  -- | Create a followup message for an Interaction   CreateFollowupInteractionMessage :: ApplicationId -> InteractionToken -> InteractionResponseMessage -> InteractionResponseRequest Message+  -- | Returns a followup message for an Interaction.   GetFollowupInteractionMessage :: ApplicationId -> InteractionToken -> MessageId -> InteractionResponseRequest Message+  -- | Edits a followup message for an Interaction.   EditFollowupInteractionMessage :: ApplicationId -> InteractionToken -> MessageId -> InteractionResponse -> InteractionResponseRequest Message+  -- | Deletes a followup message for an Interaction.   DeleteFollowupInteractionMessage :: ApplicationId -> InteractionToken -> MessageId -> InteractionResponseRequest ()  instance Request (InteractionResponseRequest a) where@@ -41,12 +57,12 @@   (DeleteFollowupInteractionMessage aid _ _) -> "intrespf " <> show aid  interaction :: ApplicationId -> InteractionToken -> R.Url 'R.Https-interaction aid it = baseUrl /: "webhooks" // aid /: fromToken it /: "messages"+interaction aid it = baseUrl /: "webhooks" /~ aid /~ it /: "messages"  interactionResponseJsonRequest :: InteractionResponseRequest a -> JsonRequest interactionResponseJsonRequest a = case a of   (CreateInteractionResponse iid it i) ->-    Post (baseUrl /: "interactions" // iid /: fromToken it /: "callback") (convert i) mempty+    Post (baseUrl /: "interactions" /~ iid /~ it /: "callback") (convert i) mempty   (GetOriginalInteractionResponse aid it) ->     Get (interaction aid it /: "@original") mempty   (EditOriginalInteractionResponse aid it i) ->@@ -54,13 +70,13 @@   (DeleteOriginalInteractionResponse aid it) ->     Delete (interaction aid it /: "@original") mempty   (CreateFollowupInteractionMessage aid it i) ->-    Post (baseUrl /: "webhooks" // aid /: fromToken it) (convertIRM i) mempty+    Post (baseUrl /: "webhooks" /~ aid /~ it) (convertIRM i) mempty   (GetFollowupInteractionMessage aid it mid) ->-    Get (interaction aid it // mid) mempty+    Get (interaction aid it /~ mid) mempty   (EditFollowupInteractionMessage aid it mid i) ->-    Patch (interaction aid it // mid) (convert i) mempty+    Patch (interaction aid it /~ mid) (convert i) mempty   (DeleteFollowupInteractionMessage aid it mid) ->-    Delete (interaction aid it // mid) mempty+    Delete (interaction aid it /~ mid) mempty   where     convert :: InteractionResponse -> RestIO R.ReqBodyMultipart     convert ir@(InteractionResponseChannelMessage irm) = R.reqBodyMultipart (partBS "payload_json" (BL.toStrict $ encode ir) : convert' irm)@@ -72,6 +88,3 @@     convert' InteractionResponseMessage {..} = case interactionResponseMessageEmbeds of       Nothing -> []       Just f -> (maybeEmbed . Just) =<< f--fromToken :: InteractionToken -> T.Text-fromToken (InteractionToken t) = t

@@ -12,8 +12,8 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as TE - import qualified Network.HTTP.Req as R+import Web.Internal.HttpApiData (ToHttpApiData)  import Discord.Internal.Types @@ -34,12 +34,13 @@   where   -- | https://discord.com/developers/docs/reference#user-agent   -- Second place where the library version is noted-  agent = "DiscordBot (https://github.com/aquarial/discord-haskell, 1.13.0)"+  agent = "DiscordBot (https://github.com/discord-haskell/discord-haskell, 1.14.0)" --- Append to an URL-infixl 5 //-(//) :: Show a => R.Url scheme -> a -> R.Url scheme-(//) url part = url R./: T.pack (show part)+-- Possibly append to an URL+infixl 5 /?+(/?) :: ToHttpApiData a => R.Url scheme -> Maybe a -> R.Url scheme+(/?) url Nothing = url+(/?) url (Just part) = url R./~ part   -- | A compiled HTTP request ready to execute

@@ -7,19 +7,16 @@ -- | Provides actions for Channel API interactions module Discord.Internal.Rest.User   ( UserRequest(..)-  , parseCurrentUserAvatar-  , CurrentUserAvatar+  , parseAvatarImage   ) where   import Data.Aeson-import Codec.Picture-import Network.HTTP.Req ((/:))+import Network.HTTP.Req ((/:), (/~)) import qualified Network.HTTP.Req as R import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Base64 as B64  import Discord.Internal.Rest.Prelude@@ -39,7 +36,7 @@   -- | Returns a 'User' for a given user ID   GetUser              :: UserId -> UserRequest User   -- | Modify user's username & avatar pic-  ModifyCurrentUser    :: T.Text -> CurrentUserAvatar -> UserRequest User+  ModifyCurrentUser    :: T.Text -> Base64Image User -> UserRequest User   -- | Returns a list of user 'Guild' objects the current user is a member of.   --   Requires the guilds OAuth2 scope.   GetCurrentUserGuilds :: UserRequest [PartialGuild]@@ -52,17 +49,17 @@    GetUserConnections   :: UserRequest [ConnectionObject] --- | Formatted avatar data https://discord.com/developers/docs/resources/user#avatar-data-data CurrentUserAvatar = CurrentUserAvatar T.Text-  deriving (Show, Read, Eq, Ord)--parseCurrentUserAvatar :: B.ByteString -> Either T.Text CurrentUserAvatar-parseCurrentUserAvatar bs =-  case decodeImage bs of-    Left e -> Left (T.pack e)-    Right im -> Right $ CurrentUserAvatar $ "data:image/png;base64,"-                <> TE.decodeUtf8 (B64.encode (BL.toStrict (encodePng (convertRGBA8 im))))-+-- | @parseAvatarImage bs@ will attempt to convert the given image bytestring+-- @bs@ to the base64 format expected by the Discord API. It may return Left+-- with an error reason if the image format could not be predetermined from the+-- opening magic bytes. This function does /not/ validate the rest of the image,+-- and this is up to the library user to check themselves.+--+-- This function accepts all file types accepted by 'getMimeType'.+parseAvatarImage :: B.ByteString -> Either T.Text (Base64Image User)+parseAvatarImage bs+  | Just mime <- getMimeType bs = Right (Base64Image mime (TE.decodeUtf8 (B64.encode bs)))+  | otherwise                   = Left "Unsupported image format provided"  userMajorRoute :: UserRequest a -> String userMajorRoute c = case c of@@ -82,15 +79,15 @@ userJsonRequest c = case c of   (GetCurrentUser) -> Get (users /: "@me") mempty -  (GetUser user) -> Get (users // user ) mempty+  (GetUser user) -> Get (users /~ user ) mempty -  (ModifyCurrentUser name (CurrentUserAvatar im)) ->+  (ModifyCurrentUser name b64im) ->       Patch (users /: "@me")  (pure (R.ReqBodyJson (object [ "username" .= name-                                                           , "avatar" .= im ]))) mempty+                                                           , "avatar" .= b64im ]))) mempty    (GetCurrentUserGuilds) -> Get (users /: "@me" /: "guilds") mempty -  (LeaveGuild guild) -> Delete (users /: "@me" /: "guilds" // guild) mempty+  (LeaveGuild guild) -> Delete (users /: "@me" /: "guilds" /~ guild) mempty    (GetUserDMs) -> Get (users /: "@me" /: "channels") mempty 

@@ -20,8 +20,9 @@   majorRoute = voiceMajorRoute   jsonRequest = voiceJsonRequest --- | Data constructor for requests. See <https://discord.com/developers/docs/resources/ API>+-- | Data constructor for requests data VoiceRequest a where+  -- | List all available 'VoiceRegion's.   ListVoiceRegions :: VoiceRequest [VoiceRegion]  voiceMajorRoute :: VoiceRequest a -> String

@@ -1,7 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE DataKinds #-}-{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} @@ -18,7 +17,7 @@ import qualified Data.Text as T import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL-import           Network.HTTP.Req ((/:))+import           Network.HTTP.Req ((/:), (/~)) import qualified Network.HTTP.Req as R import Network.HTTP.Client (RequestBody (RequestBodyBS)) import Network.HTTP.Client.MultipartFormData (partBS, partFileRequestBody)@@ -41,22 +40,67 @@   majorRoute = webhookMajorRoute   jsonRequest = webhookJsonRequest --- | Data constructor for requests. See <https://discord.com/developers/docs/resources/ API>+-- | Data constructors for webhook requests. data WebhookRequest a where-  CreateWebhook :: ChannelId -> CreateWebhookOpts -> WebhookRequest Webhook-  GetChannelWebhooks :: ChannelId -> WebhookRequest [Webhook]-  GetGuildWebhooks :: GuildId -> WebhookRequest [Webhook]-  GetWebhook :: WebhookId -> WebhookRequest Webhook-  GetWebhookWithToken :: WebhookId -> T.Text -> WebhookRequest Webhook-  ModifyWebhook :: WebhookId -> ModifyWebhookOpts-                                      -> WebhookRequest Webhook-  ModifyWebhookWithToken :: WebhookId -> T.Text -> ModifyWebhookOpts-                                      -> WebhookRequest Webhook-  DeleteWebhook :: WebhookId -> WebhookRequest ()-  DeleteWebhookWithToken :: WebhookId -> T.Text -> WebhookRequest ()-  ExecuteWebhookWithToken :: WebhookId -> T.Text -> ExecuteWebhookWithTokenOpts-                                       -> WebhookRequest ()+  -- | Creates a new webhook and returns a webhook object on success. Requires the @MANAGE_WEBHOOKS@ permission.+  -- An error will be returned if a webhook name (name) is not valid. A webhook name is valid if:+  --+  -- * It does not contain the substring @clyde@ (case-insensitive)+  -- * It follows the nickname guidelines in the Usernames and Nicknames documentation,+  --   with an exception that webhook names can be up to 80 characters+  CreateWebhook :: ChannelId+                -> CreateWebhookOpts+                -> WebhookRequest Webhook+  -- | Returns a channel's `Webhook`s as a list. Requires the @MANAGE_WEBHOOKS@ permission.+  GetChannelWebhooks :: ChannelId+                     -> WebhookRequest [Webhook]+  -- | Returns a guild's `Webhook`s as a list. Requires the @MANAGE_WEBHOOKS@ permission.+  GetGuildWebhooks :: GuildId+                   -> WebhookRequest [Webhook]+  -- | Returns the `Webhook` for the given id. If a token is given, authentication is not required.+  GetWebhook :: WebhookId+             -> Maybe WebhookToken+             -> WebhookRequest Webhook+  -- | Modify a webhook. Requires the @MANAGE_WEBHOOKS@ permission. Returns the updated `Webhook` on success.+  -- If a token is given, authentication is not required.+  ModifyWebhook :: WebhookId+                -> Maybe WebhookToken+                -> ModifyWebhookOpts+                -> WebhookRequest Webhook+  -- | Delete a webhook permanently. Requires the @MANAGE_WEBHOOKS@ permission.+  -- If a token is given, authentication is not required.+  DeleteWebhook :: WebhookId+                -> Maybe WebhookToken+                -> WebhookRequest ()+  -- | Executes a Webhook.+  -- +  -- Refer to [Uploading Files](https://discord.com/developers/docs/reference#uploading-files)+  -- for details on attachments and @multipart/form-data@ requests.+  ExecuteWebhook :: WebhookId+                 -> WebhookToken+                 -> ExecuteWebhookWithTokenOpts+                 -> WebhookRequest ()+  -- We don't support slack and github compatible webhooks because you should+  --  just use execute webhook. +  -- | Returns a previously-sent webhook message from the same token.+  GetWebhookMessage :: WebhookId +                    -> WebhookToken +                    -> MessageId +                    -> WebhookRequest Message+  -- | Edits a previously-sent webhook message from the same token.+  EditWebhookMessage :: WebhookId +                     -> WebhookToken +                     -> MessageId +                     -> T.Text -- currently we don't support the full range of edits - feel free to PR and fix this+                     -> WebhookRequest Message+  -- | Deletes a previously-sent webhook message from the same token.+  DeleteWebhookMessage :: WebhookId +                       -> WebhookToken +                       -> MessageId +                       -> WebhookRequest ()++-- | Options for `ModifyWebhook` and `ModifyWebhookWithToken` data ModifyWebhookOpts = ModifyWebhookOpts   { modifyWebhookOptsName          :: Maybe T.Text   , modifyWebhookOptsAvatar        :: Maybe T.Text@@ -69,6 +113,7 @@                           ("name",   toJSON <$> modifyWebhookOptsName),                           ("avatar",  toJSON <$> modifyWebhookOptsAvatar) ] ] +-- | Options for `CreateWebhook` data CreateWebhookOpts = CreateWebhookOpts   { createWebhookOptsName          :: T.Text   , createWebhookOptsAvatar        :: Maybe T.Text@@ -79,11 +124,13 @@                          [("name",   toJSON <$> Just createWebhookOptsName),                           ("avatar",  toJSON <$> createWebhookOptsAvatar) ] ] +-- | Options for `ExecuteWebhookWithToken` data ExecuteWebhookWithTokenOpts = ExecuteWebhookWithTokenOpts   { executeWebhookWithTokenOptsUsername      :: Maybe T.Text   , executeWebhookWithTokenOptsContent       :: WebhookContent   } deriving (Show, Read, Eq, Ord) +-- | A webhook's content data WebhookContent = WebhookContentText T.Text                     | WebhookContentFile T.Text B.ByteString                     | WebhookContentEmbeds [CreateEmbed]@@ -100,59 +147,51 @@                          [("username",   toJSON <$> executeWebhookWithTokenOptsUsername)]                            <> webhookContentJson executeWebhookWithTokenOptsContent                          ]-+-- | Major routes for webhook requests webhookMajorRoute :: WebhookRequest a -> String webhookMajorRoute ch = case ch of-  (CreateWebhook c _) ->            "aaaaaahook " <> show c-  (GetChannelWebhooks c) ->         "aaaaaahook " <> show c-  (GetGuildWebhooks g) ->           "aaaaaahook " <> show g-  (GetWebhook w) ->                 "aaaaaahook " <> show w-  (GetWebhookWithToken w _) ->      "getwebhook " <> show w-  (ModifyWebhook w _) ->            "modifyhook " <> show w-  (ModifyWebhookWithToken w _ _) -> "modifyhook " <> show w-  (DeleteWebhook w) ->              "deletehook " <> show w-  (DeleteWebhookWithToken w _) ->   "deletehook " <> show w-  (ExecuteWebhookWithToken w _ _) -> "executehk " <> show w+  (CreateWebhook c _) ->    "aaaaaahook " <> show c+  (GetChannelWebhooks c) -> "aaaaaahook " <> show c+  (GetGuildWebhooks g) ->   "aaaaaahook " <> show g+  (GetWebhook w _) ->       "getwebhook " <> show w+  (ModifyWebhook w _ _) ->  "modifyhook " <> show w+  (DeleteWebhook w _) ->    "deletehook " <> show w+  (ExecuteWebhook w _ _) ->  "executehk " <> show w+  (GetWebhookMessage w _ _) -> "gethkmsg " <> show w+  (EditWebhookMessage w _ _ _) -> "edithkmsg " <> show w+  (DeleteWebhookMessage w _ _) -> "delhkmsg " <> show w +-- | Create a 'JsonRequest' from a `WebhookRequest` webhookJsonRequest :: WebhookRequest r -> JsonRequest webhookJsonRequest ch = case ch of   (CreateWebhook channel patch) ->     let body = pure (R.ReqBodyJson patch)-    in Post (baseUrl /: "channels" // channel /: "webhooks") body  mempty+    in Post (baseUrl /: "channels" /~ channel /: "webhooks") body  mempty    (GetChannelWebhooks c) ->-    Get (baseUrl /: "channels" // c /: "webhooks")  mempty+    Get (baseUrl /: "channels" /~ c /: "webhooks")  mempty    (GetGuildWebhooks g) ->-    Get (baseUrl /: "guilds" // g /: "webhooks")  mempty--  (GetWebhook w) ->-    Get (baseUrl /: "webhooks" // w)  mempty--  (GetWebhookWithToken w t) ->-    Get (baseUrl /: "webhooks" // w /: t)  mempty--  (ModifyWebhook w patch) ->-    Patch (baseUrl /: "webhooks" // w) (pure (R.ReqBodyJson patch))  mempty+    Get (baseUrl /: "guilds" /~ g /: "webhooks")  mempty -  (ModifyWebhookWithToken w t p) ->-    Patch (baseUrl /: "webhooks" // w /: t) (pure (R.ReqBodyJson p))  mempty+  (GetWebhook w t) ->+    Get (baseUrl /: "webhooks" /~ w /? t)  mempty -  (DeleteWebhook w) ->-    Delete (baseUrl /: "webhooks" // w)  mempty+  (ModifyWebhook w t p) ->+    Patch (baseUrl /: "webhooks" /~ w /? t) (pure (R.ReqBodyJson p))  mempty -  (DeleteWebhookWithToken w t) ->-    Delete (baseUrl /: "webhooks" // w /: t)  mempty+  (DeleteWebhook w t) ->+    Delete (baseUrl /: "webhooks" /~ w /? t)  mempty -  (ExecuteWebhookWithToken w tok o) ->+  (ExecuteWebhook w tok o) ->     case executeWebhookWithTokenOptsContent o of       WebhookContentFile name text  ->         let part = partFileRequestBody "file" (T.unpack name) (RequestBodyBS text)             body = R.reqBodyMultipart [part]-        in Post (baseUrl /: "webhooks" // w /: tok) body mempty+        in Post (baseUrl /: "webhooks" /~ w /~ tok) body mempty       WebhookContentText _ ->         let body = pure (R.ReqBodyJson o)-        in Post (baseUrl /: "webhooks" // w /: tok) body mempty+        in Post (baseUrl /: "webhooks" /~ w /~ tok) body mempty       WebhookContentEmbeds embeds ->         let mkPart (name,content) = partFileRequestBody name (T.unpack name) (RequestBodyBS content)             uploads CreateEmbed{..} = [(n,c) | (n, Just (CreateEmbedImageUpload c)) <-@@ -163,4 +202,13 @@             parts =  map mkPart (concatMap uploads embeds)             partsJson = [partBS "payload_json" $ BL.toStrict $ encode $ toJSON $ object ["embed" .= createEmbed e] | e <- embeds]             body = R.reqBodyMultipart (partsJson ++ parts)-        in Post (baseUrl /: "webhooks" // w /: tok) body mempty+        in Post (baseUrl /: "webhooks" /~ w /: unToken tok) body mempty++  (GetWebhookMessage w t m) ->+    Get (baseUrl /: "webhooks" /~ w /~ t /: "messages" /~ m)  mempty++  (EditWebhookMessage w t m p) ->+    Patch (baseUrl /: "webhooks" /~ w /~ t /: "messages" /~ m) (pure (R.ReqBodyJson $ object ["content" .= p]))  mempty++  (DeleteWebhookMessage w t m) ->+    Delete (baseUrl /: "webhooks" /~ w /~ t /: "messages" /~ m)  mempty

@@ -29,6 +29,7 @@ import Discord.Internal.Types.Prelude import Discord.Internal.Types.User +-- | Converts an internal event to its user facing counterpart userFacingEvent :: EventInternalParse -> Event userFacingEvent event = case event of   InternalReady a b c d e f g -> Ready a b c d e f g

@@ -401,6 +401,10 @@         createDescription :: T.Text,         -- | What options the application (max length 25).         createOptions :: Maybe Options,+        -- | The default permissions required for members set when using the command+        -- in a guild.+        -- Set of permissions represented as a bit set.+        createDefaultMemberPermissions :: Maybe T.Text,         -- | Whether the command is enabled by default when the application is added         -- to a guild.         createDefaultPermission :: Bool@@ -408,6 +412,10 @@   | CreateApplicationCommandUser       { -- | The application command name (1-32 chars).         createName :: T.Text,+        -- | The default permissions required for members set when using the command+        -- in a guild.+        -- Set of permissions represented as a bit set.+        createDefaultMemberPermissions :: Maybe T.Text,         -- | Whether the command is enabled by default when the application is added         -- to a guild.         createDefaultPermission :: Bool@@ -415,6 +423,10 @@   | CreateApplicationCommandMessage       { -- | The application command name (1-32 chars).         createName :: T.Text,+        -- | The default permissions required for members set when using the command+        -- in a guild.+        -- Set of permissions represented as a bit set.+        createDefaultMemberPermissions :: Maybe T.Text,         -- | Whether the command is enabled by default when the application is added         -- to a guild.         createDefaultPermission :: Bool@@ -429,6 +441,7 @@             [ ("name", toMaybeJSON createName),               ("description", toMaybeJSON createDescription),               ("options", toJSON <$> createOptions),+              ("default_member_permissions", toMaybeJSON createDefaultMemberPermissions),               ("default_permission", toMaybeJSON createDefaultPermission),               ("type", Just $ Number 1)             ]@@ -438,6 +451,7 @@       [ (name, value)         | (name, Just value) <-             [ ("name", toMaybeJSON createName),+              ("default_member_permissions", toMaybeJSON createDefaultMemberPermissions),               ("default_permission", toMaybeJSON createDefaultPermission),               ("type", Just $ Number 2)             ]@@ -447,6 +461,7 @@       [ (name, value)         | (name, Just value) <-             [ ("name", toMaybeJSON createName),+              ("default_member_permissions", toMaybeJSON createDefaultMemberPermissions),               ("default_permission", toMaybeJSON createDefaultPermission),               ("type", Just $ Number 3)             ]@@ -464,21 +479,21 @@ -- than or equal to 100 characters. createChatInput :: T.Text -> T.Text -> Maybe CreateApplicationCommand createChatInput name desc-  | nameIsValid True name && not (T.null desc) && T.length desc <= 100 = Just $ CreateApplicationCommandChatInput name desc Nothing True+  | nameIsValid True name && not (T.null desc) && T.length desc <= 100 = Just $ CreateApplicationCommandChatInput name desc Nothing Nothing True   | otherwise = Nothing  -- | Create the basics for a user command. Use record overwriting to enter the -- other values. The name needs to be between 1 and 32 characters. createUser :: T.Text -> Maybe CreateApplicationCommand createUser name-  | nameIsValid False name = Just $ CreateApplicationCommandUser name True+  | nameIsValid False name = Just $ CreateApplicationCommandUser name Nothing True   | otherwise = Nothing  -- | Create the basics for a message command. Use record overwriting to enter -- the other values. The name needs to be between 1 and 32 characters. createMessage :: T.Text -> Maybe CreateApplicationCommand createMessage name-  | nameIsValid False name = Just $ CreateApplicationCommandMessage name True+  | nameIsValid False name = Just $ CreateApplicationCommandMessage name Nothing True   | otherwise = Nothing  -- | Data type to be used when editing application commands. The specification

@@ -25,111 +25,121 @@ 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.-      , channelName        :: T.Text      -- ^ The name of the channel (2 - 1000 characters).-      , channelPosition    :: Integer     -- ^ The storing position of the channel.-      , channelPermissions :: [Overwrite] -- ^ An array of permission 'Overwrite's-      , channelUserRateLimit :: Integer   -- ^ Seconds before a user can speak again-      , channelNSFW        :: Bool        -- ^ Is not-safe-for-work-      , channelTopic       :: T.Text      -- ^ The topic of the channel. (0 - 1024 chars).+      { 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.+      , channelName        :: T.Text            -- ^ The name of the channel (2 - 1000 characters).+      , channelPosition    :: Integer           -- ^ The storing position of the channel.+      , channelPermissions :: [Overwrite]       -- ^ An array of permission 'Overwrite's+      , channelUserRateLimit :: Integer         -- ^ Seconds before a user can speak again+      , channelNSFW        :: Bool              -- ^ Is not-safe-for-work+      , channelTopic       :: T.Text            -- ^ The topic of the channel. (0 - 1024 chars).       , channelLastMessage :: Maybe MessageId   -- ^ The id of the last message sent in the                                                 --   channel       , channelParentId    :: Maybe ParentId    -- ^ The id of the parent channel (category)       }+  -- | A news Channel in a guild.   | ChannelNews-      { channelId          :: ChannelId-      , channelGuild       :: GuildId-      , channelName        :: T.Text-      , channelPosition    :: Integer-      , channelPermissions :: [Overwrite]-      , channelNSFW        :: Bool-      , channelTopic       :: T.Text-      , channelLastMessage :: Maybe MessageId+      { channelId          :: ChannelId       -- ^ The id of the channel+      , channelGuild       :: GuildId         -- ^ The id of the guild+      , channelName        :: T.Text          -- ^ The name of the channel (2 - 1000 characters)+      , channelPosition    :: Integer         -- ^ The position of the channel+      , channelPermissions :: [Overwrite]     -- ^ An array of permission 'Overrite's+      , channelNSFW        :: Bool            -- ^ Is not-safe-for-work+      , channelTopic       :: T.Text          -- ^ Topic of the channel (0 - 1024 characters)+      , channelLastMessage :: Maybe MessageId -- ^ The ID of the last message of the channel+      , channelParentId    :: Maybe ParentId  -- ^ The id of the parent channel (category)       }+   -- | A store page channel in a guild   | ChannelStorePage-      { channelId          :: ChannelId-      , channelGuild       :: GuildId-      , channelName        :: T.Text-      , channelPosition    :: Integer-      , channelNSFW        :: Bool-      , channelPermissions :: [Overwrite]-      , channelParentId    :: Maybe ParentId+      { channelId          :: ChannelId      -- ^ The id of the channel+      , channelGuild       :: GuildId        -- ^ The id of the guild+      , channelName        :: T.Text         -- ^ The name of the channel (2 - 1000 characters)+      , channelPosition    :: Integer        -- ^ The position of the channel+      , channelNSFW        :: Bool           -- ^ Is not-safe-for-work+      , channelPermissions :: [Overwrite]    -- ^ An array of permission 'Overrite's+      , channelParentId    :: Maybe ParentId -- ^ The id of the parrent channel (category)       }   -- | A voice channel in a guild.   | ChannelVoice-      { channelId          :: ChannelId-      , channelGuild       :: GuildId-      , channelName        :: T.Text-      , channelPosition    :: Integer-      , channelPermissions :: [Overwrite]-      , channelNSFW        :: Bool-      , channelBitRate     :: Integer     -- ^ The bitrate (in bits) of the channel.-      , channelUserLimit   :: Integer     -- ^ The user limit of the voice channel.-      , channelParentId    :: Maybe ParentId+      { channelId          :: ChannelId       -- ^ The id of the channel+      , channelGuild       :: GuildId         -- ^ The id of the guild+      , channelName        :: T.Text          -- ^ The name of the channel (2 - 1000) characters+      , channelPosition    :: Integer         -- ^ The position of the channel+      , channelPermissions :: [Overwrite]     -- ^ An array of permission 'Overrite's+      , channelNSFW        :: Bool            -- ^ Is not-safe-for-work+      , channelBitRate     :: Integer         -- ^ The bitrate (in bps) of the channel.+      , channelUserLimit   :: Integer         -- ^ The user limit of the voice channel.+      , channelParentId    :: Maybe ParentId  -- ^ The id of the parrent channel (category)       }   -- | DM Channels represent a one-to-one conversation between two users, outside the scope   --   of guilds   | ChannelDirectMessage-      { channelId          :: ChannelId-      , channelRecipients  :: [User]      -- ^ The 'User' object(s) of the DM recipient(s).-      , channelLastMessage :: Maybe MessageId+      { channelId          :: ChannelId       -- ^ The id of the channel+      , channelRecipients  :: [User]          -- ^ The 'User' object(s) of the DM recipient(s).+      , channelLastMessage :: Maybe MessageId -- ^ The last message sent to the channel       }+  -- | Like a 'ChannelDirectMessage' but for more people   | ChannelGroupDM-      { channelId          :: ChannelId-      , channelRecipients  :: [User]-      , channelLastMessage :: Maybe MessageId+      { channelId          :: ChannelId       -- ^ The id of the channel+      , channelRecipients  :: [User]          -- ^ The 'User' object(s) of the DM recipent(s).+      , channelLastMessage :: Maybe MessageId -- ^ The last message sent to the channel       }+  -- | A channel category   | ChannelGuildCategory-      { channelId          :: ChannelId-      , channelGuild       :: GuildId-      , channelName        :: T.Text-      , channelPosition    :: Integer-      , channelPermissions :: [Overwrite]+      { channelId          :: ChannelId   -- ^ The id of the category+      , channelGuild       :: GuildId     -- ^ The id of the gild+      , channelName        :: T.Text      -- ^ The name of the category+      , channelPosition    :: Integer     -- ^ The position of the category+      , channelPermissions :: [Overwrite] -- ^ A list of permission 'Overrite's       }+  -- | A stage channel   | ChannelStage-      { channelId          :: ChannelId-      , channelGuild       :: GuildId-      , channelStageId     :: StageId-      , channelStageTopic  :: Text+      { channelId          :: ChannelId -- ^ The id of the channel+      , channelGuild       :: GuildId   -- ^ The id of the guild+      , channelStageId     :: StageId   -- ^ The id of the stage+      , channelStageTopic  :: Text      -- ^ The topic text       }+  -- | A news Thread   | ChannelNewsThread-      { channelId          :: ChannelId   -- ^ The id of the thread-      , channelGuild       :: GuildId     -- ^ The id of the guild.-      , channelThreadName  :: Maybe T.Text      -- ^ The name of the channel (2 - 1000 characters).+      { channelId          :: ChannelId               -- ^ The id of the thread+      , channelGuild       :: GuildId                 -- ^ The id of the guild.+      , channelThreadName  :: Maybe T.Text            -- ^ The name of the channel (2 - 1000 characters).       , channelUserRateLimitThread :: Maybe Integer   -- ^ Seconds before a user can speak again-      , channelLastMessage :: Maybe MessageId   -- ^ The id of the last message sent in the-                                                --   channel-      , channelParentId    :: Maybe ParentId    -- ^ The id of the parent channel (category)+      , channelLastMessage :: Maybe MessageId         -- ^ The id of the last message sent in the+                                                      --   channel+      , channelParentId    :: Maybe ParentId          -- ^ The id of the parent channel       , channelThreadMetadata :: Maybe ThreadMetadata -- ^ Metadata about this thread-      , channelThreadMember :: Maybe ThreadMember -- ^ Used to indicate if the user has joined the thread+      , channelThreadMember :: Maybe ThreadMember     -- ^ Used to indicate if the user has joined the thread       }+  -- | A thread anyone can join   | ChannelPublicThread-      { channelId          :: ChannelId   -- ^ The id of the thread-      , channelGuild       :: GuildId     -- ^ The id of the guild.-      , channelThreadName  :: Maybe T.Text      -- ^ The name of the channel (2 - 1000 characters).+      { channelId          :: ChannelId               -- ^ The id of the thread+      , channelGuild       :: GuildId                 -- ^ The id of the guild.+      , channelThreadName  :: Maybe T.Text            -- ^ The name of the channel (2 - 1000 characters).       , channelUserRateLimitThread :: Maybe Integer   -- ^ Seconds before a user can speak again-      , channelLastMessage :: Maybe MessageId   -- ^ The id of the last message sent in the-                                                --   channel-      , channelParentId    :: Maybe ParentId    -- ^ The id of the parent channel (category)+      , channelLastMessage :: Maybe MessageId         -- ^ The id of the last message sent in the+                                                      --   channel+      , channelParentId    :: Maybe ParentId          -- ^ The id of the parent channel       , channelThreadMetadata :: Maybe ThreadMetadata -- ^ Metadata about this thread-      , channelThreadMember :: Maybe ThreadMember -- ^ Used to indicate if the user has joined the thread+      , channelThreadMember :: Maybe ThreadMember     -- ^ Used to indicate if the user has joined the thread       }+  -- | An on-invite thread   | ChannelPrivateThread-      { channelId          :: ChannelId   -- ^ The id of the thread-      , channelGuild       :: GuildId     -- ^ The id of the guild.-      , channelThreadName  :: Maybe T.Text      -- ^ The name of the channel (2 - 1000 characters).+      { channelId          :: ChannelId               -- ^ The id of the thread+      , channelGuild       :: GuildId                 -- ^ The id of the guild.+      , channelThreadName  :: Maybe T.Text            -- ^ The name of the channel (2 - 1000 characters).       , channelUserRateLimitThread :: Maybe Integer   -- ^ Seconds before a user can speak again-      , channelLastMessage :: Maybe MessageId   -- ^ The id of the last message sent in the-                                                --   channel-      , channelParentId    :: Maybe ParentId    -- ^ The id of the parent channel (category)+      , channelLastMessage :: Maybe MessageId         -- ^ The id of the last message sent in the+                                                      --   channel+      , channelParentId    :: Maybe ParentId          -- ^ The id of the parent channel       , channelThreadMetadata :: Maybe ThreadMetadata -- ^ Metadata about this thread-      , channelThreadMember :: Maybe ThreadMember -- ^ Used to indicate if the user has joined the thread+      , channelThreadMember :: Maybe ThreadMember     -- ^ Used to indicate if the user has joined the thread       }+  -- | A channel of unknown type   | ChannelUnknownType-      { channelId          :: ChannelId-      , channelJSON        :: Text+      { channelId          :: ChannelId -- ^ The id of the channel+      , channelJSON        :: Text      -- ^ The library couldn't parse the channel type, here is the raw JSON       } deriving (Show, Read, Eq, Ord)  instance FromJSON Channel where@@ -180,6 +190,7 @@                     <*> o .:? "nsfw" .!= False                     <*> o .:? "topic" .!= ""                     <*> o .:? "last_message_id"+                    <*> o .:? "parent_id"       6 ->         ChannelStorePage <$> o .:  "id"                          <*> o .:? "guild_id" .!= 0@@ -244,7 +255,7 @@               , ("nsfw", toJSON <$> pure channelNSFW)               , ("topic",   toJSON <$> pure channelTopic)               , ("last_message_id",  toJSON <$> channelLastMessage)-+              , ("parent_id", toJSON <$> channelParentId)               ] ]   toJSON ChannelStorePage{..} = object [(name,value) | (name, Just value) <-               [ ("type", Just (Number 6))@@ -344,23 +355,26 @@  -- | Permission overwrites for a channel. data Overwrite = Overwrite-  { overwriteId    :: OverwriteId -- ^ 'Role' or 'User' id-  , overwriteType  :: Integer    -- ^ Either role (0) or member (1)-  , overwriteAllow :: T.Text   -- ^ Allowed permission bit set-  , overwriteDeny  :: T.Text   -- ^ Denied permission bit set+  { overwriteId    :: Either RoleId UserId -- ^ 'Role' or 'User' id+  , overwriteAllow :: T.Text               -- ^ Allowed permission bit set+  , overwriteDeny  :: T.Text               -- ^ Denied permission bit set   } deriving (Show, Read, Eq, Ord)  instance FromJSON Overwrite where-  parseJSON = withObject "Overwrite" $ \o ->-    Overwrite <$> o .: "id"-              <*> o .: "type"-              <*> o .: "allow"+  parseJSON = withObject "Overwrite" $ \o -> do+    t <- o .: "type"+    i <- case (t :: Int) of+      0 -> Left <$> o .: "id"+      1 -> Right <$> o .: "id"+      _ -> error "Type field can only be 0 (role id) or 1 (user id)"+    Overwrite i+              <$> o .: "allow"               <*> o .: "deny"  instance ToJSON Overwrite where   toJSON Overwrite{..} = object-              [ ("id",     toJSON overwriteId)-              , ("type",   toJSON overwriteType)+              [ ("id",     toJSON $ either unId unId overwriteId)+              , ("type",   toJSON $ (either (const 0) (const 1) overwriteId :: Int))               , ("allow",  toJSON overwriteAllow)               , ("deny",   toJSON overwriteDeny)               ]@@ -394,6 +408,7 @@               , ("create_timestamp", toJSON <$> pure threadMetadataCreateTime)               ] ] +-- | A user in a thread data ThreadMember = ThreadMember  { threadMemberThreadId :: Maybe ChannelId -- ^ id of the thread  , threadMemberUserId   :: Maybe UserId    -- ^ id of the user@@ -416,6 +431,7 @@               , ("flags", toJSON <$> pure threadMemberFlags)               ] ] + data ThreadListSyncFields = ThreadListSyncFields   { threadListSyncFieldsGuildId :: GuildId   , threadListSyncFieldsChannelIds :: Maybe [ChannelId]@@ -557,12 +573,12 @@  -- | Data constructor for a part of MessageDetailedOpts. data AllowedMentions = AllowedMentions-  { mentionEveryone    :: Bool-  , mentionUsers       :: Bool-  , mentionRoles       :: Bool-  , mentionUserIds     :: [UserId]-  , mentionRoleIds     :: [RoleId]-  , mentionRepliedUser :: Bool+  { mentionEveryone    :: Bool     -- ^ Can mention @\@everyone@+  , mentionUsers       :: Bool     -- ^ Can mention any user+  , mentionRoles       :: Bool     -- ^ Can mention any mentionable role+  , mentionUserIds     :: [UserId] -- ^ List of users able to be mentionned+  , mentionRoleIds     :: [RoleId] -- ^ List of roles able to be mentioneed +  , mentionRepliedUser :: Bool     -- ^ Can mention the sender of the replied message    } deriving (Show, Read, Eq, Ord)  instance Default AllowedMentions where@@ -586,8 +602,9 @@                                  "users"        .= mentionUserIds,                                  "replied_user" .= mentionRepliedUser ] +-- | A reaction to a message data MessageReaction = MessageReaction-  { messageReactionCount :: Int+  { messageReactionCount :: Int    , messageReactionMeIncluded :: Bool   , messageReactionEmoji :: Emoji   } deriving (Show, Read, Eq, Ord)

@@ -22,7 +22,8 @@ -- All discord embed color stuff is credited to -- https://github.com/WarwickTabletop/tablebot/pull/34 data DiscordColor-  = DiscordColorRGB Integer Integer Integer+  = -- | An RGB color with values in @[0..255]@ +    DiscordColorRGB Integer Integer Integer   | DiscordColorDefault   | DiscordColorAqua   | DiscordColorDarkAqua@@ -95,6 +96,7 @@   let (r, g, b) = fromMaybe (0, 0, 0) $ hexToRGB hex    in DiscordColorRGB r g b +-- | Convert a color to its internal `Integer` representation colorToInternal :: DiscordColor -> Integer -- colorToInternal (DiscordColor i) = i colorToInternal (DiscordColorRGB r g b) = (r * 256 + g) * 256 + b@@ -133,6 +135,7 @@ colorToInternal DiscordColorDiscordRed = 15548997 colorToInternal DiscordColorDiscordBlack = 16777215 +-- | Convert a color integer to a RGB color with values in @[0..255]@ convertToRGB :: Integer -> DiscordColor convertToRGB i = DiscordColorRGB (div i (256 * 256) .&. 255) (div i 256 .&. 255) (i .&. 255) 

@@ -6,6 +6,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} +-- | Message components module Discord.Internal.Types.Components   ( ActionRow (..),     Button (..),@@ -28,6 +29,7 @@ import Discord.Internal.Types.Emoji (Emoji) import Discord.Internal.Types.Prelude (toMaybeJSON) +-- | Container for other message Components data ActionRow = ActionRowButtons [Button] | ActionRowSelectMenu SelectMenu   deriving (Show, Read, Eq, Ord) @@ -329,5 +331,6 @@           <*> o .:? "placeholder" .!= ""       _ -> fail "expected text input, found other type of component" +-- | Create a text input from an id and a label mkTextInput :: T.Text -> T.Text -> TextInput mkTextInput cid label = TextInput cid False label Nothing Nothing True "" ""

@@ -150,6 +150,7 @@         ("format_type", toJSON stickerItemFormatType)       ] +-- | The format of a sticker data StickerFormatType   = StickerFormatTypePNG   | StickerFormatTypeAPNG

@@ -21,50 +21,91 @@ import Discord.Internal.Types.Emoji (Emoji)  --- | Represents possible events sent by discord. Detailed information can be found at https://discord.com/developers/docs/topics/gateway.+-- | Represents possible events sent by discord. Detailed information can be found at <https://discord.com/developers/docs/topics/gateway>. data Event =+  -- | Contains the initial state information     Ready                      Int User [Channel] [GuildUnavailable] T.Text (Maybe Shard) PartialApplication+  -- | Response to a @Resume@ gateway command   | Resumed                    [T.Text]+  -- | new guild channel created   | ChannelCreate              Channel+  -- | channel was updated   | ChannelUpdate              Channel+  -- | channel was deleted   | ChannelDelete              Channel+  -- | thread created, also sent when being added to a private thread   | ThreadCreate               Channel+  -- | thread was updated   | ThreadUpdate               Channel+  -- | thread was deleted   | ThreadDelete               Channel-  | ThreadListSync             ThreadListSyncFields -  | ThreadMembersUpdate        ThreadMembersUpdateFields +  -- | sent when gaining access to a channel, contains all active threads in that channel+  | ThreadListSync             ThreadListSyncFields+  -- | thread member for the current user was updated+  | ThreadMembersUpdate        ThreadMembersUpdateFields+  -- | message was pinned or unpinned   | ChannelPinsUpdate          ChannelId (Maybe UTCTime)+  -- | lazy-load for unavailable guild, guild became available, or user joined a new guild   | GuildCreate                Guild+  -- | guild was updated   | GuildUpdate                Guild+  -- | guild became unavailable, or user left/was removed from a guild   | GuildDelete                GuildUnavailable+  -- | user was banned from a guild   | GuildBanAdd                GuildId User+  -- | user was unbanned from a guild   | GuildBanRemove             GuildId User+  -- | guild emojis were updated   | GuildEmojiUpdate           GuildId [Emoji]+  -- | guild integration was updated   | GuildIntegrationsUpdate    GuildId+  -- | new user joined a guild   | GuildMemberAdd             GuildId GuildMember+  -- | user was removed from a guild   | GuildMemberRemove          GuildId User+  -- | guild member was updated   | GuildMemberUpdate          GuildId [RoleId] User (Maybe T.Text)+  -- | response to @Request Guild Members@ gateway command   | GuildMemberChunk           GuildId [GuildMember]+  -- | guild role was created   | GuildRoleCreate            GuildId Role+  -- | guild role was updated   | GuildRoleUpdate            GuildId Role+  -- | guild role was deleted   | GuildRoleDelete            GuildId RoleId+  -- | message was created   | MessageCreate              Message+  -- | message was updated   | MessageUpdate              ChannelId MessageId+  -- | message was deleted   | MessageDelete              ChannelId MessageId+  -- | multiple messages were deleted at once   | MessageDeleteBulk          ChannelId [MessageId]+  -- | user reacted to a message   | MessageReactionAdd         ReactionInfo+  -- | user removed a reaction from a message   | MessageReactionRemove      ReactionInfo+  -- | all reactions were explicitly removed from a message   | MessageReactionRemoveAll   ChannelId MessageId+  -- | all reactions for a given emoji were explicitly removed from a message   | MessageReactionRemoveEmoji ReactionRemoveInfo+  -- | user was updated   | PresenceUpdate             PresenceInfo+  -- | user started typing in a channel   | TypingStart                TypingInfo+  -- | properties about the user changed   | UserUpdate                 User+  -- | someone joined, left, or moved a voice channel   | InteractionCreate          Interaction-  -- | VoiceStateUpdate-  -- | VoiceServerUpdate+  --  | VoiceStateUpdate+  --  | VoiceServerUpdate+  -- | An Unknown Event, none of the others   | UnknownEvent               T.Text Object   deriving (Show, Eq) +-- | Internal Event representation. Each matches to the corresponding constructor of `Event`.+--+-- An application should never have to use those directly data EventInternalParse =     InternalReady                      Int User [Channel] [GuildUnavailable] T.Text (Maybe Shard) PartialApplication   | InternalResumed                    [T.Text]@@ -103,11 +144,12 @@   | InternalTypingStart                TypingInfo   | InternalUserUpdate                 User   | InternalInteractionCreate          Interaction-  -- -- | InternalVoiceStateUpdate-  -- -- | InternalVoiceServerUpdate+  --  | InternalVoiceStateUpdate+  --  | InternalVoiceServerUpdate   | InternalUnknownEvent               T.Text Object   deriving (Show, Eq, Read) +-- | Structure containing partial information about an Application data PartialApplication = PartialApplication   { partialApplicationID :: ApplicationId   , partialApplicationFlags :: Int@@ -116,12 +158,13 @@ instance FromJSON PartialApplication where   parseJSON = withObject "PartialApplication" (\v -> PartialApplication <$> v .: "id" <*> v .: "flags") +-- | Structure containing information about a reaction data ReactionInfo = ReactionInfo-  { reactionUserId    :: UserId-  , reactionGuildId   :: Maybe GuildId-  , reactionChannelId :: ChannelId-  , reactionMessageId :: MessageId-  , reactionEmoji     :: Emoji+  { reactionUserId    :: UserId -- ^ User who reacted+  , reactionGuildId   :: Maybe GuildId -- ^ Guild in which the reacted message is (if any) +  , reactionChannelId :: ChannelId -- ^ Channel in which the reacted message is+  , reactionMessageId :: MessageId -- ^ The reacted message+  , reactionEmoji     :: Emoji -- ^ The Emoji used for the reaction   } deriving (Show, Read, Eq, Ord)  instance FromJSON ReactionInfo where@@ -132,6 +175,7 @@                  <*> o .:  "message_id"                  <*> o .:  "emoji" +-- | Structure containing information about a reaction that has been removed data ReactionRemoveInfo  = ReactionRemoveInfo   { reactionRemoveChannelId :: ChannelId   , reactionRemoveGuildId   :: GuildId@@ -146,6 +190,7 @@                        <*> o .:  "message_id"                        <*> o .:  "emoji" +-- | Structre containing typing status information data TypingInfo = TypingInfo   { typingUserId    :: UserId   , typingChannelId :: ChannelId@@ -168,6 +213,7 @@                 Left r -> fail r                 Right b -> pure b +-- | Parse an event from name and JSON data eventParse :: T.Text -> Object -> Parser EventInternalParse eventParse t o = case t of     "READY"                     -> InternalReady <$> o .: "v"

@@ -22,7 +22,7 @@ import Discord.Internal.Types.Events import Discord.Internal.Types.Guild (Activity (..)) --- | Sent by gateway+-- | Messages that can be sent by gateway to the library data GatewayReceivable   = Dispatch EventInternalParse Integer   | HeartbeatRequest Integer@@ -41,7 +41,10 @@   deriving (Show, Read, Eq, Ord)  --- | https://discord.com/developers/docs/topics/gateway#list-of-intents+-- | Gateway intents to subrscribe to+-- +-- Details of which intent englobs what data is avalilable at+-- [the official Discord documentation](https://discord.com/developers/docs/topics/gateway#list-of-intents) data GatewayIntent = GatewayIntent   { gatewayIntentGuilds :: Bool   , gatewayIntentMembers :: Bool@@ -51,7 +54,7 @@   , gatewayIntentWebhooks :: Bool   , gatewayIntentInvites :: Bool   , gatewayIntentVoiceStates :: Bool-  , gatewayIntentPrecenses :: Bool+  , gatewayIntentPresences :: Bool   , gatewayIntentMessageChanges :: Bool   , gatewayIntentMessageReactions :: Bool   , gatewayIntentMessageTyping :: Bool@@ -70,7 +73,7 @@                       , gatewayIntentWebhooks               = True                       , gatewayIntentInvites                = True                       , gatewayIntentVoiceStates            = True-                      , gatewayIntentPrecenses              = False  -- false+                      , gatewayIntentPresences              = False  -- false                       , gatewayIntentMessageChanges         = True                       , gatewayIntentMessageReactions       = True                       , gatewayIntentMessageTyping          = True@@ -91,7 +94,7 @@                        , (2 ^  5, gatewayIntentWebhooks)                        , (2 ^  6, gatewayIntentInvites)                        , (2 ^  7, gatewayIntentVoiceStates)-                       , (2 ^  8, gatewayIntentPrecenses)+                       , (2 ^  8, gatewayIntentPresences)                        , (2 ^  9, gatewayIntentMessageChanges)                        , (2 ^ 10, gatewayIntentMessageReactions)                        , (2 ^ 11, gatewayIntentMessageTyping)@@ -109,12 +112,14 @@   | UpdateStatusVoice UpdateStatusVoiceOpts   deriving (Show, Read, Eq, Ord) +-- | Options for `RequestGuildMembers` data RequestGuildMembersOpts = RequestGuildMembersOpts                              { requestGuildMembersOptsGuildId :: GuildId                              , requestGuildMembersOptsNamesStartingWith :: T.Text                              , requestGuildMembersOptsLimit :: Integer }   deriving (Show, Read, Eq, Ord) +-- | Options for `UpdateStatusVoice` data UpdateStatusVoiceOpts = UpdateStatusVoiceOpts                            { updateStatusVoiceOptsGuildId :: GuildId                            , updateStatusVoiceOptsChannelId :: Maybe ChannelId@@ -123,6 +128,7 @@                            }   deriving (Show, Read, Eq, Ord) +-- | Options for `UpdateStatus` data UpdateStatusOpts = UpdateStatusOpts                       { updateStatusOptsSince :: Maybe UTCTime                       , updateStatusOptsGame :: Maybe Activity@@ -131,6 +137,7 @@                       }   deriving (Show, Read, Eq, Ord) +-- | Possible values for `updateStatusOptsNewStatus` data UpdateStatusType = UpdateStatusOnline                       | UpdateStatusDoNotDisturb                       | UpdateStatusAwayFromKeyboard@@ -138,6 +145,8 @@                       | UpdateStatusOffline   deriving (Show, Read, Eq, Ord, Enum) ++-- | Converts an UpdateStatusType to a textual representation statusString :: UpdateStatusType -> T.Text statusString s = case s of   UpdateStatusOnline -> "online"

@@ -11,9 +11,11 @@ import Data.Word  import Data.Aeson.Types+import qualified Data.ByteString as B import Data.Time.Clock import qualified Data.Text as T import Data.Time.Clock.POSIX+import Web.Internal.HttpApiData  import Data.Bifunctor (first) import Text.Read (readMaybe)@@ -53,6 +55,9 @@             (Just i) -> pure i       ) +instance ToHttpApiData Snowflake where+  toUrlPiece = T.pack . show+ newtype DiscordId a = DiscordId { unId :: Snowflake }   deriving (Ord, Eq, Num, Integral, Enum, Real, Bits) @@ -68,6 +73,9 @@ instance FromJSON (DiscordId a) where   parseJSON = fmap DiscordId . parseJSON +instance ToHttpApiData (DiscordId a) where+  toUrlPiece = T.pack . show+ data ChannelIdType type ChannelId = DiscordId ChannelIdType @@ -92,9 +100,6 @@ data UserIdType type UserId = DiscordId UserIdType -data OverwriteIdType-type OverwriteId = DiscordId OverwriteIdType- data RoleIdType type RoleId = DiscordId RoleIdType @@ -122,15 +127,28 @@ data ScheduledEventEntityIdType type ScheduledEventEntityId = DiscordId ScheduledEventEntityIdType -newtype InteractionToken = InteractionToken T.Text-  deriving (Show, Read, Eq, Ord)+newtype DiscordToken a = DiscordToken { unToken :: T.Text }+  deriving (Ord, Eq) -instance ToJSON InteractionToken where-  toJSON (InteractionToken token) = String token+instance Show (DiscordToken a) where+  show = show . unToken -instance FromJSON InteractionToken where-  parseJSON = withText "InteractionToken" (pure . InteractionToken)+instance Read (DiscordToken a) where+  readsPrec p = fmap (first DiscordToken) . readsPrec p +instance ToJSON (DiscordToken a) where+  toJSON = toJSON . unToken++instance FromJSON (DiscordToken a) where+  parseJSON = fmap DiscordToken . parseJSON++instance ToHttpApiData (DiscordToken a) where+  toUrlPiece = unToken++type InteractionToken = DiscordToken InteractionIdType++type WebhookToken = DiscordToken WebhookIdType+ type Shard = (Int, Int)  -- | Gets a creation date from a snowflake.@@ -181,3 +199,43 @@  toMaybeJSON :: (ToJSON a) => a -> Maybe Value toMaybeJSON = return . toJSON+++-- | @Base64Image mime data@ represents the base64 encoding of an image (as+-- @data@), together with a tag of its mime type (@mime@).  The constructor is+-- only for Internal use, and its public export is hidden in Discord.Types.+--+-- Public creation of this datatype should be done using the relevant smart+-- constructors for Emoji, Sticker, or Avatar.+data Base64Image a = Base64Image T.Text T.Text+  deriving (Show, Read, Eq, Ord)++-- | The ToJSON instance for Base64Image creates a string representation of the+-- image's base-64 data, suited for using as JSON values.+--+-- The format is: @data:%MIME%;base64,%DATA%@.+instance ToJSON (Base64Image a) where+  toJSON (Base64Image mime im) = String $ "data:" <> mime <> ";base64," <> im++-- | @getMimeType bs@ returns a possible mimetype for the given bytestring,+-- based on the first few magic bytes. It may return any of PNG/JPEG/GIF or WEBP+-- mimetypes, or Nothing if none are matched.+--+-- Reference: https://en.wikipedia.org/wiki/List_of_file_signatures+--+-- Although Discord's official documentation does not state WEBP as a supported+-- format, it has been accepted for both emojis and user avatars no problem+-- when tested manually.+--+-- /Inspired by discord.py's implementation./+getMimeType :: B.ByteString -> Maybe T.Text+getMimeType bs+  | B.take 8 bs == "\x89\x50\x4E\x47\x0D\x0A\x1A\x0A"+  = Just "image/png"+  | B.take 3 bs == "\xff\xd8\xff" || B.take 4 (B.drop 6 bs) `elem` ["JFIF", "Exif"]+  = Just "image/jpeg"+  | B.take 6 bs == "\x47\x49\x46\x38\x37\x61" || B.take 6 bs == "\x47\x49\x46\x38\x39\x61"+  = Just "image/gif"+  | B.take 4 bs == "RIFF" && B.take 4 (B.drop 8 bs) == "WEBP"+  = Just "image/webp"+  | otherwise = Nothing

@@ -73,7 +73,7 @@ -- TODO: fully update webhook structure data Webhook = Webhook   { webhookId :: WebhookId-  , webhookToken :: Maybe Text+  , webhookToken :: Maybe WebhookToken   , webhookChannelId :: ChannelId   } deriving (Show, Read, Eq, Ord) @@ -83,16 +83,17 @@             <*> o .:? "token"             <*> o .:  "channel_id" +-- | The connection object that the user has attached. data ConnectionObject = ConnectionObject-  { connectionObjectId :: Text-  , connectionObjectName :: Text-  , connectionObjectType :: Text-  , connectionObjectRevoked :: Bool-  , connectionObjectIntegrations :: [IntegrationId]-  , connectionObjectVerified :: Bool-  , connectionObjectFriendSyncOn :: Bool-  , connectionObjectShownInPresenceUpdates :: Bool-  , connectionObjectVisibleToOthers :: Bool+  { connectionObjectId :: Text -- ^ id of the connection account+  , connectionObjectName :: Text -- ^ the username of the connection account+  , connectionObjectType :: Text -- ^ the service of the connection (twitch, youtube)+  , connectionObjectRevoked :: Bool -- ^ whether the connection is revoked+  , connectionObjectIntegrations :: [IntegrationId] -- ^ List of server `IntegrationId`+  , connectionObjectVerified :: Bool -- ^ whether the connection is verified+  , connectionObjectFriendSyncOn :: Bool -- ^ whether friend sync is enabled for this connection+  , connectionObjectShownInPresenceUpdates :: Bool -- ^ whether activities related to this connection will be shown in presence updates+  , connectionObjectVisibleToOthers :: Bool -- ^ visibility of this connection   } deriving (Show, Read, Eq, Ord)  instance FromJSON ConnectionObject where

@@ -8,6 +8,7 @@     , GatewayReceivable(..)     , EventInternalParse(..)     , InternalDiscordEnum(..)+    , Base64Image(..)      , colorToInternal     , convertToRGB