discord-haskell 1.12.0 → 1.12.1

raw patch · 16 files changed

+916/−318 lines, 16 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README.md +33/−52
• changelog.md +6/−0
• discord-haskell.cabal +1/−1
• examples/ping-pong.hs +4/−4
• src/Discord/Internal/Gateway/Cache.hs +5/−5
• src/Discord/Internal/Gateway/EventLoop.hs +2/−1
• src/Discord/Internal/Rest/Channel.hs +195/−56
• src/Discord/Internal/Rest/Prelude.hs +7/−3
• src/Discord/Internal/Types.hs +6/−1
• src/Discord/Internal/Types/ApplicationCommands.hs +3/−3
• src/Discord/Internal/Types/Channel.hs +179/−8
• src/Discord/Internal/Types/Components.hs +87/−26
• src/Discord/Internal/Types/Events.hs +81/−82
• src/Discord/Internal/Types/Gateway.hs +5/−20
• src/Discord/Internal/Types/Guild.hs +202/−40
• src/Discord/Internal/Types/Interactions.hs +100/−16

@@ -1,38 +1,32 @@-# 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/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) -## About -Build that discord bot in Haskell! Also checkout the [calamity haskell library](https://github.com/nitros12/calamity)-for a more advanced interface than `discord-haskell`.+Build that discord bot in Haskell! Also checkout the+[calamity haskell library](https://github.com/nitros12/calamity)+for a more advanced interface. -### Documentation  + #### Local Documentation -Find docs on features, metadata, and parts is found in [./docs/README.md#Documentation](./docs/README.md#Documentation)+Documentation on specific features and metadata is in [the local documentation folder](./docs/README.md#Documentation)  #### Discord Server -Current project discord server: <https://discord.gg/eaRAGgX3bK>--Ask questions, get updates, request features, etc+Ask questions, get updates, request features, etc in the project discord server: <https://discord.gg/eaRAGgX3bK>  #### Official Discord Documentation -The [official discord documentation](https://discord.com/developers/docs/intro)-lists the rest requests, gateway events, and gateway sendables. The library-matches very closely. +This api closley matches the [official discord documentation](https://discord.com/developers/docs/intro),+which lists the rest requests, gateway events, and gateway sendables. -For example: -[Get Channel](https://discord.com/developers/docs/resources/channel#get-channel)-and discord-haskell has a rest request ADT including -`[GetChannel :: ChannelId -> ChannelRequest Channel]`. Similar matching exists for gateway `Event`s.+You can use the docs to check the name of something you want to do. For example: +the docs list a [Get Channel](https://discord.com/developers/docs/resources/channel#get-channel) API path,+which translates to discord-haskell's rest request ADT for `GetChannel` of type `ChannelId -> ChannelRequest Channel`.   #### Open an Issue -If something goes wrong: check the error message, (optional: check log file), make sure you have the most recent version, ask on discord, or open a github issue.--## Implementation and Progress+If something goes wrong: check the error message (optional: check [the debugging logs](./docs/debugging.md)), make sure you have the most recent version, ask on discord, or open a github issue.  ### Quickstart @@ -40,12 +34,13 @@  ```haskell {-# LANGUAGE OverloadedStrings #-}  -- allows "string literals" to be Text-import Control.Monad (when, void)-import Data.Text (isPrefixOf, toLower, Text)+import           Control.Monad (when, void)+import           UnliftIO.Concurrent+import           Data.Text (isPrefixOf, toLower, Text) import qualified Data.Text.IO as TIO-import UnliftIO.Concurrent-import Discord-import Discord.Types++import           Discord+import           Discord.Types import qualified Discord.Requests as R  -- | Replies "pong" to every message that starts with "ping"@@ -53,16 +48,14 @@ pingpongExample = do      userFacingError <- runDiscord $ def              { discordToken = "Bot ZZZZZZZZZZZZZZZZZZZ"-             , discordOnEvent = eventHandler-             , discordOnLog = \s -> TIO.putStrLn s-             , discordForkThreadForEvents = True }+             , discordOnEvent = eventHandler    }     TIO.putStrLn userFacingError     -- userFacingError is an unrecoverable error     -- put normal 'cleanup' code in discordOnEnd (see examples)  eventHandler :: Event -> DiscordHandler () eventHandler event = case event of-       MessageCreate m -> when (not (fromBot m) && isPing m) $ do+       MessageCreate m -> when (isPing m && (not (fromBot m)) $ do                void $ restCall (R.CreateReaction (messageChannelId m, messageId m) "eyes")                threadDelay (2 * 10^6)                void $ restCall (R.CreateMessage (messageChannelId m) "Pong!")@@ -75,32 +68,11 @@ isPing = ("ping" `isPrefixOf`) . toLower . messageContent ``` -```cabal--- ping-pong.cabal--executable haskell-bot-  main-is:             src/Main.hs-  default-language:    Haskell2010-  ghc-options:         -threaded-  build-depends:       base-                     , text-                     , unliftio-                     , discord-haskell-```--### Biggest TODOs--- [ ] Add slash commands [issue](https://github.com/aquarial/discord-haskell/issues/59)-- [ ] APIv9 [issue](https://github.com/aquarial/discord-haskell/issues/72)-- [ ] Event type includes roles and other cached info-- [ ] higher level bot interface? easier to add state and stuff-- [x] rewrite eventloop [issue](https://github.com/aquarial/discord-haskell/issues/70)- ### Installing  discord-haskell is on hosted on hackage at https://hackage.haskell.org/package/discord-haskell,  -In `stack.yaml`+Add the following to your `stack.yaml` (if using stack)  ```yaml extra-deps:@@ -108,7 +80,7 @@ - discord-haskell-VERSION ``` -In `project.cabal`+And add this to the `project.cabal`  ```cabal executable haskell-bot@@ -117,7 +89,8 @@   ghc-options:         -threaded   build-depends:       base                      , text-                     , discord-haskell+                     , discord-haskell +             --                          == VERSION      (if using cabal) ```  For a more complete example with various options go to @@ -127,5 +100,13 @@ [Creating your first Bot](https://github.com/aquarial/discord-haskell/wiki/Creating-your-first-Bot) for some help setting up your bot token +++### Rough Roadmap++- [ ] Add slash commands [issue](https://github.com/aquarial/discord-haskell/issues/59)+- [ ] APIv9 [issue](https://github.com/aquarial/discord-haskell/issues/72)+- [ ] Event type includes roles and other cached info+- [ ] higher level bot interface? easier to add state and stuff   

@@ -6,6 +6,12 @@  ## master +## 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/aquarial/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

@@ -1,7 +1,7 @@ cabal-version:       2.0 name:                discord-haskell -- library version is also noted at src/Discord/Rest/Prelude.hs-version:             1.12.0+version:             1.12.1 description:         Functions and data types to write discord bots.                      Official discord docs <https://discord.com/developers/docs/reference>.                      .

@@ -36,6 +36,7 @@                           , discordOnEnd = liftIO $ putStrLn "Ended"                           , discordOnEvent = eventHandler                           , discordOnLog = \s -> TIO.putStrLn s >> TIO.putStrLn ""+                          , discordGatewayIntent = def {gatewayIntentMembers = True, gatewayIntentPrecenses =True}                           }    -- only reached on an unrecoverable error@@ -46,10 +47,9 @@ --     Use place to execute commands you know you want to complete startHandler :: DiscordHandler () startHandler = do-  let activity = Activity { activityName = "ping-pong"-                          , activityType = ActivityTypeGame-                          , activityUrl = Nothing-                          }+  let activity = def { activityName = "ping-pong"+                     , activityType = ActivityTypeGame+                     }   let opts = UpdateStatusOpts { updateStatusOptsSince = Nothing                               , updateStatusOptsGame = Just activity                               , updateStatusOptsNewStatus = UpdateStatusOnline

@@ -16,7 +16,7 @@ data Cache = Cache      { cacheCurrentUser :: User      , cacheDMChannels :: M.Map ChannelId Channel-     , cacheGuilds :: M.Map GuildId (Guild, GuildInfo)+     , cacheGuilds :: M.Map GuildId Guild      , cacheChannels :: M.Map ChannelId Channel      , cacheApplication :: PartialApplication      } deriving (Show)@@ -54,10 +54,10 @@  adjustCache :: Cache -> EventInternalParse -> Cache adjustCache minfo event = case event of-  InternalGuildCreate guild info ->-    let newChans = map (setChanGuildID (guildId guild)) $ guildChannels info-        g = M.insert (guildId guild) (guild, info { guildChannels = newChans }) (cacheGuilds minfo)-        c = M.unionWith (\a _ -> a)+  InternalGuildCreate guild ->+    let newChans = maybe [] (map (setChanGuildID (guildId guild))) (guildChannels guild)+        g = M.insert (guildId guild) (guild { guildChannels = Just newChans }) (cacheGuilds minfo)+        c = M.unionWith const                         (M.fromList [ (channelId ch, ch) | ch <- newChans ])                         (cacheChannels minfo)     in minfo { cacheGuilds = g, cacheChannels = c }

@@ -24,6 +24,7 @@                            receiveData, sendTextData, sendClose)  import Discord.Internal.Types+import Discord.Internal.Rest.Prelude (apiVersion)   data GatewayHandle = GatewayHandle@@ -102,7 +103,7 @@       LoopClosed -> pure Nothing    startconnectionpls :: GatewaySendableInternal -> IO LoopState-  startconnectionpls first = runSecureClient "gateway.discord.gg" 443 "/?v=8&encoding=json" $ \conn -> do+  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

@@ -16,6 +16,9 @@   , ChannelPermissionsOpts(..)   , GroupDMAddRecipientOpts(..)   , ChannelPermissionsOptsType(..)+  , StartThreadOpts(..)+  , StartThreadNoMessageOpts(..)+  , ListThreads(..)   ) where  @@ -41,60 +44,91 @@ -- | Data constructor for requests. See <https://discord.com/developers/docs/resources/ API> data ChannelRequest a where   -- | Gets a channel by its id.-  GetChannel              :: ChannelId -> ChannelRequest Channel+  GetChannel                :: ChannelId -> ChannelRequest Channel   -- | Edits channels options.-  ModifyChannel           :: ChannelId -> ModifyChannelOpts -> ChannelRequest Channel+  ModifyChannel             :: ChannelId -> ModifyChannelOpts -> ChannelRequest Channel   -- | Deletes a channel if its id doesn't equal to the id of guild.-  DeleteChannel           :: ChannelId -> ChannelRequest Channel+  DeleteChannel             :: ChannelId -> ChannelRequest Channel   -- | Gets a messages from a channel with limit of 100 per request.-  GetChannelMessages      :: ChannelId -> (Int, MessageTiming) -> ChannelRequest [Message]+  GetChannelMessages        :: ChannelId -> (Int, MessageTiming) -> ChannelRequest [Message]   -- | Gets a message in a channel by its id.-  GetChannelMessage       :: (ChannelId, MessageId) -> ChannelRequest Message+  GetChannelMessage         :: (ChannelId, MessageId) -> ChannelRequest Message   -- | Sends a message to a channel.-  CreateMessage           :: ChannelId -> T.Text -> ChannelRequest Message+  CreateMessage             :: ChannelId -> T.Text -> ChannelRequest Message   -- | Sends a message with a file to a channel.-  CreateMessageUploadFile :: ChannelId -> T.Text -> B.ByteString -> ChannelRequest Message+  CreateMessageUploadFile   :: ChannelId -> T.Text -> B.ByteString -> ChannelRequest Message   -- | Sends a message with granular controls.-  CreateMessageDetailed   :: ChannelId -> MessageDetailedOpts -> ChannelRequest Message+  CreateMessageDetailed     :: ChannelId -> MessageDetailedOpts -> ChannelRequest Message   -- | Add an emoji reaction to a message. ID must be present for custom emoji-  CreateReaction          :: (ChannelId, MessageId) -> T.Text -> ChannelRequest ()+  CreateReaction            :: (ChannelId, MessageId) -> T.Text -> ChannelRequest ()   -- | Remove a Reaction this bot added-  DeleteOwnReaction       :: (ChannelId, MessageId) -> T.Text -> ChannelRequest ()+  DeleteOwnReaction         :: (ChannelId, MessageId) -> T.Text -> ChannelRequest ()   -- | Remove a Reaction someone else added-  DeleteUserReaction      :: (ChannelId, MessageId) -> UserId -> T.Text -> ChannelRequest ()+  DeleteUserReaction        :: (ChannelId, MessageId) -> UserId -> T.Text -> ChannelRequest ()   -- | Deletes all reactions of a single emoji on a message-  DeleteSingleReaction    :: (ChannelId, MessageId) -> T.Text -> ChannelRequest ()+  DeleteSingleReaction      :: (ChannelId, MessageId) -> T.Text -> ChannelRequest ()   -- | List of users that reacted with this emoji-  GetReactions            :: (ChannelId, MessageId) -> T.Text -> (Int, ReactionTiming) -> ChannelRequest [User]+  GetReactions              :: (ChannelId, MessageId) -> T.Text -> (Int, ReactionTiming) -> ChannelRequest [User]   -- | Delete all reactions on a message-  DeleteAllReactions      :: (ChannelId, MessageId) -> ChannelRequest ()+  DeleteAllReactions        :: (ChannelId, MessageId) -> ChannelRequest ()   -- | Edits a message content.-  EditMessage             :: (ChannelId, MessageId) -> T.Text -> Maybe CreateEmbed-                                                    -> ChannelRequest Message+  EditMessage               :: (ChannelId, MessageId) -> T.Text -> Maybe CreateEmbed+                                                      -> ChannelRequest Message   -- | Deletes a message.-  DeleteMessage           :: (ChannelId, MessageId) -> ChannelRequest ()+  DeleteMessage             :: (ChannelId, MessageId) -> ChannelRequest ()   -- | Deletes a group of messages.-  BulkDeleteMessage       :: (ChannelId, [MessageId]) -> ChannelRequest ()+  BulkDeleteMessage         :: (ChannelId, [MessageId]) -> ChannelRequest ()   -- | Edits a permission overrides for a channel.-  EditChannelPermissions  :: ChannelId -> OverwriteId -> ChannelPermissionsOpts -> ChannelRequest ()+  EditChannelPermissions    :: ChannelId -> OverwriteId -> ChannelPermissionsOpts -> ChannelRequest ()   -- | Gets all instant invites to a channel.-  GetChannelInvites       :: ChannelId -> ChannelRequest Object+  GetChannelInvites         :: ChannelId -> ChannelRequest Object   -- | Creates an instant invite to a channel.-  CreateChannelInvite     :: ChannelId -> ChannelInviteOpts -> ChannelRequest Invite+  CreateChannelInvite       :: ChannelId -> ChannelInviteOpts -> ChannelRequest Invite   -- | Deletes a permission override from a channel.-  DeleteChannelPermission :: ChannelId -> OverwriteId -> ChannelRequest ()+  DeleteChannelPermission   :: ChannelId -> OverwriteId -> ChannelRequest ()   -- | Sends a typing indicator a channel which lasts 10 seconds.-  TriggerTypingIndicator  :: ChannelId -> ChannelRequest ()+  TriggerTypingIndicator    :: ChannelId -> ChannelRequest ()   -- | Gets all pinned messages of a channel.-  GetPinnedMessages       :: ChannelId -> ChannelRequest [Message]+  GetPinnedMessages         :: ChannelId -> ChannelRequest [Message]   -- | Pins a message.-  AddPinnedMessage        :: (ChannelId, MessageId) -> ChannelRequest ()+  AddPinnedMessage          :: (ChannelId, MessageId) -> ChannelRequest ()   -- | Unpins a message.-  DeletePinnedMessage     :: (ChannelId, MessageId) -> ChannelRequest ()+  DeletePinnedMessage       :: (ChannelId, MessageId) -> ChannelRequest ()   -- | Adds a recipient to a Group DM using their access token-  GroupDMAddRecipient     :: ChannelId -> GroupDMAddRecipientOpts -> ChannelRequest ()+  GroupDMAddRecipient       :: ChannelId -> GroupDMAddRecipientOpts -> ChannelRequest ()   -- | Removes a recipient from a Group DM-  GroupDMRemoveRecipient  :: ChannelId -> UserId -> ChannelRequest ()+  GroupDMRemoveRecipient    :: ChannelId -> UserId -> ChannelRequest ()+  -- | Start a thread from a message+  StartThreadFromMessage    :: ChannelId -> MessageId -> StartThreadOpts -> ChannelRequest Channel+  -- | Start a thread without a message+  StartThreadNoMessage      :: ChannelId -> StartThreadNoMessageOpts -> ChannelRequest Channel+  -- | Join a thread+  JoinThread                :: ChannelId -> ChannelRequest ()+  -- | Add a thread member+  AddThreadMember           :: ChannelId -> UserId -> ChannelRequest ()+  -- | Leave a thread+  LeaveThread               :: ChannelId -> ChannelRequest ()+  -- | Remove a thread member+  RemoveThreadMember        :: ChannelId -> UserId -> ChannelRequest ()+  -- | Get a thread member+  GetThreadMember           :: ChannelId -> UserId -> ChannelRequest ThreadMember+  -- | List the thread members+  ListThreadMembers         :: ChannelId -> ChannelRequest [ThreadMember]+  -- | List public archived threads in the given channel. Optionally before a +  -- given time, and optional maximum number of threads. Returns the threads, +  -- thread members,  and whether there are more to collect.+  -- Requires the READ_MESSAGE_HISTORY permission.+  ListPublicArchivedThreads :: ChannelId -> (Maybe UTCTime, Maybe Integer) -> ChannelRequest ListThreads+  -- | List private archived threads in the given channel. Optionally before a +  -- given time, and optional maximum number of threads. Returns the threads, +  -- thread members, and whether there are more to collect.+  -- Requires both the READ_MESSAGE_HISTORY and MANAGE_THREADS permissions.+  ListPrivateArchivedThreads :: ChannelId -> (Maybe UTCTime, Maybe Integer) -> ChannelRequest ListThreads+  -- | List joined private archived threads in the given channel. Optionally +  -- before a  given time, and optional maximum number of threads. Returns the +  -- threads, thread members, and whether there are more to collect.+  -- Requires both the READ_MESSAGE_HISTORY and MANAGE_THREADS permissions.+  ListJoinedPrivateArchivedThreads :: ChannelId -> (Maybe UTCTime, Maybe Integer) -> ChannelRequest ListThreads   -- | Data constructor for CreateMessageDetailed requests.@@ -107,7 +141,7 @@   , messageDetailedReference                :: Maybe MessageReference   , messageDetailedComponents               :: Maybe [ComponentActionRow]   , messageDetailedStickerIds               :: Maybe [StickerId]-  } deriving (Show, Eq, Ord, Read)+  } deriving (Show, Read, Eq, Ord)  instance Default MessageDetailedOpts where   def = MessageDetailedOpts { messageDetailedContent         = ""@@ -208,35 +242,95 @@   , groupDMAddRecipientGDMJoinAccessToken :: T.Text   } deriving (Show, Read, Eq, Ord) +data StartThreadOpts = StartThreadOpts +  { startThreadName :: T.Text+  , startThreadAutoArchive :: Maybe Integer -- ^ can be one of 60, 1440, 4320, 10080+  , startThreadRateLimit :: Maybe Integer+  } deriving (Show, Read, Eq, Ord)++instance ToJSON StartThreadOpts where+  toJSON StartThreadOpts{..} = object [ (name, value) | (name, Just value) <- +      [ ("name", toJSON <$> pure startThreadName)+      , ("auto_archive_duration", toJSON <$> startThreadAutoArchive)+      , ("rate_limit_per_user", toJSON <$> startThreadRateLimit)+      ]+    ]++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+  } deriving (Show, Read, Eq, Ord)++instance ToJSON StartThreadNoMessageOpts where+  toJSON StartThreadNoMessageOpts{..} = object [ (name, value) | (name, Just value) <- +      [ ("name", toJSON <$> pure (startThreadName startThreadNoMessageBaseOpts))+      , ("auto_archive_duration", toJSON <$> (startThreadAutoArchive startThreadNoMessageBaseOpts))+      , ("rate_limit_per_user", toJSON <$> (startThreadRateLimit startThreadNoMessageBaseOpts))+      , ("type", toJSON <$> pure startThreadNoMessageType)+      , ("invitable", toJSON <$> startThreadNoMessageInvitable)+      ]+    ]++data ListThreads = ListThreads +  { listThreadsThreads :: [Channel]+  , listThreadsMembers :: [ThreadMember]+  , listThreadsHasMore :: Bool -- ^ whether there is more data to retrieve+  } deriving (Show, Read, Eq, Ord)++instance ToJSON ListThreads where+  toJSON ListThreads{..} = object +    [ ("threads", toJSON listThreadsThreads)+    , ("members", toJSON listThreadsMembers)+    , ("has_more", toJSON listThreadsHasMore)+    ]++instance FromJSON ListThreads where+  parseJSON = withObject "ListThreads" $ \o ->+    ListThreads <$> o .: "threads"+                <*> o .: "members"+                <*> o .: "has_more"+ channelMajorRoute :: ChannelRequest a -> String channelMajorRoute c = case c of-  (GetChannel chan) ->                 "get_chan " <> show chan-  (ModifyChannel chan _) ->            "mod_chan " <> show chan-  (DeleteChannel chan) ->              "mod_chan " <> show chan-  (GetChannelMessages chan _) ->            "msg " <> show chan-  (GetChannelMessage (chan, _)) ->      "get_msg " <> show chan-  (CreateMessage chan _) ->                 "msg " <> show chan-  (CreateMessageUploadFile chan _ _) ->     "msg " <> show chan-  (CreateMessageDetailed chan _) ->         "msg " <> show chan-  (CreateReaction (chan, _) _) ->     "add_react " <> show chan-  (DeleteOwnReaction (chan, _) _) ->      "react " <> show chan-  (DeleteUserReaction (chan, _) _ _) ->   "react " <> show chan-  (DeleteSingleReaction (chan, _) _) ->   "react " <> show chan-  (GetReactions (chan, _) _ _) ->         "react " <> show chan-  (DeleteAllReactions (chan, _)) ->       "react " <> show chan-  (EditMessage (chan, _) _ _) ->        "get_msg " <> show chan-  (DeleteMessage (chan, _)) ->          "get_msg " <> show chan-  (BulkDeleteMessage (chan, _)) ->     "del_msgs " <> show chan-  (EditChannelPermissions chan _ _) ->    "perms " <> show chan-  (GetChannelInvites chan) ->           "invites " <> show chan-  (CreateChannelInvite chan _) ->       "invites " <> show chan-  (DeleteChannelPermission chan _) ->     "perms " <> show chan-  (TriggerTypingIndicator chan) ->          "tti " <> show chan-  (GetPinnedMessages chan) ->              "pins " <> show chan-  (AddPinnedMessage (chan, _)) ->           "pin " <> show chan-  (DeletePinnedMessage (chan, _)) ->        "pin " <> show chan-  (GroupDMAddRecipient chan _) ->       "groupdm " <> show chan-  (GroupDMRemoveRecipient chan _) ->    "groupdm " <> show chan+  (GetChannel chan) ->                       "get_chan " <> show chan+  (ModifyChannel chan _) ->                  "mod_chan " <> show chan+  (DeleteChannel chan) ->                    "mod_chan " <> show chan+  (GetChannelMessages chan _) ->                  "msg " <> show chan+  (GetChannelMessage (chan, _)) ->            "get_msg " <> show chan+  (CreateMessage chan _) ->                       "msg " <> show chan+  (CreateMessageUploadFile chan _ _) ->           "msg " <> show chan+  (CreateMessageDetailed chan _) ->               "msg " <> show chan+  (CreateReaction (chan, _) _) ->           "add_react " <> show chan+  (DeleteOwnReaction (chan, _) _) ->            "react " <> show chan+  (DeleteUserReaction (chan, _) _ _) ->         "react " <> show chan+  (DeleteSingleReaction (chan, _) _) ->         "react " <> show chan+  (GetReactions (chan, _) _ _) ->               "react " <> show chan+  (DeleteAllReactions (chan, _)) ->             "react " <> show chan+  (EditMessage (chan, _) _ _) ->              "get_msg " <> show chan+  (DeleteMessage (chan, _)) ->                "get_msg " <> show chan+  (BulkDeleteMessage (chan, _)) ->           "del_msgs " <> show chan+  (EditChannelPermissions chan _ _) ->          "perms " <> show chan+  (GetChannelInvites chan) ->                 "invites " <> show chan+  (CreateChannelInvite chan _) ->             "invites " <> show chan+  (DeleteChannelPermission chan _) ->           "perms " <> show chan+  (TriggerTypingIndicator chan) ->                "tti " <> show chan+  (GetPinnedMessages chan) ->                    "pins " <> show chan+  (AddPinnedMessage (chan, _)) ->                 "pin " <> show chan+  (DeletePinnedMessage (chan, _)) ->              "pin " <> show chan+  (GroupDMAddRecipient chan _) ->             "groupdm " <> show chan+  (GroupDMRemoveRecipient chan _) ->          "groupdm " <> show chan+  (StartThreadFromMessage chan _ _) ->         "thread " <> show chan+  (StartThreadNoMessage chan _) ->           "thread " <> show chan+  (JoinThread chan) ->                         "thread " <> show chan+  (AddThreadMember chan _) ->                  "thread " <> show chan+  (LeaveThread chan) ->                        "thread " <> show chan+  (RemoveThreadMember chan _) ->               "thread " <> show chan+  (GetThreadMember chan _) ->                  "thread " <> show chan+  (ListThreadMembers chan) ->                  "thread " <> show chan+  (ListPublicArchivedThreads chan _) ->        "thread " <> show chan+  (ListPrivateArchivedThreads chan _) ->       "thread " <> show chan+  (ListJoinedPrivateArchivedThreads chan _) -> "thread " <> show chan  cleanupEmoji :: T.Text -> T.Text cleanupEmoji emoji =@@ -380,3 +474,48 @@   (GroupDMRemoveRecipient chan userid) ->       Delete (channels // chan // chan /: "recipients" // userid) mempty +  (StartThreadFromMessage chan mid sto) ->+      Post (channels // chan /: "messages" // mid /: "threads")+           (pure $ R.ReqBodyJson $ toJSON sto)+           mempty++  (StartThreadNoMessage chan sto) ->+      Post (channels // chan /: "messages" /: "threads")+           (pure $ R.ReqBodyJson $ toJSON sto)+           mempty++  (JoinThread chan) ->+      Put (channels // chan /: "thread-members" /: "@me")+          R.NoReqBody mempty++  (AddThreadMember chan uid) ->+      Put (channels // chan /: "thread-members" // uid)+          R.NoReqBody mempty++  (LeaveThread chan) ->+      Delete (channels // chan /: "thread-members" /: "@me")+          mempty++  (RemoveThreadMember chan uid) ->+      Delete (channels // chan /: "thread-members" // uid)+          mempty++  (GetThreadMember chan uid) ->+      Get (channels // chan /: "thread-members" // uid)+          mempty++  (ListThreadMembers chan) ->+      Get (channels // chan /: "thread-members")+          mempty++  (ListPublicArchivedThreads chan (time, lim)) ->+      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")+          (maybe mempty ("limit" R.=:) lim <> maybe mempty ("before" R.=:) time)++  (ListJoinedPrivateArchivedThreads chan (time, lim)) ->+      Get (channels // chan /: "users" /: "@me" /: "threads" /: "archived" /: "private")+          (maybe mempty ("limit" R.=:) lim <> maybe mempty ("before" R.=:) time)

@@ -17,10 +17,14 @@  import Discord.Internal.Types +-- | The api version to use.+apiVersion :: T.Text+apiVersion = "10"+ -- | The base url (Req) for API requests baseUrl :: R.Url 'R.Https-baseUrl = R.https "discord.com" R./: "api" R./: apiVersion-  where apiVersion = "v8"+baseUrl = R.https "discord.com" R./: "api" R./: apiVersion'+  where apiVersion' = "v" <> apiVersion  -- | Discord requires HTTP headers for authentication. authHeader :: Auth -> R.Option 'R.Https@@ -30,7 +34,7 @@   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.12.0)"+  agent = "DiscordBot (https://github.com/aquarial/discord-haskell, 1.12.1)"  -- Append to an URL infixl 5 //

@@ -34,8 +34,13 @@   InternalChannelCreate a -> ChannelCreate a   InternalChannelUpdate a -> ChannelUpdate a   InternalChannelDelete a -> ChannelDelete a+  InternalThreadCreate a -> ThreadCreate a+  InternalThreadUpdate a -> ThreadUpdate a+  InternalThreadDelete a -> ThreadDelete a+  InternalThreadListSync a -> ThreadListSync a+  InternalThreadMembersUpdate a -> ThreadMembersUpdate a   InternalChannelPinsUpdate a b -> ChannelPinsUpdate a b-  InternalGuildCreate a b -> GuildCreate a b+  InternalGuildCreate a -> GuildCreate a   InternalGuildUpdate a -> GuildUpdate a   InternalGuildDelete a -> GuildDelete a   InternalGuildBanAdd a b -> GuildBanAdd a b

@@ -538,7 +538,7 @@       ]  data Choice a = Choice {choiceName :: T.Text, choiceValue :: a}-  deriving (Show, Read, Eq)+  deriving (Show, Read, Eq, Ord)  instance Functor Choice where   fmap f (Choice s a) = Choice s (f a)@@ -632,7 +632,7 @@     -- | The permissions for the command in the guild.     guildApplicationCommandPermissionsPermissions :: [ApplicationCommandPermissions]   }-  deriving (Show, Eq, Ord, Read)+  deriving (Show, Read, Eq, Ord)  instance FromJSON GuildApplicationCommandPermissions where   parseJSON =@@ -668,7 +668,7 @@     -- | Whether to allow or not.     applicationCommandPermissionsPermission :: Bool   }-  deriving (Show, Eq, Ord, Read)+  deriving (Show, Read, Eq, Ord)  instance FromJSON ApplicationCommandPermissions where   parseJSON =

@@ -28,7 +28,7 @@       { 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 guild (2 - 1000 characters).+      , 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@@ -94,6 +94,39 @@       , channelStageId     :: StageId       , channelStageTopic  :: Text       }+  | 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).+      , 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)+      , channelThreadMetadata :: Maybe ThreadMetadata -- ^ Metadata about this thread+      , channelThreadMember :: Maybe ThreadMember -- ^ Used to indicate if the user has joined the thread+      }+  | 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).+      , 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)+      , channelThreadMetadata :: Maybe ThreadMetadata -- ^ Metadata about this thread+      , channelThreadMember :: Maybe ThreadMember -- ^ Used to indicate if the user has joined the 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).+      , 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)+      , channelThreadMetadata :: Maybe ThreadMetadata -- ^ Metadata about this thread+      , channelThreadMember :: Maybe ThreadMember -- ^ Used to indicate if the user has joined the thread+      }   | ChannelUnknownType       { channelId          :: ChannelId       , channelJSON        :: Text@@ -155,6 +188,30 @@                          <*> o .:? "nsfw" .!= False                          <*> o .:  "permission_overwrites"                          <*> o .:? "parent_id"+      10 -> ChannelNewsThread <$> o.: "id"+                              <*> o .:? "guild_id" .!= 0+                              <*> o .:? "name"+                              <*> o .:? "rate_limit_per_user"+                              <*> o .:? "last_message_id"+                              <*> o .:? "parent_id"+                              <*> o .:? "thread_metadata"+                              <*> o .:? "member"+      11 -> ChannelPublicThread <$> o.: "id"+                                <*> o .:? "guild_id" .!= 0+                                <*> o .:? "name"+                                <*> o .:? "rate_limit_per_user"+                                <*> o .:? "last_message_id"+                                <*> o .:? "parent_id"+                                <*> o .:? "thread_metadata"+                                <*> o .:? "member"+      12 -> ChannelPrivateThread <$> o.: "id"+                                 <*> o .:? "guild_id" .!= 0+                                 <*> o .:? "name"+                                 <*> o .:? "rate_limit_per_user"+                                 <*> o .:? "last_message_id"+                                 <*> o .:? "parent_id"+                                 <*> o .:? "thread_metadata"+                                 <*> o .:? "member"       13 ->         ChannelStage <$> o .:  "id"                      <*> o .:? "guild_id" .!= 0@@ -225,6 +282,36 @@               , ("channel_id", toJSON <$> pure channelStageId)               , ("topic", toJSON <$> pure channelStageTopic)               ] ]+  toJSON ChannelNewsThread{..} = object [(name,value) | (name, Just value) <-+              [ ("id",     toJSON <$> pure channelId)+              , ("guild_id", toJSON <$> pure channelGuild)+              , ("name",  toJSON <$> channelThreadName)+              , ("rate_limit_per_user", toJSON <$> channelUserRateLimitThread)+              , ("last_message_id",  toJSON <$> channelLastMessage)+              , ("parent_id",  toJSON <$> pure channelParentId)+              , ("thread_metadata", toJSON <$> channelThreadMetadata)+              , ("member", toJSON <$> channelThreadMember)+              ] ]+  toJSON ChannelPublicThread{..} = object [(name,value) | (name, Just value) <-+              [ ("id",     toJSON <$> pure channelId)+              , ("guild_id", toJSON <$> pure channelGuild)+              , ("name",  toJSON <$> channelThreadName)+              , ("rate_limit_per_user", toJSON <$> channelUserRateLimitThread)+              , ("last_message_id",  toJSON <$> channelLastMessage)+              , ("parent_id",  toJSON <$> pure channelParentId)+              , ("thread_metadata", toJSON <$> channelThreadMetadata)+              , ("member", toJSON <$> channelThreadMember)+              ] ]+  toJSON ChannelPrivateThread{..} = object [(name,value) | (name, Just value) <-+              [ ("id",     toJSON <$> pure channelId)+              , ("guild_id", toJSON <$> pure channelGuild)+              , ("name",  toJSON <$> channelThreadName)+              , ("rate_limit_per_user", toJSON <$> channelUserRateLimitThread)+              , ("last_message_id",  toJSON <$> channelLastMessage)+              , ("parent_id",  toJSON <$> pure channelParentId)+              , ("thread_metadata", toJSON <$> channelThreadMetadata)+              , ("member", toJSON <$> channelThreadMember)+              ] ]   toJSON ChannelUnknownType{..} = object [(name,value) | (name, Just value) <-               [ ("id",     toJSON <$> pure channelId)               , ("json", toJSON <$> pure channelJSON)@@ -233,11 +320,14 @@ -- | If the channel is part of a guild (has a guild id field) channelIsInGuild :: Channel -> Bool channelIsInGuild c = case c of-        ChannelGuildCategory{..} -> True-        ChannelText{..} -> True-        ChannelVoice{..}  -> True-        ChannelNews{..}  -> True-        ChannelStorePage{..}  -> True+        ChannelGuildCategory{} -> True+        ChannelText{} -> True+        ChannelVoice{} -> True+        ChannelNews{} -> True+        ChannelStorePage{} -> True+        ChannelNewsThread{} -> True+        ChannelPublicThread{} -> True+        ChannelPrivateThread{} -> True         _ -> False  -- | Permission overwrites for a channel.@@ -263,6 +353,87 @@               , ("deny",   toJSON overwriteDeny)               ] +-- | Metadata for threads.+data ThreadMetadata = ThreadMetadata+ { threadMetadataArchived :: Bool -- ^ Is the thread archived?+ , threadMetadataAutoArchive :: Integer -- ^ How long after activity should the thread auto archive+ , threadMetadataArchiveTime :: UTCTime -- ^ When was the last time the archive status changed?+ , threadMetadataLocked :: Bool -- ^ Is the thread locked? (only MANAGE_THREADS users can unarchive)+ , threadMetadataInvitable :: Maybe Bool -- ^ Can non-mods add other non-mods? (private threads only)+ , threadMetadataCreateTime :: Maybe UTCTime -- ^ When was the thread created?+ } deriving (Show, Read, Eq, Ord)++instance FromJSON ThreadMetadata where+  parseJSON = withObject "ThreadMetadata" $ \o ->+    ThreadMetadata <$> o .:  "archived"+                   <*> o .:  "auto_archive_duration"+                   <*> o .:  "archive_timestamp"+                   <*> o .:  "locked"+                   <*> o .:? "invitable"+                   <*> o .:? "create_timestamp"++instance ToJSON ThreadMetadata where+  toJSON ThreadMetadata{..} =  object [(name,value) | (name, Just value) <-+              [ ("archived", toJSON <$> pure threadMetadataArchived)+              , ("auto_archive_duration", toJSON <$> pure threadMetadataAutoArchive)+              , ("archive_timestamp", toJSON <$> pure threadMetadataArchiveTime)+              , ("locked", toJSON <$> pure threadMetadataLocked)+              , ("invitable", toJSON <$> threadMetadataInvitable)+              , ("create_timestamp", toJSON <$> pure threadMetadataCreateTime)+              ] ]++data ThreadMember = ThreadMember+ { threadMemberThreadId :: Maybe ChannelId -- ^ id of the thread+ , threadMemberUserId   :: Maybe UserId    -- ^ id of the user+ , threadMemberJoinTime :: UTCTime         -- ^ time the current user last joined the thread+ , threadMemberFlags    :: Integer         -- ^ user-thread settings+ } deriving (Show, Read, Eq, Ord)++instance FromJSON ThreadMember where+  parseJSON = withObject "ThreadMember" $ \o ->+    ThreadMember <$> o .:? "id"+                 <*> o .:? "user_id"+                 <*> o .:  "join_timestamp"+                 <*> o .:  "flags"++instance ToJSON ThreadMember where+  toJSON ThreadMember{..} =  object [(name,value) | (name, Just value) <-+              [ ("id", toJSON <$> threadMemberThreadId)+              , ("user_id", toJSON <$> threadMemberUserId)+              , ("join_timestamp", toJSON <$> pure threadMemberJoinTime)+              , ("flags", toJSON <$> pure threadMemberFlags)+              ] ]++data ThreadListSyncFields = ThreadListSyncFields +  { threadListSyncFieldsGuildId :: GuildId+  , threadListSyncFieldsChannelIds :: Maybe [ChannelId]+  , threadListSyncFieldsThreads :: [Channel]+  , threadListSyncFieldsThreadMembers :: [ThreadMember]+  } deriving (Show, Read, Eq, Ord)++instance FromJSON ThreadListSyncFields where+  parseJSON = withObject "ThreadListSyncFields" $ \o ->+    ThreadListSyncFields <$> o .: "guild_id"+                         <*> o .:? "channel_ids"+                         <*> o .:  "threads"+                         <*> o .:  "members"++data ThreadMembersUpdateFields = ThreadMembersUpdateFields +  { threadMembersUpdateFieldsThreadId :: ChannelId+  , threadMembersUpdateFieldsGuildId :: GuildId+  , threadMembersUpdateFieldsMemberCount :: Integer+  , threadMembersUpdateFieldsAddedMembers :: Maybe [ThreadMember]+  , threadMembersUpdateFieldsRemovedMembers :: Maybe [UserId]+  } deriving (Show, Read, Eq, Ord)++instance FromJSON ThreadMembersUpdateFields where+  parseJSON = withObject "ThreadMembersUpdateFields" $ \o ->+    ThreadMembersUpdateFields <$> o .:  "id"+                              <*> o .:  "guild_id"+                              <*> o .:  "member_count"+                              <*> o .:? "added_members"+                              <*> o .:? "removed_member_ids"+ -- | Represents information about a message in a Discord channel. data Message = Message   { messageId                 :: MessageId                -- ^ The id of the message@@ -300,7 +471,7 @@   , messageThread             :: Maybe Channel            -- ^ the thread that was started from this message, includes thread member object   , messageComponents         :: Maybe [ComponentActionRow]        -- ^ sent if the message contains components like buttons, action rows, or other interactive components   , messageStickerItems       :: Maybe [StickerItem]      -- ^ sent if the message contains stickers-  } deriving (Show, Eq, Ord, Read)+  } deriving (Show, Read, Eq, Ord)  instance FromJSON Message where   parseJSON = withObject "Message" $ \o ->@@ -675,7 +846,7 @@   , messageInteractionType :: Integer -- ^ Type of the interaction (liekly always application command)   , messageInteractionName :: T.Text -- ^ Name of the interaction   , messageInteractionUser :: User -- ^ User who invoked the interaction-  } deriving (Show, Eq, Ord, Read)+  } deriving (Show, Read, Eq, Ord)  instance ToJSON MessageInteraction where   toJSON MessageInteraction{..} = object [(name,value) | (name, Just value) <-

@@ -15,6 +15,8 @@     mkSelectMenu,     SelectOption (..),     mkSelectOption,+    ComponentTextInput (..),+    mkComponentTextInput,     Emoji (..),     mkEmoji,   )@@ -29,28 +31,32 @@ import Discord.Internal.Types.User (User)  data ComponentActionRow = ComponentActionRowButton [ComponentButton] | ComponentActionRowSelectMenu ComponentSelectMenu-  deriving (Show, Eq, Ord, Read)+  deriving (Show, Read, Eq, Ord)  instance FromJSON ComponentActionRow where   parseJSON =     withObject       "ComponentActionRow"       ( \cs -> do-          a <- cs .: "components" :: Parser Array-          let a' = toList a-          case a' of-            [] -> return $ ComponentActionRowButton []-            (c : _) ->-              withObject-                "ComponentActionRow item"-                ( \v -> do-                    t <- v .: "type" :: Parser Int-                    case t of-                      2 -> ComponentActionRowButton <$> mapM parseJSON a'-                      3 -> ComponentActionRowSelectMenu <$> parseJSON c-                      _ -> fail $ "unknown component type: " ++ show t-                )-                c+          t <- cs .: "type" :: Parser Int+          case t of+            1 -> do+              a <- cs .: "components" :: Parser Array+              let a' = toList a+              case a' of+                [] -> return $ ComponentActionRowButton []+                (c : _) ->+                  withObject+                    "ComponentActionRow item"+                    ( \v -> do+                        t' <- v .: "type" :: Parser Int+                        case t' of+                          2 -> ComponentActionRowButton <$> mapM parseJSON a'+                          3 -> ComponentActionRowSelectMenu <$> parseJSON c+                          _ -> fail $ "unknown component type: " ++ show t+                    )+                    c+            _ -> fail $ "expected action row type (1), got: " ++ show t       )  instance ToJSON ComponentActionRow where@@ -69,7 +75,7 @@         -- | What is the style of the button         componentButtonStyle :: ButtonStyle,         -- | What is the user-facing label of the button-        componentButtonLabel :: T.Text,+        componentButtonLabel :: Maybe T.Text,         -- | What emoji is displayed on the button         componentButtonEmoji :: Maybe Emoji       }@@ -80,15 +86,15 @@         -- | Whether the button is disabled         componentButtonDisabled :: Bool,         -- | What is the user-facing label of the button-        componentButtonLabel :: T.Text,+        componentButtonLabel :: Maybe T.Text,         -- | What emoji is displayed on the button         componentButtonEmoji :: Maybe Emoji       }-  deriving (Show, Eq, Ord, Read)+  deriving (Show, Read, Eq, Ord)  -- | Takes the label and the custom id of the button that is to be generated. mkButton :: T.Text -> T.Text -> ComponentButton-mkButton label customId = ComponentButton customId False ButtonStyleSecondary label Nothing+mkButton label customId = ComponentButton customId False ButtonStyleSecondary (Just label) Nothing  instance FromJSON ComponentButton where   parseJSON =@@ -99,7 +105,7 @@           case t of             2 -> do               disabled <- v .:? "disabled" .!= False-              label <- v .: "label"+              label <- v .:? "label"               partialEmoji <- v .:? "emoji"               style <- v .: "style" :: Parser Scientific               case style of@@ -126,7 +132,7 @@         | (name, Just value) <-             [ ("type", Just $ Number 2),               ("style", Just $ Number 5),-              ("label", toMaybeJSON componentButtonLabel),+              ("label", toJSON <$> componentButtonLabel),               ("disabled", toMaybeJSON componentButtonDisabled),               ("url", toMaybeJSON componentButtonUrl),               ("emoji", toJSON <$> componentButtonEmoji)@@ -138,7 +144,7 @@         | (name, Just value) <-             [ ("type", Just $ Number 2),               ("style", Just $ toJSON componentButtonStyle),-              ("label", toMaybeJSON componentButtonLabel),+              ("label", toJSON <$> componentButtonLabel),               ("disabled", toMaybeJSON componentButtonDisabled),               ("custom_id", toMaybeJSON componentButtonCustomId),               ("emoji", toJSON <$> componentButtonEmoji)@@ -155,7 +161,7 @@     ButtonStyleSuccess   | -- | Red button     ButtonStyleDanger-  deriving (Show, Eq, Ord, Read)+  deriving (Show, Read, Eq, Ord)  instance FromJSON ButtonStyle where   parseJSON =@@ -192,7 +198,7 @@     -- | Maximum number of values to select (def 1, max 25)     componentSelectMenuMaxValues :: Maybe Integer   }-  deriving (Show, Eq, Ord, Read)+  deriving (Show, Read, Eq, Ord)  -- | Takes the custom id and the options of the select menu that is to be -- generated.@@ -246,7 +252,7 @@     -- | Use this value by default     selectOptionDefault :: Maybe Bool   }-  deriving (Show, Eq, Ord, Read)+  deriving (Show, Read, Eq, Ord)  -- | Make a select option from the given label and value. mkSelectOption :: T.Text -> T.Text -> SelectOption@@ -272,6 +278,61 @@               ("default", toJSON <$> selectOptionDefault)             ]       ]++data ComponentTextInput = ComponentTextInput+  { -- | Dev identifier+    componentTextInputCustomId :: T.Text,+    -- | What style to use (short or paragraph)+    componentTextInputIsParagraph :: Bool,+    -- | The label for this component+    componentTextInputLabel :: T.Text,+    -- | The minimum input length for a text input (0-4000)+    componentTextInputMinLength :: Maybe Integer,+    -- | The maximum input length for a text input (1-4000)+    componentTextInputMaxLength :: Maybe Integer,+    -- | Whether this component is required to be filled+    componentTextInputRequired :: Bool,+    -- | The prefilled value for this component (max 4000)+    componentTextInputValue :: T.Text,+    -- | Placeholder text if empty (max 4000)+    componentTextInputPlaceholder :: T.Text+  }+  deriving (Show, Read, Eq, Ord)++instance ToJSON ComponentTextInput where+  toJSON ComponentTextInput {..} =+    object+      [ (name, value)+        | (name, Just value) <-+            [ ("type", Just $ Number 4),+              ("custom_id", toMaybeJSON componentTextInputCustomId),+              ("style", toMaybeJSON (1 + fromEnum componentTextInputIsParagraph)),+              ("label", toMaybeJSON componentTextInputLabel),+              ("min_length", toJSON <$> componentTextInputMinLength),+              ("max_length", toJSON <$> componentTextInputMaxLength),+              ("required", toMaybeJSON componentTextInputRequired),+              ("value", toMaybeJSON componentTextInputValue),+              ("placeholder", toMaybeJSON componentTextInputPlaceholder)+            ]+      ]++instance FromJSON ComponentTextInput where+  parseJSON = withObject "ComponentTextInput" $ \o -> do+    t <- o .: "type" :: Parser Int+    case t of+      4 ->+        ComponentTextInput <$> o .: "custom_id"+          <*> fmap (== (2 :: Int)) (o .:? "style" .!= 1)+          <*> o .:? "label" .!= ""+          <*> o .:? "min_length"+          <*> o .:? "max_length"+          <*> o .:? "required" .!= False+          <*> o .:? "value" .!= ""+          <*> o .:? "placeholder" .!= ""+      _ -> fail "expected text input, found other type of component"++mkComponentTextInput :: T.Text -> T.Text -> ComponentTextInput+mkComponentTextInput cid label = ComponentTextInput cid False label Nothing Nothing True "" ""  -- | Represents an emoticon (emoji) data Emoji = Emoji

@@ -15,7 +15,7 @@  import Discord.Internal.Types.Prelude import Discord.Internal.Types.Channel-import Discord.Internal.Types.Guild (Role, GuildInfo, GuildUnavailable, Guild)+import Discord.Internal.Types.Guild import Discord.Internal.Types.User (User, GuildMember) import Discord.Internal.Types.Interactions (Interaction) import Discord.Internal.Types.Components (Emoji)@@ -23,79 +23,89 @@  -- | Represents possible events sent by discord. Detailed information can be found at https://discord.com/developers/docs/topics/gateway. data Event =-    Ready                   Int User [Channel] [GuildUnavailable] T.Text (Maybe Shard) PartialApplication-  | Resumed                 [T.Text]-  | ChannelCreate           Channel-  | ChannelUpdate           Channel-  | ChannelDelete           Channel-  | ChannelPinsUpdate       ChannelId (Maybe UTCTime)-  | GuildCreate             Guild GuildInfo-  | GuildUpdate             Guild-  | GuildDelete             GuildUnavailable-  | GuildBanAdd             GuildId User-  | GuildBanRemove          GuildId User-  | GuildEmojiUpdate        GuildId [Emoji]-  | GuildIntegrationsUpdate GuildId-  | GuildMemberAdd          GuildId GuildMember-  | GuildMemberRemove       GuildId User-  | GuildMemberUpdate       GuildId [RoleId] User (Maybe T.Text)-  | GuildMemberChunk        GuildId [GuildMember]-  | GuildRoleCreate         GuildId Role-  | GuildRoleUpdate         GuildId Role-  | GuildRoleDelete         GuildId RoleId-  | MessageCreate           Message-  | MessageUpdate           ChannelId MessageId-  | MessageDelete           ChannelId MessageId-  | MessageDeleteBulk       ChannelId [MessageId]-  | MessageReactionAdd      ReactionInfo-  | MessageReactionRemove   ReactionInfo-  | MessageReactionRemoveAll ChannelId MessageId+    Ready                      Int User [Channel] [GuildUnavailable] T.Text (Maybe Shard) PartialApplication+  | Resumed                    [T.Text]+  | ChannelCreate              Channel+  | ChannelUpdate              Channel+  | ChannelDelete              Channel+  | ThreadCreate               Channel+  | ThreadUpdate               Channel+  | ThreadDelete               Channel+  | ThreadListSync             ThreadListSyncFields +  | ThreadMembersUpdate        ThreadMembersUpdateFields +  | ChannelPinsUpdate          ChannelId (Maybe UTCTime)+  | GuildCreate                Guild+  | GuildUpdate                Guild+  | GuildDelete                GuildUnavailable+  | GuildBanAdd                GuildId User+  | GuildBanRemove             GuildId User+  | GuildEmojiUpdate           GuildId [Emoji]+  | GuildIntegrationsUpdate    GuildId+  | GuildMemberAdd             GuildId GuildMember+  | GuildMemberRemove          GuildId User+  | GuildMemberUpdate          GuildId [RoleId] User (Maybe T.Text)+  | GuildMemberChunk           GuildId [GuildMember]+  | GuildRoleCreate            GuildId Role+  | GuildRoleUpdate            GuildId Role+  | GuildRoleDelete            GuildId RoleId+  | MessageCreate              Message+  | MessageUpdate              ChannelId MessageId+  | MessageDelete              ChannelId MessageId+  | MessageDeleteBulk          ChannelId [MessageId]+  | MessageReactionAdd         ReactionInfo+  | MessageReactionRemove      ReactionInfo+  | MessageReactionRemoveAll   ChannelId MessageId   | MessageReactionRemoveEmoji ReactionRemoveInfo-  | PresenceUpdate          PresenceInfo-  | TypingStart             TypingInfo-  | UserUpdate              User-  | InteractionCreate       Interaction+  | PresenceUpdate             PresenceInfo+  | TypingStart                TypingInfo+  | UserUpdate                 User+  | InteractionCreate          Interaction   -- | VoiceStateUpdate   -- | VoiceServerUpdate-  | UnknownEvent     T.Text Object+  | UnknownEvent               T.Text Object   deriving (Show, Eq)  data EventInternalParse =-    InternalReady                   Int User [Channel] [GuildUnavailable] T.Text (Maybe Shard) PartialApplication-  | InternalResumed                 [T.Text]-  | InternalChannelCreate           Channel-  | InternalChannelUpdate           Channel-  | InternalChannelDelete           Channel-  | InternalChannelPinsUpdate       ChannelId (Maybe UTCTime)-  | InternalGuildCreate             Guild GuildInfo-  | InternalGuildUpdate             Guild-  | InternalGuildDelete             GuildUnavailable-  | InternalGuildBanAdd             GuildId User-  | InternalGuildBanRemove          GuildId User-  | InternalGuildEmojiUpdate        GuildId [Emoji]-  | InternalGuildIntegrationsUpdate GuildId-  | InternalGuildMemberAdd          GuildId GuildMember-  | InternalGuildMemberRemove       GuildId User-  | InternalGuildMemberUpdate       GuildId [RoleId] User (Maybe T.Text)-  | InternalGuildMemberChunk        GuildId [GuildMember]-  | InternalGuildRoleCreate         GuildId Role-  | InternalGuildRoleUpdate         GuildId Role-  | InternalGuildRoleDelete         GuildId RoleId-  | InternalMessageCreate           Message-  | InternalMessageUpdate           ChannelId MessageId-  | InternalMessageDelete           ChannelId MessageId-  | InternalMessageDeleteBulk       ChannelId [MessageId]-  | InternalMessageReactionAdd      ReactionInfo-  | InternalMessageReactionRemove   ReactionInfo-  | InternalMessageReactionRemoveAll ChannelId MessageId+    InternalReady                      Int User [Channel] [GuildUnavailable] T.Text (Maybe Shard) PartialApplication+  | InternalResumed                    [T.Text]+  | InternalChannelCreate              Channel+  | InternalChannelUpdate              Channel+  | InternalChannelDelete              Channel+  | InternalThreadCreate               Channel+  | InternalThreadUpdate               Channel+  | InternalThreadDelete               Channel+  | InternalThreadListSync             ThreadListSyncFields +  | InternalThreadMembersUpdate        ThreadMembersUpdateFields +  | InternalChannelPinsUpdate          ChannelId (Maybe UTCTime)+  | InternalGuildCreate                Guild+  | InternalGuildUpdate                Guild+  | InternalGuildDelete                GuildUnavailable+  | InternalGuildBanAdd                GuildId User+  | InternalGuildBanRemove             GuildId User+  | InternalGuildEmojiUpdate           GuildId [Emoji]+  | InternalGuildIntegrationsUpdate    GuildId+  | InternalGuildMemberAdd             GuildId GuildMember+  | InternalGuildMemberRemove          GuildId User+  | InternalGuildMemberUpdate          GuildId [RoleId] User (Maybe T.Text)+  | InternalGuildMemberChunk           GuildId [GuildMember]+  | InternalGuildRoleCreate            GuildId Role+  | InternalGuildRoleUpdate            GuildId Role+  | InternalGuildRoleDelete            GuildId RoleId+  | InternalMessageCreate              Message+  | InternalMessageUpdate              ChannelId MessageId+  | InternalMessageDelete              ChannelId MessageId+  | InternalMessageDeleteBulk          ChannelId [MessageId]+  | InternalMessageReactionAdd         ReactionInfo+  | InternalMessageReactionRemove      ReactionInfo+  | InternalMessageReactionRemoveAll   ChannelId MessageId   | InternalMessageReactionRemoveEmoji ReactionRemoveInfo-  | InternalPresenceUpdate          PresenceInfo-  | InternalTypingStart             TypingInfo-  | InternalUserUpdate              User-  | InternalInteractionCreate       Interaction+  | InternalPresenceUpdate             PresenceInfo+  | InternalTypingStart                TypingInfo+  | InternalUserUpdate                 User+  | InternalInteractionCreate          Interaction   -- -- | InternalVoiceStateUpdate   -- -- | InternalVoiceServerUpdate-  | InternalUnknownEvent     T.Text Object+  | InternalUnknownEvent               T.Text Object   deriving (Show, Eq, Read)  data PartialApplication = PartialApplication@@ -136,22 +146,6 @@                        <*> o .:  "message_id"                        <*> o .:  "emoji" -data PresenceInfo = PresenceInfo-  { presenceUserId  :: UserId-  , presenceRoles   :: [RoleId]-  -- , presenceGame :: Maybe Activity-  , presenceGuildId :: GuildId-  , presenceStatus  :: T.Text-  } deriving (Show, Read, Eq, Ord)--instance FromJSON PresenceInfo where-  parseJSON = withObject "PresenceInfo" $ \o ->-    PresenceInfo <$> (o .: "user" >>= (.: "id"))-                 <*> o .: "roles"-              -- <*> o .: "game"-                 <*> o .: "guild_id"-                 <*> o .: "status"- data TypingInfo = TypingInfo   { typingUserId    :: UserId   , typingChannelId :: ChannelId@@ -187,11 +181,16 @@     "CHANNEL_CREATE"            -> InternalChannelCreate             <$> reparse o     "CHANNEL_UPDATE"            -> InternalChannelUpdate             <$> reparse o     "CHANNEL_DELETE"            -> InternalChannelDelete             <$> reparse o+    "THREAD_CREATE"             -> InternalThreadCreate              <$> reparse o+    "THREAD_UPDATE"             -> InternalThreadUpdate              <$> reparse o+    "THREAD_DELETE"             -> InternalThreadDelete              <$> reparse o+    "THREAD_LIST_SYNC"          -> InternalThreadListSync            <$> reparse o+    "THREAD_MEMBERS_UPDATE"     -> InternalThreadMembersUpdate       <$> reparse o     "CHANNEL_PINS_UPDATE"       -> do id <- o .: "channel_id"                                       stamp <- o .:? "last_pin_timestamp"                                       let utc = stamp >>= parseISO8601                                       pure (InternalChannelPinsUpdate id utc)-    "GUILD_CREATE"              -> InternalGuildCreate               <$> reparse o <*> reparse o+    "GUILD_CREATE"              -> InternalGuildCreate               <$> reparse o     "GUILD_UPDATE"              -> InternalGuildUpdate               <$> reparse o     "GUILD_DELETE"              -> InternalGuildDelete               <$> reparse o     "GUILD_BAN_ADD"             -> InternalGuildBanAdd    <$> o .: "guild_id" <*> o .: "user"

@@ -20,6 +20,7 @@  import Discord.Internal.Types.Prelude import Discord.Internal.Types.Events+import Discord.Internal.Types.Guild (Activity (..))  -- | Sent by gateway data GatewayReceivable@@ -57,6 +58,7 @@   , gatewayIntentDirectMessageChanges :: Bool   , gatewayIntentDirectMessageReactions :: Bool   , gatewayIntentDirectMessageTyping :: Bool+  , gatewayIntentMessageContent :: Bool   } deriving (Show, Read, Eq, Ord)  instance Default GatewayIntent where@@ -75,6 +77,7 @@                       , gatewayIntentDirectMessageChanges   = True                       , gatewayIntentDirectMessageReactions = True                       , gatewayIntentDirectMessageTyping    = True+                      , gatewayIntentMessageContent         = True                       }  compileGatewayIntent :: GatewayIntent -> Int@@ -95,6 +98,7 @@                        , (2 ^ 12, gatewayIntentDirectMessageChanges)                        , (2 ^ 13, gatewayIntentDirectMessageReactions)                        , (2 ^ 14, gatewayIntentDirectMessageTyping)+                       , (2 ^ 15, gatewayIntentMessageContent)                        ]        ] @@ -127,25 +131,6 @@                       }   deriving (Show, Read, Eq, Ord) -data Activity = Activity-              { activityName :: T.Text-              , activityType :: ActivityType-              , activityUrl :: Maybe T.Text-              }-  deriving (Show, Read, Eq, Ord)--data ActivityType = ActivityTypeGame-                  | ActivityTypeStreaming-                  | ActivityTypeListening-                  | ActivityTypeCompeting-  deriving (Show, Read, Eq, Ord)--activityTypeId :: ActivityType -> Int-activityTypeId a = case a of ActivityTypeGame -> 0-                             ActivityTypeStreaming -> 1-                             ActivityTypeListening -> 2-                             ActivityTypeCompeting -> 5- data UpdateStatusType = UpdateStatusOnline                       | UpdateStatusDoNotDisturb                       | UpdateStatusAwayFromKeyboard@@ -228,7 +213,7 @@       , "status" .= statusString status       , "game" .= (game <&> \a -> object [                                 "name" .= activityName a-                              , "type" .= activityTypeId (activityType a)+                              , "type" .= fromDiscordType (activityType a)                               , "url" .= activityUrl a                               ])       ]

@@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE DeriveDataTypeable #-}  -- | Types relating to Discord Guilds (servers) module Discord.Internal.Types.Guild where@@ -8,10 +9,12 @@  import Data.Aeson import qualified Data.Text as T+import Data.Data (Data)+import Data.Default (Default(..))  import Discord.Internal.Types.Prelude import Discord.Internal.Types.Color (DiscordColor)-import Discord.Internal.Types.Channel (Channel)+import Discord.Internal.Types.Channel (Channel, StickerItem) import Discord.Internal.Types.User (User, GuildMember) import Discord.Internal.Types.Components (Emoji) @@ -22,25 +25,57 @@ -- -- https://discord.com/developers/docs/resources/guild#guild-object data Guild = Guild-      { guildId                  :: GuildId       -- ^ Gulid id-      , guildName                :: T.Text          -- ^ Guild name (2 - 100 chars)-      , guildIcon                :: Maybe T.Text    -- ^ Icon hash-      , guildSplash              :: Maybe T.Text    -- ^ Splash hash-      , guildOwnerId             :: UserId       -- ^ Guild owner id-      , guildPermissions         :: Maybe T.Text-      , guildRegion              :: Maybe T.Text    -- ^ Guild voice region-      , guildAfkId               :: Maybe ChannelId -- ^ Id of afk channel-      , guildAfkTimeout          :: Integer         -- ^ Afk timeout in seconds-      , guildWidgetEnabled       :: Maybe Bool      -- ^ Id of embedded channel-      , guildWidgetChannelId     :: Maybe ChannelId -- ^ Id of embedded channel-      , guildVerificationLevel   :: Integer         -- ^ Level of verification-      , guildNotification        :: Integer         -- ^ Level of default notifications-      , guildExplicitFilterLevel :: Integer-      , guildRoles               :: [Role]           -- ^ Array of 'Role' objects-      , guildEmojis              :: [Emoji]          -- ^ Array of 'Emoji' objects-      , guildFeatures            :: [T.Text]-      , guildMultiFactAuth       :: !Integer-      , guildApplicationId       :: Maybe Snowflake+      { guildId                   :: GuildId              -- ^ Gulid id+      , guildName                 :: T.Text               -- ^ Guild name (2 - 100 chars)+      , guildIcon                 :: Maybe T.Text         -- ^ Icon hash+      , guildIconHash             :: Maybe T.Text         -- ^ Icon hash, when returned in template object+      , guildSplash               :: Maybe T.Text         -- ^ Splash hash+      , guildDiscoverySplash      :: Maybe T.Text         -- ^ Discovery splash hash+      , guildOwner                :: Maybe Bool           -- ^ True is user is the owner of the guild+      , guildOwnerId              :: UserId               -- ^ Guild owner id+      , guildPermissions          :: Maybe T.Text         -- ^ Total permissions for the user in the guild+      , guildAfkId                :: Maybe ChannelId      -- ^ Id of afk channel+      , guildAfkTimeout           :: Integer              -- ^ Afk timeout in seconds+      , guildWidgetEnabled        :: Maybe Bool           -- ^ Id of embedded channel+      , guildWidgetChannelId      :: Maybe ChannelId      -- ^ Id of embedded channel+      , guildVerificationLevel    :: Integer              -- ^ Level of verification+      , guildNotification         :: Integer              -- ^ Level of default notifications+      , guildExplicitFilterLevel  :: Integer              -- ^ Whose media gets scanned+      , guildRoles                :: [Role]               -- ^ Array of 'Role' objects+      , guildEmojis               :: [Emoji]              -- ^ Array of 'Emoji' objects+      , guildFeatures             :: [T.Text]             -- ^ Array of guild feature strings+      , guildMultiFactAuth        :: !Integer             -- ^ MFA level for the guild+      , guildApplicationId        :: Maybe ApplicationId  -- ^ Application id of the guild if bot created+      , guildSystemChannelId      :: Maybe ChannelId      -- ^ Channel where guild notices such as welcome messages and boost events+      , guildSystemChannelFlags   :: Integer              -- ^ Flags on the system channel+      , guildRulesChannelId       :: Maybe ChannelId      -- ^ Id of channel with rules/guidelines+      , guildJoinedAt             :: Maybe UTCTime        -- ^ When this guild was joined at+      , guildLarge                :: Maybe Bool           -- ^ True if this guild is considered large+      , guildUnavailable          :: Maybe Bool           -- ^ True if the guild is unavailable due to outage+      , guildMemberCount          :: Maybe Integer        -- ^ Total number of members in the guild+      -- voice_states+      , guildMembers              :: Maybe [GuildMember]  -- ^ Users in the guild+      , guildChannels             :: Maybe [Channel]      -- ^ Channels in the guild+      , guildThreads              :: Maybe [Channel]      -- ^ All active threads in the guild that the current user has permission to view+      , guildPresences            :: Maybe [PresenceInfo] -- ^ Presences of the members in the guild+      , guildMaxPresences         :: Maybe Integer        -- ^ Maximum number of prescences in the guild+      , guildMaxMembers           :: Maybe Integer        -- ^ Maximum number of members in the guild+      , guildVanityURL            :: Maybe T.Text         -- ^ Vanity url code for the guild+      , guildDescription          :: Maybe T.Text         -- ^ Description of a commmunity guild+      , guildBanner               :: Maybe T.Text         -- ^ Banner hash+      , guildPremiumTier          :: Integer              -- ^ Premium tier (boost level)+      , guildSubscriptionCount    :: Maybe Integer        -- ^ Number of boosts the guild has+      , guildPreferredLocale      :: T.Text               -- ^ Preferred locale of a community server+      , guildPublicUpdatesChannel :: Maybe ChannelId      -- ^ Id of channel where admins and mods get updates+      , guildMaxVideoUsers        :: Maybe Integer        -- ^ Maximum number of users in video channel+      , guildApproxMemberCount    :: Maybe Integer        -- ^ Approximate number of members in the guild+      , guildApproxPresenceCount  :: Maybe Integer        -- ^ Approximate number of non-offline members in the guild+      -- welcome_screen+      , guildNSFWLevel            :: Integer              -- ^ Guild NSFW level+      -- stage_instances+      , guildStickers             :: Maybe [StickerItem]  -- ^ Custom guild stickers+      -- guild_scheduled_events+      , guildPremiumBar           :: Bool                 -- ^ Whether the guild has the boost progress bar enabled       } deriving (Show, Read, Eq, Ord)  instance FromJSON Guild where@@ -48,10 +83,12 @@     Guild <$> o .:  "id"           <*> o .:  "name"           <*> o .:? "icon"+          <*> o .:? "icon_hash"           <*> o .:? "splash"+          <*> o .:? "discovery_splash"+          <*> o .:? "owner"           <*> o .:  "owner_id"           <*> o .:? "permissions"-          <*> o .:? "region"           <*> o .:? "afk_channel_id"           <*> o .:  "afk_timeout"           <*> o .:? "widget_enabled"@@ -64,8 +101,37 @@           <*> o .:  "features"           <*> o .:  "mfa_level"           <*> o .:? "application_id"+          <*> o .:? "system_channel_id"+          <*> o .:  "system_channel_flags"+          <*> o .:? "rules_channel_id"+          <*> o .:? "joined_at"+          <*> o .:? "large"+          <*> o .:? "unavailable"+          <*> o .:? "member_count"+          -- voice_states+          <*> o .:? "members"+          <*> o .:? "channels"+          <*> o .:? "threads"+          <*> o .:? "presences"+          <*> o .:? "max_presences"+          <*> o .:? "max_members"+          <*> o .:? "vanity_url_code"+          <*> o .:? "description"+          <*> o .:? "banner"+          <*> o .:  "premium_tier"+          <*> o .:? "premium_subscription_count"+          <*> o .:  "preferred_locale"+          <*> o .:? "public_updates_channel_id"+          <*> o .:? "max_video_channel_users"+          <*> o .:? "approximate_member_count"+          <*> o .:? "approximate_presence_count"+          -- welcome_screen+          <*> o .: "nsfw_level"+          -- stage_instances+          <*> o .:? "stickers"+          <*> o .: "premium_progress_bar_enabled" -data GuildUnavailable = GuildUnavailable+newtype GuildUnavailable = GuildUnavailable       { idOnceAvailable :: GuildId       } deriving (Show, Read, Eq, Ord) @@ -73,24 +139,120 @@   parseJSON = withObject "GuildUnavailable" $ \o ->        GuildUnavailable <$> o .: "id" -data GuildInfo = GuildInfo-      { guildJoinedAt    :: UTCTime-      , guildLarge       :: Bool-      , guildMemberCount :: Integer-   -- , guildVoiceStates :: [VoiceState]  -- (without guildid) todo have to add voice state data type-      , guildMembers     :: [GuildMember]-      , guildChannels    :: [Channel]     -- ^ Channels in the guild (sent in GuildCreate)-   -- , guildPresences   :: [Presence]-      } deriving (Show, Read, Eq, Ord)+data PresenceInfo = PresenceInfo+  { presenceUserId     :: UserId+  -- , presenceRoles   :: [RoleId]+  , presenceActivities :: Maybe [Activity]+  , presenceGuildId    :: Maybe GuildId+  , presenceStatus     :: T.Text+  } deriving (Show, Read, Eq, Ord) -instance FromJSON GuildInfo where-  parseJSON = withObject "GuildInfo" $ \o ->-    GuildInfo <$> o .: "joined_at"-              <*> o .: "large"-              <*> o .: "member_count"-           -- <*> o .: "voice_states"-              <*> o .: "members"-              <*> o .: "channels"+instance FromJSON PresenceInfo where+  parseJSON = withObject "PresenceInfo" $ \o ->+    PresenceInfo <$> (o .: "user" >>= (.: "id"))+                 <*> o .:  "activities"+                 <*> o .:? "guild_id"+                 <*> o .:  "status"++-- | Object for a single activity+--+-- https://discord.com/developers/docs/topics/gateway#activity-object+--+-- When setting a bot's activity, only the name, url, and type are sent - and+-- it seems that not many types are permitted either.+data Activity = +  Activity+    { activityName :: T.Text -- ^ Name of activity+    , activityType :: ActivityType -- ^ Type of activity+    , activityUrl :: Maybe T.Text -- ^ URL of the activity (only verified when streaming)+    , activityCreatedAt :: Integer -- ^ unix time in milliseconds+    , activityTimeStamps :: Maybe ActivityTimestamps -- ^ Start and end times+    , activityApplicationId :: Maybe ApplicationId -- ^ Application of the activity+    , activityDetails :: Maybe T.Text -- ^ Details of Activity+    , activityState :: Maybe T.Text -- ^ State of the user's party+    , activityEmoji :: Maybe Emoji -- ^ Simplified emoji object+    , activityParty :: Maybe ActivityParty -- ^ Info for the current player's party+    -- assets+    -- secrets+    , activityInstance :: Maybe Bool -- ^ Whether or not the activity is an instanced game session+    , activityFlags :: Maybe Integer -- ^ The flags https://discord.com/developers/docs/topics/gateway#activity-object-activity-flags+    , activityButtons :: Maybe [ActivityButton] -- ^ Custom buttons shown in Rich Presence+    }+  deriving (Show, Read, Eq, Ord)++instance Default Activity where+  def = Activity "discord-haskell" ActivityTypeGame Nothing 0 Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing++instance FromJSON Activity where+  parseJSON = withObject "Activity" $ \o -> do+    Activity <$> o .:  "name"+             <*> o .:  "type"+             <*> o .:? "url"+             <*> o .:  "created_at"+             <*> o .:? "timestamps"+             <*> o .:? "application_id"+             <*> o .:? "details"+             <*> o .:? "state"+             <*> o .:? "emoji"+             <*> o .:? "party"+             -- assets+             -- secrets+             <*> o .:? "instance"+             <*> o .:? "flags"+             <*> o .:? "buttons"++data ActivityTimestamps = ActivityTimestamps+  { activityTimestampsStart :: Maybe Integer -- ^ unix time in milliseconds+  , activityTimestampsEnd :: Maybe Integer -- ^ unix time in milliseconds+  } deriving (Show, Read, Eq, Ord)++instance FromJSON ActivityTimestamps where+  parseJSON = withObject "ActivityTimestamps" $ \o ->+    ActivityTimestamps <$> o .:? "start"+                       <*> o .:? "end"++data ActivityParty = ActivityParty+  { activityPartyId :: Maybe T.Text+  , activityPartySize :: Maybe (Integer, Integer)+  } deriving (Show, Read, Eq, Ord)++instance FromJSON ActivityParty where+  parseJSON = withObject "ActivityParty" $ \o ->+    ActivityParty <$> o .:? "id"+                  <*> o .:? "size"++data ActivityButton = ActivityButton+  { activityButtonLabel :: T.Text+  , activityButtonUrl :: T.Text+  } deriving (Show, Read, Eq, Ord)++instance FromJSON ActivityButton where+  parseJSON = withObject "ActivityButton" $ \o ->+    ActivityButton <$> o .: "label"+                   <*> o .: "url"++-- | To see what these look like, go to here: +-- https://discord.com/developers/docs/topics/gateway#activity-object-activity-types+data ActivityType = +    ActivityTypeGame+  | ActivityTypeStreaming+  | ActivityTypeListening+  | ActivityTypeWatching+  | ActivityTypeCustom+  | ActivityTypeCompeting+  deriving (Show, Read, Eq, Ord, Data)++instance InternalDiscordEnum ActivityType where+  discordTypeStartValue = ActivityTypeGame+  fromDiscordType ActivityTypeGame = 0+  fromDiscordType ActivityTypeStreaming = 1+  fromDiscordType ActivityTypeListening = 2+  fromDiscordType ActivityTypeWatching = 3+  fromDiscordType ActivityTypeCustom = 4+  fromDiscordType ActivityTypeCompeting = 5++instance FromJSON ActivityType where+  parseJSON = discordTypeParseJSON "ActivityType"  data PartialGuild = PartialGuild       { partialGuildId          :: GuildId

@@ -25,10 +25,12 @@     interactionResponseMessageBasic,     InteractionResponseMessageFlags (..),     InteractionResponseMessageFlag (..),+    InteractionResponseModalData (..),   ) where  import Control.Applicative (Alternative ((<|>)))+import Control.Monad (join) import Data.Aeson import Data.Aeson.Types (Parser) import Data.Bits (Bits (shift, (.|.)))@@ -37,7 +39,7 @@ import qualified Data.Text as T import Discord.Internal.Types.ApplicationCommands (Choice) import Discord.Internal.Types.Channel (AllowedMentions, Attachment, Message)-import Discord.Internal.Types.Components (ComponentActionRow)+import Discord.Internal.Types.Components (ComponentActionRow, ComponentTextInput) import Discord.Internal.Types.Embed (CreateEmbed, createEmbed) import Discord.Internal.Types.Prelude (ApplicationCommandId, ApplicationId, ChannelId, GuildId, InteractionId, InteractionToken, MessageId, RoleId, Snowflake, UserId) import Discord.Internal.Types.User (GuildMember, User)@@ -122,7 +124,29 @@         -- | The invoking guild's preferred locale.         interactionGuildLocale :: Maybe T.Text       }-  deriving (Show, Eq, Read)+  | InteractionModalSubmit+      { -- | The id of this interaction.+        interactionId :: InteractionId,+        -- | The id of the application that this interaction belongs to.+        interactionApplicationId :: ApplicationId,+        -- | The data for this interaction.+        interactionDataModal :: InteractionDataModal,+        -- | What guild this interaction comes from.+        interactionGuildId :: Maybe GuildId,+        -- | What channel this interaction comes from.+        interactionChannelId :: Maybe ChannelId,+        -- | What user/member this interaction comes from.+        interactionUser :: MemberOrUser,+        -- | The unique token that represents this interaction.+        interactionToken :: InteractionToken,+        -- | What version of interaction is this (always 1).+        interactionVersion :: Int,+        -- | The invoking user's preferred locale.+        interactionLocale :: T.Text,+        -- | The invoking guild's preferred locale.+        interactionGuildLocale :: Maybe T.Text+      }+  deriving (Show, Read, Eq, Ord)  instance FromJSON Interaction where   parseJSON =@@ -170,10 +194,21 @@                 <*> return version                 <*> v .: "locale"                 <*> return glocale+            5 ->+              InteractionModalSubmit iid aid+                <$> v .: "data"+                <*> return gid+                <*> return cid+                <*> parseJSON (Object v)+                <*> return tok+                <*> return version+                <*> v .: "locale"+                <*> return glocale             _ -> fail "unknown interaction type"       ) -newtype MemberOrUser = MemberOrUser (Either GuildMember User) deriving (Show, Eq, Read)+newtype MemberOrUser = MemberOrUser (Either GuildMember User)+  deriving (Show, Read, Eq, Ord)  instance {-# OVERLAPPING #-} FromJSON MemberOrUser where   parseJSON =@@ -193,7 +228,7 @@         -- | Values for the select menu.         interactionDataComponentValues :: [T.Text]       }-  deriving (Show, Read, Eq)+  deriving (Show, Read, Eq, Ord)  instance FromJSON InteractionDataComponent where   parseJSON =@@ -241,7 +276,7 @@         -- | The options of the application command.         interactionDataApplicationCommandOptions :: Maybe InteractionDataApplicationCommandOptions       }-  deriving (Show, Read, Eq)+  deriving (Show, Read, Eq, Ord)  instance FromJSON InteractionDataApplicationCommand where   parseJSON =@@ -269,7 +304,7 @@ data InteractionDataApplicationCommandOptions   = InteractionDataApplicationCommandOptionsSubcommands [InteractionDataApplicationCommandOptionSubcommandOrGroup]   | InteractionDataApplicationCommandOptionsValues [InteractionDataApplicationCommandOptionValue]-  deriving (Show, Read, Eq)+  deriving (Show, Read, Eq, Ord)  instance FromJSON InteractionDataApplicationCommandOptions where   parseJSON =@@ -299,7 +334,7 @@         interactionDataApplicationCommandOptionSubcommandGroupFocused :: Bool       }   | InteractionDataApplicationCommandOptionSubcommandOrGroupSubcommand InteractionDataApplicationCommandOptionSubcommand-  deriving (Show, Read, Eq)+  deriving (Show, Read, Eq, Ord)  instance FromJSON InteractionDataApplicationCommandOptionSubcommandOrGroup where   parseJSON =@@ -323,7 +358,7 @@     interactionDataApplicationCommandOptionSubcommandOptions :: [InteractionDataApplicationCommandOptionValue],     interactionDataApplicationCommandOptionSubcommandFocused :: Bool   }-  deriving (Show, Read, Eq)+  deriving (Show, Read, Eq, Ord)  instance FromJSON InteractionDataApplicationCommandOptionSubcommand where   parseJSON =@@ -374,7 +409,7 @@       { interactionDataApplicationCommandOptionValueName :: T.Text,         interactionDataApplicationCommandOptionValueNumberValue :: Either T.Text Scientific       }-  deriving (Show, Read, Eq)+  deriving (Show, Read, Eq, Ord)  instance FromJSON InteractionDataApplicationCommandOptionValue where   parseJSON =@@ -412,6 +447,30 @@             _ -> fail $ "unexpected interaction data application command option value type: " ++ show t       ) +data InteractionDataModal = InteractionDataModal+  { -- | The unique id of the component (up to 100 characters).+    interactionDataModalCustomId :: T.Text,+    -- | Components from the modal.+    interactionDataModalComponents :: [ComponentTextInput]+  }+  deriving (Show, Read, Eq, Ord)++instance FromJSON InteractionDataModal where+  parseJSON =+    withObject+      "InteractionDataModal"+      ( \v ->+          InteractionDataModal <$> v .: "custom_id"+            <*> ((v .: "components") >>= (join <$>) . mapM getTextInput)+      )+    where+      getTextInput :: Value -> Parser [ComponentTextInput]+      getTextInput = withObject "InteractionDataModal.TextInput" $ \o -> do+        t <- o .: "type" :: Parser Int+        case t of+          1 -> o .: "components"+          _ -> fail $ "expected action row type (1), got: " ++ show t+ parseValue :: (FromJSON a) => Object -> Bool -> Parser (Either T.Text a) parseValue o True = Left <$> o .: "value" parseValue o False = Right <$> o .: "value"@@ -429,9 +488,11 @@   { resolvedDataUsers :: Maybe Value,     resolvedDataMembers :: Maybe Value,     resolvedDataRoles :: Maybe Value,-    resolvedDataChannels :: Maybe Value+    resolvedDataChannels :: Maybe Value,+    resolvedDataMessages :: Maybe Value,+    resolvedDataAttachments :: Maybe Value   }-  deriving (Show, Read, Eq)+  deriving (Show, Read, Eq, Ord)  instance ToJSON ResolvedData where   toJSON ResolvedData {..} =@@ -441,7 +502,9 @@             [ ("users", resolvedDataUsers),               ("members", resolvedDataMembers),               ("roles", resolvedDataRoles),-              ("channels", resolvedDataChannels)+              ("channels", resolvedDataChannels),+              ("messages", resolvedDataMessages),+              ("attachments", resolvedDataAttachments)             ]       ] @@ -455,6 +518,8 @@             <*> v .:? "members"             <*> v .:? "roles"             <*> v .:? "channels"+            <*> v .:? "messages"+            <*> v .:? "attachments"       )  -- | The data to respond to an interaction with. Unless specified otherwise, you@@ -473,6 +538,9 @@     InteractionResponseUpdateMessage InteractionResponseMessage   | -- | respond to an autocomplete interaction with suggested choices     InteractionResponseAutocompleteResult InteractionResponseAutocomplete+  | -- | respond with a popup modal+    InteractionResponseModal InteractionResponseModalData+  deriving (Show, Read, Eq, Ord)  -- | A basic interaction response, sending back the given text. interactionResponseBasic :: T.Text -> InteractionResponse@@ -485,9 +553,10 @@   toJSON (InteractionResponseChannelMessage ms) = object [("type", Number 4), ("data", toJSON ms)]   toJSON (InteractionResponseUpdateMessage ms) = object [("type", Number 7), ("data", toJSON ms)]   toJSON (InteractionResponseAutocompleteResult ms) = object [("type", Number 8), ("data", toJSON ms)]+  toJSON (InteractionResponseModal ms) = object [("type", Number 9), ("data", toJSON ms)]  data InteractionResponseAutocomplete = InteractionResponseAutocompleteString [Choice T.Text] | InteractionResponseAutocompleteInteger [Choice Integer] | InteractionResponseAutocompleteNumber [Choice Scientific]-  deriving (Show, Eq)+  deriving (Show, Read, Eq, Ord)  instance ToJSON InteractionResponseAutocomplete where   toJSON (InteractionResponseAutocompleteString cs) = object [("choices", toJSON cs)]@@ -504,7 +573,7 @@     interactionResponseMessageComponents :: Maybe [ComponentActionRow],     interactionResponseMessageAttachments :: Maybe [Attachment]   }-  deriving (Show, Eq)+  deriving (Show, Read, Eq, Ord)  -- | A basic interaction response, sending back the given text. This is -- effectively a helper function.@@ -531,10 +600,10 @@ -- Currently the only flag is EPHERMERAL, which means only the user can see the -- message. data InteractionResponseMessageFlag = InteractionResponseMessageFlagEphermeral-  deriving (Show, Read, Eq)+  deriving (Show, Read, Eq, Ord)  newtype InteractionResponseMessageFlags = InteractionResponseMessageFlags [InteractionResponseMessageFlag]-  deriving (Show, Read, Eq)+  deriving (Show, Read, Eq, Ord)  instance Enum InteractionResponseMessageFlag where   fromEnum InteractionResponseMessageFlagEphermeral = 1 `shift` 6@@ -544,3 +613,18 @@  instance ToJSON InteractionResponseMessageFlags where   toJSON (InteractionResponseMessageFlags fs) = Number $ fromInteger $ fromIntegral $ foldr (.|.) 0 (fromEnum <$> fs)++data InteractionResponseModalData = InteractionResponseModalData+  { interactionResponseModalCustomId :: T.Text,+    interactionResponseModalTitle :: T.Text,+    interactionResponseModalComponents :: [ComponentTextInput]+  }+  deriving (Show, Read, Eq, Ord)++instance ToJSON InteractionResponseModalData where+  toJSON InteractionResponseModalData {..} =+    object+      [ ("custom_id", toJSON interactionResponseModalCustomId),+        ("title", toJSON interactionResponseModalTitle),+        ("components", toJSON $ map (\ti -> object [("type", Number 1), ("components", toJSON [ti])]) interactionResponseModalComponents)+      ]