discord-haskell 1.10.0 → 1.11.0

raw patch · 24 files changed

+2507/−272 lines, 24 filesdep +scientificPVP ok

version bump matches the API change (PVP)

Dependencies added: scientific

API changes (from Hackage documentation)

Files

• README.md +43/−87
• changelog.md +9/−0
• discord-haskell.cabal +9/−1
• examples/ping-pong.hs +30/−21
• src/Discord.hs +1/−1
• src/Discord/Interactions.hs +7/−0
• src/Discord/Internal/Gateway/Cache.hs +4/−2
• src/Discord/Internal/Gateway/EventLoop.hs +2/−2
• src/Discord/Internal/Rest.hs +4/−2
• src/Discord/Internal/Rest/ApplicationCommands.hs +103/−0
• src/Discord/Internal/Rest/Channel.hs +8/−33
• src/Discord/Internal/Rest/Guild.hs +12/−12
• src/Discord/Internal/Rest/Interactions.hs +65/−0
• src/Discord/Internal/Rest/Prelude.hs +7/−3
• src/Discord/Internal/Types.hs +11/−1
• src/Discord/Internal/Types/ApplicationCommands.hs +693/−0
• src/Discord/Internal/Types/Channel.hs +409/−49
• src/Discord/Internal/Types/Components.hs +296/−0
• src/Discord/Internal/Types/Events.hs +20/−5
• src/Discord/Internal/Types/Guild.hs +22/−38
• src/Discord/Internal/Types/Interactions.hs +614/−0
• src/Discord/Internal/Types/Prelude.hs +54/−1
• src/Discord/Internal/Types/User.hs +80/−14
• src/Discord/Requests.hs +4/−0

@@ -1,54 +1,81 @@-# discord-haskell           [![Build Status](https://app.travis-ci.com/aquarial/discord-haskell.svg?branch=master)](https://app.travis-ci.com/github/aquarial/discord-haskell)        [![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) -Build that discord bot in Haskell! Also checkout the [calamity haskell library](https://github.com/nitros12/calamity) +## 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`. -### Discord Server+### Documentation  -Created a discord server: https://discord.gg/eaRAGgX3bK+#### Local Documentation +Find docs on features, metadata, and parts is found in [./docs/README.md#Documentation](./docs/README.md#Documentation)++#### Discord Server++Current project discord server: <https://discord.gg/eaRAGgX3bK>+ Ask questions, get updates, request features, etc +#### 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. ++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.++#### 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+ ### Quickstart -This is an example bot that replies "pong" to messages that start with "ping". Also checkout the [other examples](./examples/)+This is an example bot that replies "pong" to messages that start with "ping". Also checkout the [other examples](./examples/) for things like state management.  ```haskell {-# LANGUAGE OverloadedStrings #-}  -- allows "string literals" to be Text- import Control.Monad (when, void) import Data.Text (isPrefixOf, toLower, Text) import qualified Data.Text.IO as TIO- import UnliftIO.Concurrent- import Discord import Discord.Types import qualified Discord.Requests as R  -- | Replies "pong" to every message that starts with "ping" pingpongExample :: IO ()-pingpongExample = do userFacingError <- runDiscord $ def-                                            { discordToken = "Bot ZZZZZZZZZZZZZZZZZZZ"-                                            , discordOnEvent = eventHandler }-                     TIO.putStrLn userFacingError+pingpongExample = do +    userFacingError <- runDiscord $ def+             { discordToken = "Bot ZZZZZZZZZZZZZZZZZZZ"+             , discordOnEvent = eventHandler+             , discordOnLog = \s -> TIO.putStrLn s+             , discordForkThreadForEvents = True }+    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-               void $ restCall (R.CreateReaction (messageChannel m, messageId m) "eyes")+               void $ restCall (R.CreateReaction (messageChannelId m, messageId m) "eyes")                threadDelay (2 * 10^6)-               void $ restCall (R.CreateMessage (messageChannel m) "Pong!")+               void $ restCall (R.CreateMessage (messageChannelId m) "Pong!")        _ -> return ()  fromBot :: Message -> Bool fromBot = userIsBot . messageAuthor  isPing :: Message -> Bool-isPing = ("ping" `isPrefixOf`) . toLower . messageText+isPing = ("ping" `isPrefixOf`) . toLower . messageContent ``` -```+```cabal -- ping-pong.cabal  executable haskell-bot@@ -101,75 +128,4 @@ for some help setting up your bot token  -### Emoji--For single character Emoji you can use the unicode name ("eyes", "fire", etc).--For multi-character Emoji you must use the discord format. Type `\:emoji:` into-a discord chat and paste that into the Text--For example `:thumbsup::skin-tone-3:` is `"👍\127997"`. -A custom emoji will look like `<name:id_number>` or `name:id_number`.--See [examples/ping-pong.hs](https://github.com/aquarial/discord-haskell/blob/master/examples/ping-pong.hs)- for a `CreateReaction` request in use.  -### Embeds--Embeds are special messages with boarders and images. [Example embed created by discord-haskell](./examples/embed-photo.jpg)--The `Embed` record (and sub-records) store embed data received from Discord.--The `CreateEmbed` record stores data when we want to create an embed.--`CreateEmbed` has a `Default` instance, so you only need to specify the fields you use:--```haskell-_ <- restCall (R.CreateMessageEmbed <channel_id> "Pong!" $-        def { createEmbedTitle = "Pong Embed"-            , createEmbedImage = Just $ CreateEmbedImageUpload <bytestring>-            , createEmbedThumbnail = Just $ CreateEmbedImageUrl-                    "https://avatars2.githubusercontent.com/u/37496339"-            })-```--Uploading a file each time is slow, prefer uploading images to a hosting site like imgur.com, and then referencing them.- -### Limitations--The following features are not implemented:--- Voice & Audio-- Authenticating with a user token--### Debugging--Always print the userFacingError Text returned from `runDiscord`. I use this to record-errors that cannot be recovered from.--If something else goes wrong with the library please open an issue. It is helpful,-but not always necessary, to attach a log of what's going on when the library-crashes.--Assign a handler to the `discordOnLog :: Text -> IO ()` to print info as it happens.-Remember to remove sensitive information before posting.--### Getting Help--#### Official discord docs--For a list of rest requests, gateway events, and gateway sendables go ggto the -[official discord documentation](https://discord.com/developers/docs/intro)--The rest requests line up very closely. The documentation lists -[Get Channel](https://discord.com/developers/docs/resources/channel#get-channel)-and discord-haskell has `GetChannel :: ChannelId -> ChannelRequest Channel`. Same for gateway `Event`s.--#### Examples--The [examples](https://github.com/aquarial/discord-haskell/tree/master/examples) were crafted-to display a variety of use cases. Read them with care.--#### Open an Issue--For deeper questions about how the library functions, feel free to open an issue.

@@ -6,6 +6,15 @@  ## master +## 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/aquarial/discord-haskell/pull/94) fixed a parse error with webhooktoken+++rename fields `messageText` -> `messageContent`, `messageChannel` -> `messageChannelId`  ## 1.10.0 

@@ -1,7 +1,7 @@ cabal-version:       2.0 name:                discord-haskell -- library version is also noted at src/Discord/Rest/Prelude.hs-version:             1.10.0+version:             1.11.0 description:         Functions and data types to write discord bots.                      Official discord docs <https://discord.com/developers/docs/reference>.                      .@@ -34,6 +34,7 @@                      , text                      , unliftio                      , discord-haskell+                     -- , req               {- needed for slash commands -}  library   ghc-options:         -Wall@@ -44,6 +45,7 @@   exposed-modules:     Discord                      , Discord.Types                      , Discord.Handle+                     , Discord.Interactions                      , Discord.Requests                      , Discord.Internal.Gateway                      , Discord.Internal.Gateway.Cache@@ -58,6 +60,8 @@                      , 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@@ -66,6 +70,9 @@                      , Discord.Internal.Types.Guild                      , Discord.Internal.Types.User                      , Discord.Internal.Types.Embed+                     , Discord.Internal.Types.ApplicationCommands+                     , Discord.Internal.Types.Interactions+                     , Discord.Internal.Types.Components   build-depends:                        base >= 4 && <5                      , aeson@@ -89,3 +96,4 @@                      , wuss                      , mtl                      , unliftio+                     , scientific

@@ -13,28 +13,39 @@  -- Allows this code to be an executable. See discord-haskell.cabal main :: IO ()-main = pingpongExample+main = if testserverid == -1+       then TIO.putStrLn "ERROR: modify the source and set testserverid to your serverid"+       else pingpongExample +++-- check the url in a discord server+--                                <server id>           <channel id>+-- https://discord.com/channels/2385235298674262408/4286572469284672046+testserverid :: Snowflake+testserverid = 453207241294610442+ -- | Replies "pong" to every message that starts with "ping" pingpongExample :: IO () pingpongExample = do   tok <- TIO.readFile "./examples/auth-token.secret"    -- open ghci and run  [[ :info RunDiscordOpts ]] to see available fields-  t <- runDiscord $ def { discordToken = tok-                        , discordOnStart = startHandler-                        , discordOnEnd = liftIO $ putStrLn "Ended"-                        , discordOnEvent = eventHandler-                        , discordOnLog = \s -> TIO.putStrLn s >> TIO.putStrLn ""-                        }-  TIO.putStrLn t+  err <- runDiscord $ def { discordToken = tok+                          , discordOnStart = startHandler+                          , discordOnEnd = liftIO $ putStrLn "Ended"+                          , discordOnEvent = eventHandler+                          , discordOnLog = \s -> TIO.putStrLn s >> TIO.putStrLn ""+                          } +  -- only reached on an unrecoverable error+  -- put normal 'cleanup' code in discordOnEnd+  TIO.putStrLn err+ -- If the start handler throws an exception, discord-haskell will gracefully shutdown --     Use place to execute commands you know you want to complete startHandler :: DiscordHandler () startHandler = do-  Right partialGuilds <- restCall R.GetCurrentUserGuilds-   let activity = Activity { activityName = "ping-pong"                           , activityType = ActivityTypeGame                           , activityUrl = Nothing@@ -46,23 +57,21 @@                               }   sendCommand (UpdateStatus opts) -  forM_ partialGuilds $ \pg -> do-    Right guild <- restCall $ R.GetGuild (partialGuildId pg)-    Right chans <- restCall $ R.GetGuildChannels (guildId guild)-    forM_ (take 1 (filter isTextChannel chans))-      (\channel -> restCall $ R.CreateMessage (channelId channel)-                                      "Hello! I will reply to pings with pongs")+  Right chans <- restCall $ R.GetGuildChannels testserverid+  forM_ (take 1 (filter isTextChannel chans))+        (\channel -> restCall $ R.CreateMessage (channelId channel)+                        "Hello! I will reply to pings with pongs")   -- If an event handler throws an exception, discord-haskell will continue to run eventHandler :: Event -> DiscordHandler () eventHandler event = case event of       MessageCreate m -> when (not (fromBot m) && isPing m) $ do-        void $ restCall (R.CreateReaction (messageChannel m, messageId m) "eyes")-        threadDelay (2 * 10^(6 :: Int))+        void $ restCall (R.CreateReaction (messageChannelId m, messageId m) "eyes")+        threadDelay (2 * 10 ^ (6 :: Int))          -- A very simple message.-        void $ restCall (R.CreateMessage (messageChannel m) "Pong!")+        void $ restCall (R.CreateMessage (messageChannelId m) "Pong!")          -- A more complex message. Text-to-speech, does not mention everyone nor         -- the user, and uses Discord native replies.@@ -77,7 +86,7 @@                        , R.messageDetailedReference = Just $                           def { referenceMessageId = Just $ messageId m }                        }-        void $ restCall (R.CreateMessageDetailed (messageChannel m) opts)+        void $ restCall (R.CreateMessageDetailed (messageChannelId m) opts)       _ -> return ()  isTextChannel :: Channel -> Bool@@ -88,4 +97,4 @@ fromBot = userIsBot . messageAuthor  isPing :: Message -> Bool-isPing = ("ping" `T.isPrefixOf`) . T.toLower . messageText+isPing = ("ping" `T.isPrefixOf`) . T.toLower . messageContent

@@ -131,7 +131,7 @@                     resp <- liftIO $ writeRestCall (discordHandleRestChan h) r                     case resp of                       Right x -> pure (Right x)-                      Left (RestCallInternalErrorCode c e1 e2) ->+                      Left (RestCallInternalErrorCode c e1 e2) -> do                         pure (Left (RestCallErrorCode c (TE.decodeUtf8 e1) (TE.decodeUtf8 e2)))                       Left (RestCallInternalHttpException _) ->                         threadDelay (10 * 10^(6 :: Int)) >> restCall r

@@ -0,0 +1,7 @@+module Discord.Interactions+  ( module Discord.Internal.Types.ApplicationCommands+  , module Discord.Internal.Types.Interactions+  ) where++import Discord.Internal.Types.ApplicationCommands+import Discord.Internal.Types.Interactions

@@ -18,6 +18,7 @@      , cacheDMChannels :: M.Map ChannelId Channel      , cacheGuilds :: M.Map GuildId (Guild, GuildInfo)      , cacheChannels :: M.Map ChannelId Channel+     , cacheApplication :: PartialApplication      } deriving (Show)  data CacheHandle = CacheHandle@@ -29,9 +30,9 @@ cacheLoop cacheHandle log = do       ready <- readChan eventChan       case ready of-        Right (InternalReady _ user dmChannels _unavailableGuilds _) -> do+        Right (InternalReady _ user dmChannels _unavailableGuilds _ _ pApp) -> do           let dmChans = M.fromList (zip (map channelId dmChannels) dmChannels)-          putMVar cache (Right (Cache user dmChans M.empty M.empty))+          putMVar cache (Right (Cache user dmChans M.empty M.empty pApp))           loop         Right r ->           writeChan log ("cache - stopping cache - expected Ready event, but got " <> T.pack (show r))@@ -72,6 +73,7 @@   --      c = M.filterWithKey (\(keyGuildId,_) _ -> keyGuildId /= guildId guild) (cacheChannels minfo)   --      m2 = minfo { cacheGuilds = g, cacheChannels = c }   --  putMVar cache m2+  InternalReady _ _ _ _ _ _ pa -> minfo { cacheApplication = pa }   _ -> minfo  setChanGuildID :: GuildId -> Channel -> Channel

@@ -102,7 +102,7 @@       LoopClosed -> pure Nothing    startconnectionpls :: GatewaySendableInternal -> IO LoopState-  startconnectionpls first = runSecureClient "gateway.discord.gg" 443 "/?v=6&encoding=json" $ \conn -> do+  startconnectionpls first = runSecureClient "gateway.discord.gg" 443 "/?v=8&encoding=json" $ \conn -> do                       msg <- getPayload conn log                       case msg of                         Right (Hello interval) -> do@@ -141,7 +141,7 @@       Right (Dispatch event sq) -> do writeIORef (gatewayHandleLastSequenceId thehandle) sq                                       writeChan eventChan (Right event)                                       case event of-                                        (InternalReady _ _ _ _ seshID) ->+                                        (InternalReady _ _ _ _ seshID _ _) ->                                             writeIORef (gatewayHandleSessionId thehandle) seshID                                         _ -> writeIORef (startsendingUsers sendablesData) True                                       loop

@@ -1,3 +1,4 @@+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings  #-}  -- | Provides a higher level interface to the rest functions.@@ -43,8 +44,9 @@   r <- readMVar m   pure $ case eitherDecode <$> r of     Right (Right o) -> Right o-    Right (Left er) -> Left (RestCallInternalNoParse er (case r of Right x -> x-                                                                   Left _ -> ""))+    (Right (Left er)) -> Left (RestCallInternalNoParse er (case r of +      Right x -> x+      Left _ -> ""))     Left e -> Left e  

@@ -0,0 +1,103 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeApplications #-}++module Discord.Internal.Rest.ApplicationCommands where++import Data.Aeson (ToJSON (toJSON), Value)+import Network.HTTP.Req as R++import Discord.Internal.Rest.Prelude+import Discord.Internal.Types+import Discord.Internal.Types.ApplicationCommands+++instance Request (ApplicationCommandRequest a) where+  jsonRequest = applicationCommandJsonRequest+  majorRoute = applicationCommandMajorRoute++data ApplicationCommandRequest a where+  GetGlobalApplicationCommands :: ApplicationId -> ApplicationCommandRequest [InternalApplicationCommand]+  CreateGlobalApplicationCommand :: ApplicationId -> CreateApplicationCommand -> ApplicationCommandRequest InternalApplicationCommand+  GetGlobalApplicationCommand :: ApplicationId -> ApplicationCommandId -> ApplicationCommandRequest InternalApplicationCommand+  EditGlobalApplicationCommand :: ApplicationId -> ApplicationCommandId -> EditApplicationCommand -> ApplicationCommandRequest InternalApplicationCommand+  DeleteGlobalApplicationCommand :: ApplicationId -> ApplicationCommandId -> ApplicationCommandRequest ()+  BulkOverWriteGlobalApplicationCommand :: ApplicationId -> [CreateApplicationCommand] -> ApplicationCommandRequest ()+  GetGuildApplicationCommands :: ApplicationId -> GuildId -> ApplicationCommandRequest [InternalApplicationCommand]+  CreateGuildApplicationCommand :: ApplicationId -> GuildId -> CreateApplicationCommand -> ApplicationCommandRequest InternalApplicationCommand+  GetGuildApplicationCommand :: ApplicationId -> GuildId -> ApplicationCommandId -> ApplicationCommandRequest InternalApplicationCommand+  EditGuildApplicationCommand :: ApplicationId -> GuildId -> ApplicationCommandId -> CreateApplicationCommand -> ApplicationCommandRequest InternalApplicationCommand+  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]++-- TODO: permissions checks+-- GetGuildApplicationCommandPermissions :: ApplicationId -> GuildID -> ApplicationCommandR++applications :: ApplicationId -> R.Url 'R.Https+applications s = baseUrl /: "applications" // s++applicationCommandMajorRoute :: ApplicationCommandRequest a -> String+applicationCommandMajorRoute a = case a of+  (GetGlobalApplicationCommands aid) -> "get_glob_appcomm" <> show aid+  (CreateGlobalApplicationCommand aid _) -> "write_glob_appcomm" <> show aid+  (GetGlobalApplicationCommand aid _) -> "get_glob_appcomm" <> show aid+  (EditGlobalApplicationCommand aid _ _) -> "write_glob_appcomm" <> show aid+  (DeleteGlobalApplicationCommand aid _) -> "write_glob_appcomm" <> show aid+  (BulkOverWriteGlobalApplicationCommand aid _) -> "write_glob_appcomm" <> show aid+  (GetGuildApplicationCommands aid _) -> "get_appcomm" <> show aid+  (CreateGuildApplicationCommand aid _ _) -> "write_appcomm" <> show aid+  (GetGuildApplicationCommand aid _ _) -> "get_appcomm" <> show aid+  (EditGuildApplicationCommand aid _ _ _) -> "write_appcomm" <> show aid+  (DeleteGuildApplicationCommand aid _ _) -> "write_appcomm" <> show aid+  (BulkOverWriteGuildApplicationCommand aid _ _) -> "write_appcomm" <> show aid+  (GetGuildApplicationCommandPermissions aid _) -> "appcom_perm " <> show aid+  (GetApplicationCommandPermissions aid _ _) -> "appcom_perm " <> show aid+  (EditApplicationCommandPermissions aid _ _ _) -> "appcom_perm " <> show aid+  (BatchEditApplicationCommandPermissions aid _ _) -> "appcom_perm " <> show aid++applicationCommandJsonRequest :: ApplicationCommandRequest a -> JsonRequest+applicationCommandJsonRequest a = case a of+  (GetGlobalApplicationCommands aid) ->+    Get (applications aid /: "commands") mempty+  (CreateGlobalApplicationCommand aid cac) ->+    Post (applications aid /: "commands") (convert cac) mempty+  (GetGlobalApplicationCommand aid aci) ->+    Get (applications aid /: "commands" // aci) mempty+  (EditGlobalApplicationCommand aid aci eac) ->+    Patch (applications aid /: "commands" // aci) (convert eac) mempty+  (DeleteGlobalApplicationCommand aid aci) ->+    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+  (CreateGuildApplicationCommand aid gid cac) ->+    Post (applications aid /: "guilds" // gid /: "commands") (convert cac) mempty+  (GetGuildApplicationCommand aid gid aci) ->+    Get (applications aid /: "guilds" // gid /: "commands" // aci) mempty+  (EditGuildApplicationCommand aid gid aci eac) ->+    Patch (applications aid /: "guilds" // gid /: "commands" // aci) (convert eac) mempty+  (DeleteGuildApplicationCommand aid gid aci) ->+    Delete (applications aid /: "guilds" // gid /: "commands" // aci) mempty+  (BulkOverWriteGuildApplicationCommand aid gid cacs) ->+    Put (applications aid /: "guilds" // gid /: "commands") (R.ReqBodyJson $ toJSON cacs) mempty+  (GetGuildApplicationCommandPermissions aid gid) ->+    Get (applications aid /: "guilds" // gid /: "commands" /: "permissions") mempty+  (GetApplicationCommandPermissions aid gid cid) ->+    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 aid cid gid ps)) mempty+  (BatchEditApplicationCommandPermissions aid gid ps) ->+    Put (applications aid /: "guilds" // gid /: "commands" /: "permissions") (R.ReqBodyJson $ toJSON ps) mempty+  where+    convert :: (ToJSON a) => a -> RestIO (ReqBodyJson Value)+    convert = (pure @RestIO) . R.ReqBodyJson . toJSON

@@ -106,6 +106,8 @@   , messageDetailedFile                     :: Maybe (T.Text, B.ByteString)   , messageDetailedAllowedMentions          :: Maybe AllowedMentions   , messageDetailedReference                :: Maybe MessageReference+  , messageDetailedComponents               :: Maybe [Component]+  , messageDetailedStickerIds               :: Maybe [StickerId]   } deriving (Show, Read, Eq, Ord)  instance Default MessageDetailedOpts where@@ -115,39 +117,10 @@                             , messageDetailedFile            = Nothing                             , messageDetailedAllowedMentions = Nothing                             , messageDetailedReference       = Nothing+                            , messageDetailedComponents      = Nothing+                            , messageDetailedStickerIds      = Nothing                             } --- | Data constructor for a part of MessageDetailedOpts.-data AllowedMentions = AllowedMentions-  { mentionEveryone    :: Bool-  , mentionUsers       :: Bool-  , mentionRoles       :: Bool-  , mentionUserIds     :: [UserId]-  , mentionRoleIds     :: [RoleId]-  , mentionRepliedUser :: Bool-  } deriving (Show, Read, Eq, Ord)--instance Default AllowedMentions where-  def = AllowedMentions { mentionEveryone    = False-                        , mentionUsers       = True-                        , mentionRoles       = True-                        , mentionUserIds     = []-                        , mentionRoleIds     = []-                        , mentionRepliedUser = True-                        }--instance ToJSON AllowedMentions where-  toJSON AllowedMentions{..} = object [-                                 ("parse" .= [name :: T.Text | (name, True) <--                                     [ ("everyone", mentionEveryone),-                                       ("users",    mentionUsers && mentionUserIds == []),-                                       ("roles",    mentionRoles && mentionRoleIds == []) ] ]),-                                 -- https://discord.com/developers/docs/resources/channel#allowed-mentions-object-                                 --  parse.users and users list cannot both be active, prioritize id list-                                 ("roles"        .= mentionRoleIds),-                                 ("users"        .= mentionUserIds),-                                 ("replied_user" .= mentionRepliedUser) ]- -- | Data constructor for GetReaction requests data ReactionTiming = BeforeReaction MessageId                     | AfterReaction MessageId@@ -330,12 +303,14 @@             Just f  -> [partFileRequestBody "file" (T.unpack $ fst f)               $ RequestBodyBS $ snd f] -          payloadData = object $ [ "content" .= messageDetailedContent msgOpts+          payloadData =  object $ [ "content" .= messageDetailedContent msgOpts                                  , "tts"     .= messageDetailedTTS msgOpts ] ++                                  [ name .= value | (name, Just value) <--                                    [ ("embed", toJSON <$> createEmbed <$> messageDetailedEmbed msgOpts)+                                    [ ("embed", toJSON . createEmbed <$> messageDetailedEmbed msgOpts)                                     , ("allowed_mentions", toJSON <$> messageDetailedAllowedMentions msgOpts)                                     , ("message_reference", toJSON <$> messageDetailedReference msgOpts)+                                    , ("components", toJSON . (filterOutIncorrectEmoji <$>) <$> messageDetailedComponents msgOpts)+                                    , ("sticker_ids", toJSON <$> messageDetailedStickerIds msgOpts)                                     ] ]           payloadPart = partBS "payload_json" $ BL.toStrict $ encode $ toJSON payloadData 

@@ -131,12 +131,12 @@   DeleteGuildIntegration   :: GuildId -> IntegrationId -> GuildRequest ()   -- | Sync an 'Integration'. Requires the 'MANAGE_GUILD' permission.   SyncGuildIntegration     :: GuildId -> IntegrationId -> GuildRequest ()-  -- | Returns the 'GuildEmbed' object. Requires the 'MANAGE_GUILD' permission.-  GetGuildEmbed            :: GuildId -> GuildRequest GuildEmbed-  -- | Modify a 'GuildEmbed' object for the guild. All attributes may be passed in with+  -- | Returns the 'GuildWidget' object. Requires the 'MANAGE_GUILD' permission.+  GetGuildWidget            :: GuildId -> GuildRequest GuildWidget +  -- | Modify a 'GuildWidget' object for the guild. All attributes may be passed in with   --   JSON and modified. Requires the 'MANAGE_GUILD' permission. Returns the updated-  --   'GuildEmbed' object.-  ModifyGuildEmbed         :: GuildId -> GuildEmbed -> GuildRequest GuildEmbed+  --   'GuildWidget' object.+  ModifyGuildWidget         :: GuildId -> GuildWidget -> GuildRequest GuildWidget   -- | Vanity URL   GetGuildVanityURL        :: GuildId -> GuildRequest T.Text @@ -167,13 +167,13 @@  instance ToJSON CreateGuildBanOpts where   toJSON CreateGuildBanOpts{..} =  object [(name, val) | (name, Just val) <--                       [("delete-message-days",+                       [("delete_message_days",                              toJSON <$> createGuildBanOptsDeleteLastNMessages ),                         ("reason", toJSON <$> createGuildBanOptsReason )]]  data ModifyGuildRoleOpts = ModifyGuildRoleOpts   { modifyGuildRoleOptsName            :: Maybe T.Text-  , modifyGuildRoleOptsPermissions     :: Maybe Integer+  , modifyGuildRoleOptsPermissions     :: Maybe T.Text   , modifyGuildRoleOptsColor           :: Maybe ColorInteger   , modifyGuildRoleOptsSeparateSidebar :: Maybe Bool   , modifyGuildRoleOptsMentionable     :: Maybe Bool@@ -324,8 +324,8 @@   (ModifyGuildIntegration g _ _) -> "guild_intgr " <> show g   (DeleteGuildIntegration g _) ->   "guild_intgr " <> show g   (SyncGuildIntegration g _) ->      "guild_sync " <> show g-  (GetGuildEmbed g) ->              "guild_embed " <> show g-  (ModifyGuildEmbed g _) ->         "guild_embed " <> show g+  (GetGuildWidget g) ->              "guild_widget " <> show g+  (ModifyGuildWidget g _) ->         "guild_widget " <> show g   (GetGuildVanityURL g) ->                "guild " <> show g  @@ -436,11 +436,11 @@   (SyncGuildIntegration guild integ) ->       Post (guilds // guild /: "integrations" // integ) (pure R.NoReqBody) mempty -  (GetGuildEmbed guild) ->+  (GetGuildWidget guild) ->       Get (guilds // guild /: "integrations") mempty -  (ModifyGuildEmbed guild patch) ->-      Patch (guilds // guild /: "embed") (pure (R.ReqBodyJson patch)) mempty+  (ModifyGuildWidget guild patch) ->+      Patch (guilds // guild /: "widget") (pure (R.ReqBodyJson patch)) mempty    (GetGuildVanityURL guild) ->       Get (guilds // guild /: "vanity-url") mempty

@@ -0,0 +1,65 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeApplications #-}++module Discord.Internal.Rest.Interactions where++import Data.Aeson (ToJSON (toJSON), Value)+import Network.HTTP.Req as R++import Discord.Internal.Rest.Prelude+import Discord.Internal.Types+import Discord.Internal.Types.Interactions++data InteractionResponseRequest a where+  CreateInteractionResponse :: InteractionId -> InteractionToken -> InteractionResponse -> InteractionResponseRequest ()+  GetOriginalInteractionResponse :: ApplicationId -> InteractionToken -> InteractionResponseRequest Message+  EditOriginalInteractionResponse :: ApplicationId -> InteractionToken -> InteractionCallbackMessages -> InteractionResponseRequest Message+  DeleteOriginalInteractionResponse :: ApplicationId -> InteractionToken -> InteractionResponseRequest ()+  CreateFollowupInteractionMessage :: ApplicationId -> InteractionToken -> InteractionCallbackMessages  -> InteractionResponseRequest Message+  GetFollowupInteractionMessage :: ApplicationId -> InteractionToken -> MessageId -> InteractionResponseRequest Message+  EditFollowupInteractionMessage :: ApplicationId -> InteractionToken -> MessageId -> InteractionResponse -> InteractionResponseRequest Message+  DeleteFollowupInteractionMessage :: ApplicationId -> InteractionToken -> MessageId -> InteractionResponseRequest ()++instance Request (InteractionResponseRequest a) where+  jsonRequest = interactionResponseJsonRequest+  majorRoute = interactionResponseMajorRoute++interactionResponseMajorRoute :: InteractionResponseRequest a -> String+interactionResponseMajorRoute a = case a of+  (CreateInteractionResponse iid _ _) -> "intresp " <> show iid+  (GetOriginalInteractionResponse aid _) -> "intresp " <> show aid+  (EditOriginalInteractionResponse aid _ _) -> "intresp " <> show aid+  (DeleteOriginalInteractionResponse aid _) -> "intresp " <> show aid+  (CreateFollowupInteractionMessage iid _ _) -> "intrespf " <> show iid+  (GetFollowupInteractionMessage aid _ _) -> "intrespf " <> show aid+  (EditFollowupInteractionMessage aid _ _ _) -> "intrespf " <> show aid+  (DeleteFollowupInteractionMessage aid _ _) -> "intrespf " <> show aid++interaction :: ApplicationId -> InteractionToken -> R.Url 'R.Https+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 /: it /: "callback") (convert i) mempty+  (GetOriginalInteractionResponse aid it) ->+    Get (interaction aid it /: "@original") mempty+  (EditOriginalInteractionResponse aid it i) ->+    Patch (interaction aid it /: "@original") (convert i) mempty+  (DeleteOriginalInteractionResponse aid it) ->+    Delete (interaction aid it /: "@original") mempty+  (CreateFollowupInteractionMessage aid it i) ->+    Post (baseUrl /: "webhooks" // aid /: it) (convert i) mempty+  (GetFollowupInteractionMessage aid it mid) ->+    Get (interaction aid it // mid) mempty+  (EditFollowupInteractionMessage aid it mid i) ->+    Patch (interaction aid it // mid) (convert i) mempty+  (DeleteFollowupInteractionMessage aid it mid) ->+    Delete (interaction aid it // mid) mempty+  where+    convert :: (ToJSON a) => a -> RestIO (ReqBodyJson Value)+    convert = (pure @RestIO) . R.ReqBodyJson . toJSON

@@ -19,7 +19,7 @@ -- | The base url (Req) for API requests baseUrl :: R.Url 'R.Https baseUrl = R.https "discord.com" R./: "api" R./: apiVersion-  where apiVersion = "v6"+  where apiVersion = "v8"  -- | Discord requires HTTP headers for authentication. authHeader :: Auth -> R.Option 'R.Https@@ -29,7 +29,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.10.0)"+  agent = "DiscordBot (https://github.com/aquarial/discord-haskell, 1.11.0)"  -- Append to an URL infixl 5 //@@ -37,7 +37,7 @@ (//) url part = url R./: T.pack (show part)  --- | Represtents a HTTP request made to an API that supplies a Json response+-- | A compiled HTTP request ready to execute data JsonRequest where   Delete ::                 R.Url 'R.Https ->      R.Option 'R.Https -> JsonRequest   Get    ::                 R.Url 'R.Https ->      R.Option 'R.Https -> JsonRequest@@ -46,7 +46,11 @@   Post   :: R.HttpBody a => R.Url 'R.Https -> RestIO a -> R.Option 'R.Https -> JsonRequest  class Request a where+  -- | used for putting a request into a rate limit bucket+  --   https://discord.com/developers/docs/topics/rate-limits#rate-limits   majorRoute :: a -> String++  -- | build a JSON http request   jsonRequest :: a -> JsonRequest  -- | Same Monad as IO. Overwrite Req settings

@@ -8,6 +8,9 @@   , module Discord.Internal.Types.Guild   , module Discord.Internal.Types.User   , module Discord.Internal.Types.Embed+  , module Discord.Internal.Types.Components+--, module Discord.Internal.Types.ApplicationCommands+--, module Discord.Internal.Types.Interactions   , module Data.Aeson   , module Data.Time.Clock   , userFacingEvent@@ -20,14 +23,20 @@ import Discord.Internal.Types.User import Discord.Internal.Types.Embed import Discord.Internal.Types.Prelude+import Discord.Internal.Types.Components +-- import Discord.Internal.Types.ApplicationCommands+import Discord.Internal.Types.Interactions++ import Data.Aeson (Object) import Data.Time.Clock (UTCTime(..))+import Data.Maybe (fromMaybe)   userFacingEvent :: EventInternalParse -> Event userFacingEvent event = case event of-  InternalReady a b c d e -> Ready a b c d e+  InternalReady a b c d e f g -> Ready a b c d e f g   InternalResumed a -> Resumed a   InternalChannelCreate a -> ChannelCreate a   InternalChannelUpdate a -> ChannelUpdate a@@ -58,4 +67,5 @@   InternalPresenceUpdate a -> PresenceUpdate a   InternalTypingStart a -> TypingStart a   InternalUserUpdate a -> UserUpdate a+  InternalInteractionCreate a -> InteractionCreate (fromMaybe (InteractionUnknown a) (fromInternal a))   InternalUnknownEvent a b -> UnknownEvent a b

@@ -0,0 +1,693 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}++module Discord.Internal.Types.ApplicationCommands+  ( ApplicationCommand (..),+    ApplicationCommandOptionSubcommandOrGroup (..),+    ApplicationCommandOptionSubcommand (..),+    ApplicationCommandOptionValue (..),+    InternalApplicationCommand (..),+    CreateApplicationCommand (..),+    createApplicationCommandChatInput,+    createApplicationCommandUser,+    createApplicationCommandMessage,+    EditApplicationCommand (..),+    ApplicationCommandType (..),+    InternalApplicationCommandOption (..),+    ApplicationCommandOptionType (..),+    InternalApplicationCommandOptionChoice,+    Choice (..),+    ApplicationCommandChannelType (..),+    GuildApplicationCommandPermissions (..),+    ApplicationCommandPermissions (..),+    ApplicationCommandPermissionType (..),+    StringNumberValue (..),+  )+where++import Control.Applicative+import Data.Aeson+import Data.Char (isLower)+import Data.Data (Data)+import Data.Default (Default (..))+import Data.Maybe (fromJust, fromMaybe)+import Data.Scientific (Scientific)+import qualified Data.Text as T+import Discord.Internal.Types.Prelude (ApplicationCommandId, ApplicationId, GuildId, Internals (..), Snowflake, makeTable, toMaybeJSON)++data ApplicationCommand+  = ApplicationCommandUser+      { applicationCommandId :: ApplicationCommandId,+        applicationCommandApplicationId :: ApplicationId,+        applicationCommandGuildId :: Maybe GuildId,+        applicationCommandName :: T.Text,+        applicationCommandDefaultPermission :: Maybe Bool,+        applicationCommandVersion :: Snowflake+      }+  | ApplicationCommandMessage+      { applicationCommandId :: ApplicationCommandId,+        applicationCommandApplicationId :: ApplicationId,+        applicationCommandGuildId :: Maybe GuildId,+        applicationCommandName :: T.Text,+        applicationCommandDefaultPermission :: Maybe Bool,+        applicationCommandVersion :: Snowflake+      }+  | ApplicationCommandChatInput+      { applicationCommandId :: ApplicationCommandId,+        applicationCommandApplicationId :: ApplicationId,+        applicationCommandGuildId :: Maybe GuildId,+        applicationCommandName :: T.Text,+        applicationCommandDescription :: T.Text,+        applicationCommandOptions :: Maybe ApplicationCommandOptions,+        applicationCommandDefaultPermission :: Maybe Bool,+        applicationCommandVersion :: Snowflake+      }+  | ApplicationCommandUnknown InternalApplicationCommand+  deriving (Show, Eq, Read)++data ApplicationCommandOptions+  = ApplicationCommandOptionsSubcommands [ApplicationCommandOptionSubcommandOrGroup]+  | ApplicationCommandOptionsValues [ApplicationCommandOptionValue]+  deriving (Show, Eq, Read)++data ApplicationCommandOptionSubcommandOrGroup+  = ApplicationCommandOptionSubcommandGroup+      { applicationCommandOptionSubcommandGroupName :: T.Text,+        applicationCommandOptionSubcommandGroupDescription :: T.Text,+        applicationCommandOptionSubcommandGroupOptions :: [ApplicationCommandOptionSubcommand]+      }+  | ApplicationCommandOptionSubcommandOrGroupSubcommand ApplicationCommandOptionSubcommand+  deriving (Show, Eq, Read)++data ApplicationCommandOptionSubcommand = ApplicationCommandOptionSubcommand+  { applicationCommandOptionSubcommandName :: T.Text,+    applicationCommandOptionSubcommandDescription :: T.Text,+    applicationCommandOptionSubcommandOptions :: [ApplicationCommandOptionValue]+  }+  deriving (Show, Eq, Read)++data ApplicationCommandOptionValue+  = ApplicationCommandOptionValueString+      { applicationCommandOptionValueName :: T.Text,+        applicationCommandOptionValueDescription :: T.Text,+        applicationCommandOptionValueRequired :: Maybe Bool,+        applicationCommandOptionValueStringChoices :: Maybe [Choice T.Text],+        applicationCommandOptionValueAutocomplete :: Maybe Bool+      }+  | ApplicationCommandOptionValueInteger+      { applicationCommandOptionValueName :: T.Text,+        applicationCommandOptionValueDescription :: T.Text,+        applicationCommandOptionValueRequired :: Maybe Bool,+        applicationCommandOptionValueIntegerChoices :: Maybe [Choice Integer],+        applicationCommandOptionValueIntegerMinVal :: Maybe Integer,+        applicationCommandOptionValueIntegerMaxVal :: Maybe Integer,+        applicationCommandOptionValueAutocomplete :: Maybe Bool+      }+  | ApplicationCommandOptionValueBoolean+      { applicationCommandOptionValueName :: T.Text,+        applicationCommandOptionValueDescription :: T.Text,+        applicationCommandOptionValueRequired :: Maybe Bool+      }+  | ApplicationCommandOptionValueUser+      { applicationCommandOptionValueName :: T.Text,+        applicationCommandOptionValueDescription :: T.Text,+        applicationCommandOptionValueRequired :: Maybe Bool+      }+  | ApplicationCommandOptionValueChannel+      { applicationCommandOptionValueName :: T.Text,+        applicationCommandOptionValueDescription :: T.Text,+        applicationCommandOptionValueRequired :: Maybe Bool,+        applicationCommandOptionValueChannelTypes :: Maybe [ApplicationCommandChannelType]+      }+  | ApplicationCommandOptionValueRole+      { applicationCommandOptionValueName :: T.Text,+        applicationCommandOptionValueDescription :: T.Text,+        applicationCommandOptionValueRequired :: Maybe Bool+      }+  | ApplicationCommandOptionValueMentionable+      { applicationCommandOptionValueName :: T.Text,+        applicationCommandOptionValueDescription :: T.Text,+        applicationCommandOptionValueRequired :: Maybe Bool+      }+  | ApplicationCommandOptionValueNumber+      { applicationCommandOptionValueName :: T.Text,+        applicationCommandOptionValueDescription :: T.Text,+        applicationCommandOptionValueRequired :: Maybe Bool,+        applicationCommandOptionValueNumberChoices :: Maybe [Choice Scientific],+        applicationCommandOptionValueNumberMinVal :: Maybe Scientific,+        applicationCommandOptionValueNumberMaxVal :: Maybe Scientific,+        applicationCommandOptionValueAutocomplete :: Maybe Bool+      }+  deriving (Show, Eq, Read)++instance Internals ApplicationCommandOptionValue InternalApplicationCommandOption where+  toInternal ApplicationCommandOptionValueNumber {..} = InternalApplicationCommandOption ApplicationCommandOptionTypeNumber applicationCommandOptionValueName applicationCommandOptionValueDescription applicationCommandOptionValueRequired (((StringNumberValueNumber <$>) <$>) <$> applicationCommandOptionValueNumberChoices) Nothing Nothing applicationCommandOptionValueNumberMinVal applicationCommandOptionValueNumberMaxVal applicationCommandOptionValueAutocomplete+  toInternal ApplicationCommandOptionValueInteger {..} = InternalApplicationCommandOption ApplicationCommandOptionTypeInteger applicationCommandOptionValueName applicationCommandOptionValueDescription applicationCommandOptionValueRequired (((StringNumberValueInteger <$>) <$>) <$> applicationCommandOptionValueIntegerChoices) Nothing Nothing (fromInteger <$> applicationCommandOptionValueIntegerMinVal) (fromInteger <$> applicationCommandOptionValueIntegerMaxVal) applicationCommandOptionValueAutocomplete+  toInternal ApplicationCommandOptionValueString {..} = InternalApplicationCommandOption ApplicationCommandOptionTypeInteger applicationCommandOptionValueName applicationCommandOptionValueDescription applicationCommandOptionValueRequired (((StringNumberValueString <$>) <$>) <$> applicationCommandOptionValueStringChoices) Nothing Nothing Nothing Nothing applicationCommandOptionValueAutocomplete+  toInternal ApplicationCommandOptionValueChannel {..} = InternalApplicationCommandOption ApplicationCommandOptionTypeChannel applicationCommandOptionValueName applicationCommandOptionValueDescription applicationCommandOptionValueRequired Nothing Nothing applicationCommandOptionValueChannelTypes Nothing Nothing Nothing+  toInternal ApplicationCommandOptionValueBoolean {..} = InternalApplicationCommandOption ApplicationCommandOptionTypeBoolean applicationCommandOptionValueName applicationCommandOptionValueDescription applicationCommandOptionValueRequired Nothing Nothing Nothing Nothing Nothing Nothing+  toInternal ApplicationCommandOptionValueUser {..} = InternalApplicationCommandOption ApplicationCommandOptionTypeUser applicationCommandOptionValueName applicationCommandOptionValueDescription applicationCommandOptionValueRequired Nothing Nothing Nothing Nothing Nothing Nothing+  toInternal ApplicationCommandOptionValueRole {..} = InternalApplicationCommandOption ApplicationCommandOptionTypeRole applicationCommandOptionValueName applicationCommandOptionValueDescription applicationCommandOptionValueRequired Nothing Nothing Nothing Nothing Nothing Nothing+  toInternal ApplicationCommandOptionValueMentionable {..} = InternalApplicationCommandOption ApplicationCommandOptionTypeMentionable applicationCommandOptionValueName applicationCommandOptionValueDescription applicationCommandOptionValueRequired Nothing Nothing Nothing Nothing Nothing Nothing++  fromInternal InternalApplicationCommandOption {internalApplicationCommandOptionType = ApplicationCommandOptionTypeNumber, ..} = do+    cs <- maybe (Just []) (mapM extractChoices) internalApplicationCommandOptionChoices+    return $ ApplicationCommandOptionValueNumber internalApplicationCommandOptionName internalApplicationCommandOptionDescription internalApplicationCommandOptionRequired (fromResult cs) internalApplicationCommandOptionMinVal internalApplicationCommandOptionMaxVal internalApplicationCommandOptionAutocomplete+    where+      extractChoices (Choice s (StringNumberValueNumber n)) = Just (Choice s n)+      extractChoices _ = Nothing+      fromResult [] = Nothing+      fromResult is = Just is+  fromInternal InternalApplicationCommandOption {internalApplicationCommandOptionType = ApplicationCommandOptionTypeInteger, ..} = do+    cs <- maybe (Just []) (mapM extractChoices) internalApplicationCommandOptionChoices+    return $ ApplicationCommandOptionValueInteger internalApplicationCommandOptionName internalApplicationCommandOptionDescription internalApplicationCommandOptionRequired (fromResult cs) (round <$> internalApplicationCommandOptionMinVal) (round <$> internalApplicationCommandOptionMaxVal) internalApplicationCommandOptionAutocomplete+    where+      extractChoices (Choice s (StringNumberValueInteger n)) = Just (Choice s n)+      extractChoices _ = Nothing+      fromResult [] = Nothing+      fromResult is = Just is+  -- note with the above: the bounds are rounded for simplicity but ideally they wouldn't be+  fromInternal InternalApplicationCommandOption {internalApplicationCommandOptionType = ApplicationCommandOptionTypeString, ..} = do+    cs <- maybe (Just []) (mapM extractChoices) internalApplicationCommandOptionChoices+    return $ ApplicationCommandOptionValueString internalApplicationCommandOptionName internalApplicationCommandOptionDescription internalApplicationCommandOptionRequired (fromResult cs) internalApplicationCommandOptionAutocomplete+    where+      extractChoices (Choice s (StringNumberValueString n)) = Just (Choice s n)+      extractChoices _ = Nothing+      fromResult [] = Nothing+      fromResult is = Just is+  fromInternal InternalApplicationCommandOption {internalApplicationCommandOptionType = ApplicationCommandOptionTypeBoolean, ..} = Just $ ApplicationCommandOptionValueBoolean internalApplicationCommandOptionName internalApplicationCommandOptionDescription internalApplicationCommandOptionRequired+  fromInternal InternalApplicationCommandOption {internalApplicationCommandOptionType = ApplicationCommandOptionTypeUser, ..} = Just $ ApplicationCommandOptionValueUser internalApplicationCommandOptionName internalApplicationCommandOptionDescription internalApplicationCommandOptionRequired+  fromInternal InternalApplicationCommandOption {internalApplicationCommandOptionType = ApplicationCommandOptionTypeRole, ..} = Just $ ApplicationCommandOptionValueRole internalApplicationCommandOptionName internalApplicationCommandOptionDescription internalApplicationCommandOptionRequired+  fromInternal InternalApplicationCommandOption {internalApplicationCommandOptionType = ApplicationCommandOptionTypeMentionable, ..} = Just $ ApplicationCommandOptionValueMentionable internalApplicationCommandOptionName internalApplicationCommandOptionDescription internalApplicationCommandOptionRequired+  fromInternal InternalApplicationCommandOption {internalApplicationCommandOptionType = ApplicationCommandOptionTypeChannel, ..} = Just $ ApplicationCommandOptionValueChannel internalApplicationCommandOptionName internalApplicationCommandOptionDescription internalApplicationCommandOptionRequired internalApplicationCommandOptionChannelTypes+  fromInternal _ = Nothing++instance Internals ApplicationCommandOptionSubcommand InternalApplicationCommandOption where+  toInternal ApplicationCommandOptionSubcommand {..} = InternalApplicationCommandOption ApplicationCommandOptionTypeSubcommand applicationCommandOptionSubcommandName applicationCommandOptionSubcommandDescription Nothing Nothing (Just $ toInternal <$> applicationCommandOptionSubcommandOptions) Nothing Nothing Nothing Nothing++  fromInternal InternalApplicationCommandOption {internalApplicationCommandOptionType = ApplicationCommandOptionTypeSubcommand, ..} = do+    os <- maybe (Just []) (mapM fromInternal) internalApplicationCommandOptionOptions+    return $ ApplicationCommandOptionSubcommand internalApplicationCommandOptionName internalApplicationCommandOptionDescription os+  fromInternal _ = Nothing++instance Internals ApplicationCommandOptionSubcommandOrGroup InternalApplicationCommandOption where+  toInternal (ApplicationCommandOptionSubcommandOrGroupSubcommand s) = toInternal s+  toInternal ApplicationCommandOptionSubcommandGroup {..} = InternalApplicationCommandOption ApplicationCommandOptionTypeSubcommandGroup applicationCommandOptionSubcommandGroupName applicationCommandOptionSubcommandGroupDescription Nothing Nothing (Just $ toInternal <$> applicationCommandOptionSubcommandGroupOptions) Nothing Nothing Nothing Nothing++  fromInternal io@InternalApplicationCommandOption {internalApplicationCommandOptionType = ApplicationCommandOptionTypeSubcommand, ..} = ApplicationCommandOptionSubcommandOrGroupSubcommand <$> fromInternal io+  fromInternal InternalApplicationCommandOption {internalApplicationCommandOptionType = ApplicationCommandOptionTypeSubcommandGroup, ..} = do+    os <- maybe (Just []) (mapM fromInternal) internalApplicationCommandOptionOptions+    return $ ApplicationCommandOptionSubcommandGroup internalApplicationCommandOptionName internalApplicationCommandOptionDescription os+  fromInternal _ = Nothing++instance Internals ApplicationCommandOptions [InternalApplicationCommandOption] where+  toInternal (ApplicationCommandOptionsSubcommands is) = toInternal <$> is+  toInternal (ApplicationCommandOptionsValues is) = toInternal <$> is++  fromInternal is = (ApplicationCommandOptionsSubcommands <$> mapM fromInternal is) <|> (ApplicationCommandOptionsValues <$> mapM fromInternal is)++instance Internals ApplicationCommand InternalApplicationCommand where+  toInternal ApplicationCommandUser {..} = InternalApplicationCommand applicationCommandId (Just ApplicationCommandTypeUser) applicationCommandApplicationId applicationCommandGuildId applicationCommandName "" Nothing applicationCommandDefaultPermission applicationCommandVersion+  toInternal ApplicationCommandMessage {..} = InternalApplicationCommand applicationCommandId (Just ApplicationCommandTypeMessage) applicationCommandApplicationId applicationCommandGuildId applicationCommandName "" Nothing applicationCommandDefaultPermission applicationCommandVersion+  toInternal ApplicationCommandChatInput {..} = InternalApplicationCommand applicationCommandId (Just ApplicationCommandTypeChatInput) applicationCommandApplicationId applicationCommandGuildId applicationCommandName applicationCommandDescription (toInternal <$> applicationCommandOptions) applicationCommandDefaultPermission applicationCommandVersion+  toInternal (ApplicationCommandUnknown ai) = ai++  fromInternal InternalApplicationCommand {internalApplicationCommandType = Just ApplicationCommandTypeUser, ..} = Just $ ApplicationCommandUser internalApplicationCommandId internalApplicationCommandApplicationId internalApplicationCommandGuildId internalApplicationCommandName internalApplicationCommandDefaultPermission internalApplicationCommandVersion+  fromInternal InternalApplicationCommand {internalApplicationCommandType = Just ApplicationCommandTypeMessage, ..} = Just $ ApplicationCommandMessage internalApplicationCommandId internalApplicationCommandApplicationId internalApplicationCommandGuildId internalApplicationCommandName internalApplicationCommandDefaultPermission internalApplicationCommandVersion+  fromInternal a@InternalApplicationCommand {internalApplicationCommandType = Just ApplicationCommandTypeChatInput, ..} = Just $ fromMaybe (ApplicationCommandUnknown a) $ ((internalApplicationCommandOptions <|> Just []) >>= fromInternal) >>= \iOptions -> Just $ ApplicationCommandChatInput internalApplicationCommandId internalApplicationCommandApplicationId internalApplicationCommandGuildId internalApplicationCommandName internalApplicationCommandDescription (Just iOptions) internalApplicationCommandDefaultPermission internalApplicationCommandVersion+  fromInternal a = fromInternal (a {internalApplicationCommandType = Just ApplicationCommandTypeChatInput})++-- Just $ ApplicationCommandMessage internalApplicationCommandId internalApplicationCommandApplicationId internalApplicationCommandGuildId internalApplicationCommandName internalApplicationCommandDefaultPermission internalApplicationCommandVersion++-- | What type of application command. Represents slash commands, right clicking+-- a user, and right clicking a message respectively.+data ApplicationCommandType+  = -- | Slash commands+    ApplicationCommandTypeChatInput+  | -- | User commands+    ApplicationCommandTypeUser+  | -- | Message commands+    ApplicationCommandTypeMessage+  deriving (Show, Read, Data, Eq)++instance Enum ApplicationCommandType where+  fromEnum ApplicationCommandTypeChatInput = 1+  fromEnum ApplicationCommandTypeUser = 2+  fromEnum ApplicationCommandTypeMessage = 3+  toEnum a = fromJust $ lookup a table+    where+      table = makeTable ApplicationCommandTypeChatInput++instance ToJSON ApplicationCommandType where+  toJSON = toJSON . fromEnum++instance FromJSON ApplicationCommandType where+  parseJSON = withScientific "ApplicationCommandType" (return . toEnum . round)++-- | Data type to be used when creating application commands. The specification+-- is below.+--+-- If a command of the same type and and name is sent to the server, it will+-- overwrite any command that already exists in the same scope (guild vs+-- global).+--+-- The description has to be empty for non-slash command application+-- commands, as do the options. The options need to be `Nothing` for non-slash+-- commands, too. If one of the options is a subcommand or subcommand group,+-- the base command will no longer be usable.+--+-- A subcommand group can have subcommands within it. This is the maximum amount+-- of command nesting permitted.+--+-- https://discord.com/developers/docs/interactions/application-commands#create-global-application-command+data CreateApplicationCommand = CreateApplicationCommand+  { -- | The application command name (1-32 chars).+    createApplicationCommandName :: T.Text,+    -- | The application command description (1-100 chars). Has to be empty for+    -- non-slash commands.+    createApplicationCommandDescription :: T.Text,+    -- | What options the application (max length 25). Has to be `Nothing` for+    -- non-slash commands.+    createApplicationCommandOptions :: Maybe [InternalApplicationCommandOption],+    -- | Whether the command is enabled by default when the application is added+    -- to a guild. Defaults to true if not present+    createApplicationCommandDefaultPermission :: Maybe Bool,+    -- | What the type of the command is. If `Nothing`, defaults to slash+    -- commands.+    createApplicationCommandType :: Maybe ApplicationCommandType+  }+  deriving (Show, Eq, Read)++instance ToJSON CreateApplicationCommand where+  toJSON CreateApplicationCommand {..} =+    object+      [ (name, value)+        | (name, Just value) <-+            [ ("name", toMaybeJSON createApplicationCommandName),+              ("description", toMaybeJSON createApplicationCommandDescription),+              ("options", toJSON <$> createApplicationCommandOptions),+              ("default_permission", toJSON <$> createApplicationCommandDefaultPermission),+              ("type", toJSON <$> createApplicationCommandType)+            ]+      ]++-- | Create the basics for a chat input (slash command). Use record overwriting+-- to enter the other values. The name needs to be all lower case letters, and+-- between 1 and 32 characters. The description has to be non-empty and less+-- than or equal to 100 characters.+createApplicationCommandChatInput :: T.Text -> T.Text -> Maybe CreateApplicationCommand+createApplicationCommandChatInput name desc+  | T.all isLower name && not (T.null desc) && l >= 1 && l <= 32 && T.length desc <= 100 = Just $ CreateApplicationCommand name desc Nothing Nothing (Just ApplicationCommandTypeChatInput)+  | otherwise = Nothing+  where+    l = T.length name++-- | 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.+createApplicationCommandUser :: T.Text -> Maybe CreateApplicationCommand+createApplicationCommandUser name+  | l >= 1 && l <= 32 = Just $ CreateApplicationCommand name "" Nothing Nothing (Just ApplicationCommandTypeUser)+  | otherwise = Nothing+  where+    l = T.length name++-- | 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.+createApplicationCommandMessage :: T.Text -> Maybe CreateApplicationCommand+createApplicationCommandMessage name+  | l >= 1 && l <= 32 = Just $ CreateApplicationCommand name "" Nothing Nothing (Just ApplicationCommandTypeMessage)+  | otherwise = Nothing+  where+    l = T.length name++-- | Data type to be used when editing application commands. The specification+-- is below. See `CreateApplicationCommand` for an explanation for the+-- parameters.+--+-- https://discord.com/developers/docs/interactions/application-commands#edit-global-application-command+data EditApplicationCommand = EditApplicationCommand+  { editApplicationCommandName :: Maybe T.Text,+    editApplicationCommandDescription :: Maybe T.Text,+    editApplicationCommandOptions :: Maybe [InternalApplicationCommandOption],+    editApplicationCommandDefaultPermission :: Maybe Bool,+    editApplicationCommandType :: Maybe ApplicationCommandType+  }++instance Default EditApplicationCommand where+  def = EditApplicationCommand Nothing Nothing Nothing Nothing Nothing++instance ToJSON EditApplicationCommand where+  toJSON EditApplicationCommand {..} =+    object+      [ (name, value)+        | (name, Just value) <-+            [ ("name", toJSON <$> editApplicationCommandName),+              ("description", toJSON <$> editApplicationCommandDescription),+              ("options", toJSON <$> editApplicationCommandOptions),+              ("default_permission", toJSON <$> editApplicationCommandDefaultPermission),+              ("type", toJSON <$> editApplicationCommandType)+            ]+      ]++-- | The full information about an application command, obtainable with the+-- various get requests. In theory, you never need to construct one of these -+-- so if you are, reconsider what you're doing.+--+-- https://discord.com/developers/docs/interactions/application-commands#application-command-object-application-command-structure+data InternalApplicationCommand = InternalApplicationCommand+  { -- | Unique id of the command.+    internalApplicationCommandId :: ApplicationCommandId,+    -- | The type of the command.+    internalApplicationCommandType :: Maybe ApplicationCommandType,+    -- | Unique id of the parent application (the bot).+    internalApplicationCommandApplicationId :: ApplicationId,+    -- | The guild id of the command if not global.+    internalApplicationCommandGuildId :: Maybe GuildId,+    -- | Must be 1-32 characters.+    internalApplicationCommandName :: T.Text,+    -- | Must be empty for USER and MESSAGE commands, otherwise 1-100 chars.+    internalApplicationCommandDescription :: T.Text,+    -- | CHAT_INPUT only, parameters to command+    internalApplicationCommandOptions :: Maybe [InternalApplicationCommandOption],+    -- | whether the command is enabled by default when the app is added to a+    -- guild. Defaults to true.+    internalApplicationCommandDefaultPermission :: Maybe Bool,+    internalApplicationCommandVersion :: Snowflake+  }+  deriving (Show, Eq, Read)++instance FromJSON InternalApplicationCommand where+  parseJSON =+    withObject+      "InternalApplicationCommand"+      ( \v ->+          InternalApplicationCommand+            <$> v .: "id"+            <*> v .:? "type"+            <*> v .: "application_id"+            <*> v .:? "guild_id"+            <*> v .: "name"+            <*> v .: "description"+            <*> v .:? "options"+            <*> v .:? "default_permission"+            <*> v .: "version"+      )++-- | This is the structure that designates different options for slash commands.+--+-- https://discord.com/developers/docs/interactions/application-commands#application-command-object-application-command-option-structure+data InternalApplicationCommandOption = InternalApplicationCommandOption+  { -- | What the type of this option is.+    internalApplicationCommandOptionType :: ApplicationCommandOptionType,+    -- | The name of the option . 1-32 characters+    internalApplicationCommandOptionName :: T.Text,+    -- | 1-100 characters+    internalApplicationCommandOptionDescription :: T.Text,+    -- | Is the parameter required? default false+    internalApplicationCommandOptionRequired :: Maybe Bool,+    -- | If specified, these are the only valid options to choose from. Type+    -- depends on optionType, and can only be specified for STRING, INTEGER or+    -- NUMBER types.+    internalApplicationCommandOptionChoices :: Maybe [InternalApplicationCommandOptionChoice],+    -- | If the option type is a subcommand or subcommand group type, these are+    -- the parameters to the subcommand.+    internalApplicationCommandOptionOptions :: Maybe [InternalApplicationCommandOption],+    -- | If option is channel type, these are the only channel types allowed.+    internalApplicationCommandOptionChannelTypes :: Maybe [ApplicationCommandChannelType],+    -- | If option is number type, minimum value for the number+    internalApplicationCommandOptionMinVal :: Maybe Scientific,+    -- | if option is number type, maximum value for the number+    internalApplicationCommandOptionMaxVal :: Maybe Scientific,+    -- | Enable auto complete interactions. may not be set to true if choices is present.+    internalApplicationCommandOptionAutocomplete :: Maybe Bool+  }+  deriving (Show, Eq, Read)++instance ToJSON InternalApplicationCommandOption where+  toJSON InternalApplicationCommandOption {..} =+    object+      [ (name, value)+        | (name, Just value) <-+            [ ("type", toMaybeJSON internalApplicationCommandOptionType),+              ("name", toMaybeJSON internalApplicationCommandOptionName),+              ("description", toMaybeJSON internalApplicationCommandOptionDescription),+              ("required", toJSON <$> internalApplicationCommandOptionRequired),+              ("choices", toJSON <$> internalApplicationCommandOptionChoices),+              ("options", toJSON <$> internalApplicationCommandOptionOptions),+              ("channel_types", toJSON <$> internalApplicationCommandOptionChannelTypes),+              ("min_val", toJSON <$> internalApplicationCommandOptionMinVal),+              ("max_val", toJSON <$> internalApplicationCommandOptionMaxVal),+              ("autocomplete", toJSON <$> internalApplicationCommandOptionAutocomplete)+            ]+      ]++instance FromJSON InternalApplicationCommandOption where+  parseJSON =+    withObject+      "InternalApplicationCommandOption"+      ( \v ->+          InternalApplicationCommandOption+            <$> v .: "type"+            <*> v .: "name"+            <*> v .: "description"+            <*> v .:? "required"+            <*> v .:? "choices"+            <*> v .:? "options"+            <*> v .:? "channel_types"+            <*> v .:? "min_val"+            <*> v .:? "max_val"+            <*> v .:? "autocomplete"+      )++-- | What type of command option. Can represent a wide variety of types, so+-- please check out the documentation below.+--+-- https://discord.com/developers/docs/interactions/application-commands#application-command-object-application-command-option-type+data ApplicationCommandOptionType+  = -- | A subcommand. It can take further options, excluding sub commands and+    -- sub command groups.+    ApplicationCommandOptionTypeSubcommand+  | -- | A subcommand group. It can take further options, excluding sub command+    -- groups.+    ApplicationCommandOptionTypeSubcommandGroup+  | -- | Can typically be provided with default values.+    ApplicationCommandOptionTypeString+  | -- | Can typically be provided with default values, and possibly with+    -- minimum and maximum values.+    ApplicationCommandOptionTypeInteger+  | ApplicationCommandOptionTypeBoolean+  | ApplicationCommandOptionTypeUser+  | -- | Can be limited in the types of the channel allowed.+    ApplicationCommandOptionTypeChannel+  | ApplicationCommandOptionTypeRole+  | -- | Users and roles.+    ApplicationCommandOptionTypeMentionable+  | -- | Can typically be provided with default values, and possibly with+    -- minimum and maximum values. Represents a double.+    ApplicationCommandOptionTypeNumber+  deriving (Show, Read, Data, Eq)++instance Enum ApplicationCommandOptionType where+  fromEnum ApplicationCommandOptionTypeSubcommand = 1+  fromEnum ApplicationCommandOptionTypeSubcommandGroup = 2+  fromEnum ApplicationCommandOptionTypeString = 3+  fromEnum ApplicationCommandOptionTypeInteger = 4+  fromEnum ApplicationCommandOptionTypeBoolean = 5+  fromEnum ApplicationCommandOptionTypeUser = 6+  fromEnum ApplicationCommandOptionTypeChannel = 7+  fromEnum ApplicationCommandOptionTypeRole = 8+  fromEnum ApplicationCommandOptionTypeMentionable = 9+  fromEnum ApplicationCommandOptionTypeNumber = 10+  toEnum a = fromJust $ lookup a table+    where+      table = makeTable ApplicationCommandOptionTypeSubcommand++instance ToJSON ApplicationCommandOptionType where+  toJSON = toJSON . fromEnum++instance FromJSON ApplicationCommandOptionType where+  parseJSON = withScientific "ApplicationCommandOptionType" (return . toEnum . round)++-- | Utility data type to store strings or number types.+data StringNumberValue = StringNumberValueString T.Text | StringNumberValueNumber Scientific | StringNumberValueInteger Integer+  deriving (Show, Read, Eq)++instance ToJSON StringNumberValue where+  toJSON (StringNumberValueString s) = toJSON s+  toJSON (StringNumberValueNumber i) = toJSON i+  toJSON (StringNumberValueInteger i) = toJSON i++instance FromJSON StringNumberValue where+  parseJSON (String t) = return $ StringNumberValueString t+  parseJSON v = (StringNumberValueInteger <$> parseJSON v) <|> (StringNumberValueNumber <$> parseJSON v)++data Choice a = Choice {choiceName :: T.Text, choiceValue :: a}+  deriving (Show, Read, Eq)++instance Functor Choice where+  fmap f (Choice s a) = Choice s (f a)++type InternalApplicationCommandOptionChoice = Choice StringNumberValue++-- | The choices for a particular option.+-- data InternalApplicationCommandOptionChoice = InternalApplicationCommandOptionChoice+--   { internalApplicationCommandOptionChoiceName :: T.Text,+--     internalApplicationCommandOptionChoiceValue :: StringNumberValue+--   }+--   deriving (Show, Read, Eq)+instance (ToJSON a) => ToJSON (Choice a) where+  toJSON Choice {..} = object [("name", toJSON choiceName), ("value", toJSON choiceValue)]++instance (FromJSON a) => FromJSON (Choice a) where+  parseJSON =+    withObject+      "Choice"+      ( \v ->+          Choice+            <$> v .: "name"+            <*> v .: "value"+      )++-- | The different channel types.+--+-- https://discord.com/developers/docs/resources/channel#channel-object-channel-types+data ApplicationCommandChannelType+  = -- | A text channel in a server.+    ApplicationCommandChannelTypeGuildText+  | -- | A direct message between users.+    ApplicationCommandChannelTypeDM+  | -- | A voice channel in a server.+    ApplicationCommandChannelTypeGuildVoice+  | -- | A direct message between multiple users.+    ApplicationCommandChannelTypeGroupDM+  | -- | An organizational category that contains up to 50 channels.+    ApplicationCommandChannelTypeGuildCategory+  | -- | A channel that users can follow and crosspost into their own server.+    ApplicationCommandChannelTypeGuildNews+  | -- | A channel in which game developers can sell their game on discord.+    ApplicationCommandChannelTypeGuildStore+  | -- | A temporary sub-channel within a guild_news channel.+    ApplicationCommandChannelTypeGuildNewsThread+  | -- | A temporary sub-channel within a guild_text channel+    ApplicationCommandChannelTypeGuildPublicThread+  | -- | A temporary sub-channel within a GUILD_TEXT channel that is only+    -- viewable by those invited and those with the MANAGE_THREADS permission+    ApplicationCommandChannelTypeGuildPrivateThread+  | -- | A voice channel for hosting events with an audience.+    ApplicationCommandChannelTypeGuildStageVoice+  deriving (Show, Read, Data, Eq)++instance Enum ApplicationCommandChannelType where+  fromEnum ApplicationCommandChannelTypeGuildText = 0+  fromEnum ApplicationCommandChannelTypeDM = 1+  fromEnum ApplicationCommandChannelTypeGuildVoice = 2+  fromEnum ApplicationCommandChannelTypeGroupDM = 3+  fromEnum ApplicationCommandChannelTypeGuildCategory = 4+  fromEnum ApplicationCommandChannelTypeGuildNews = 5+  fromEnum ApplicationCommandChannelTypeGuildStore = 6+  fromEnum ApplicationCommandChannelTypeGuildNewsThread = 10+  fromEnum ApplicationCommandChannelTypeGuildPublicThread = 11+  fromEnum ApplicationCommandChannelTypeGuildPrivateThread = 12+  fromEnum ApplicationCommandChannelTypeGuildStageVoice = 13+  toEnum a = fromJust $ lookup a table+    where+      table = makeTable ApplicationCommandChannelTypeGuildText++instance ToJSON ApplicationCommandChannelType where+  toJSON = toJSON . fromEnum++instance FromJSON ApplicationCommandChannelType where+  parseJSON = withScientific "ApplicationCommandChannelType" (return . toEnum . round)++data GuildApplicationCommandPermissions = GuildApplicationCommandPermissions+  { -- | The id of the command+    guildApplicationCommandPermissionsId :: ApplicationCommandId,+    -- | The id of the application+    guildApplicationCommandPermissionsApplicationId :: ApplicationId,+    -- | The id of the guild+    guildApplicationCommandPermissionsGuildId :: GuildId,+    -- | The permissions for the command in the guild+    guildApplicationCommandPermissionsPermissions :: [ApplicationCommandPermissions]+  }+  deriving (Show, Eq, Ord, Read)++instance FromJSON GuildApplicationCommandPermissions where+  parseJSON =+    withObject+      "GuildApplicationCommandPermissions"+      ( \v ->+          GuildApplicationCommandPermissions+            <$> v .: "id"+            <*> v .: "application_id"+            <*> v .: "guild_id"+            <*> v .: "permissions"+      )++instance ToJSON GuildApplicationCommandPermissions where+  toJSON GuildApplicationCommandPermissions {..} =+    object+      [ (name, value)+        | (name, Just value) <-+            [ ("id", toMaybeJSON guildApplicationCommandPermissionsId),+              ("application_id", toMaybeJSON guildApplicationCommandPermissionsApplicationId),+              ("guild_id", toMaybeJSON guildApplicationCommandPermissionsGuildId),+              ("permissions", toMaybeJSON guildApplicationCommandPermissionsPermissions)+            ]+      ]++data ApplicationCommandPermissions = ApplicationCommandPermissions+  { -- | The id of the role or user+    applicationCommandPermissionsId :: Snowflake,+    -- | Choose either role or user+    applicationCommandPermissionsType :: ApplicationCommandPermissionType,+    -- | Whether to allow or not+    applicationCommandPermissionsPermission :: Bool+  }+  deriving (Show, Eq, Ord, Read)++instance FromJSON ApplicationCommandPermissions where+  parseJSON =+    withObject+      "ApplicationCommandPermissions"+      ( \v ->+          ApplicationCommandPermissions+            <$> v .: "id"+            <*> v .: "type"+            <*> v .: "permission"+      )++instance ToJSON ApplicationCommandPermissions where+  toJSON ApplicationCommandPermissions {..} =+    object+      [ (name, value)+        | (name, Just value) <-+            [ ("id", toMaybeJSON applicationCommandPermissionsId),+              ("type", toMaybeJSON applicationCommandPermissionsType),+              ("permission", toMaybeJSON applicationCommandPermissionsPermission)+            ]+      ]++data ApplicationCommandPermissionType+  = ApplicationCommandPermissionTypeRole+  | ApplicationCommandPermissionTypeUser+  deriving (Show, Eq, Ord, Read, Data)++instance Enum ApplicationCommandPermissionType where+  fromEnum ApplicationCommandPermissionTypeRole = 1+  fromEnum ApplicationCommandPermissionTypeUser = 2+  toEnum a = fromJust $ lookup a table+    where+      table = makeTable ApplicationCommandPermissionTypeRole++instance ToJSON ApplicationCommandPermissionType where+  toJSON = toJSON . fromEnum++instance FromJSON ApplicationCommandPermissionType where+  parseJSON = withScientific "ApplicationCommandPermissionType" (return . toEnum . round)

@@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE DeriveDataTypeable #-}  -- | Data structures pertaining to Discord Channels module Discord.Internal.Types.Channel where@@ -13,8 +14,12 @@ import qualified Data.Text as T  import Discord.Internal.Types.Prelude-import Discord.Internal.Types.User (User(..))+import Discord.Internal.Types.User (User(..), GuildMember) import Discord.Internal.Types.Embed+import Data.Data (Data)+import Data.Maybe (fromJust)+import Data.Bits+import Discord.Internal.Types.Components (Component, Emoji)  -- | Guild channels represent an isolated set of users and messages in a Guild (Server) data Channel@@ -158,6 +163,73 @@       _ -> ChannelUnknownType <$> o .:  "id"                               <*> pure (T.pack (show o)) +instance ToJSON Channel where+  toJSON ChannelText{..} = object [(name,value) | (name, Just value) <-+              [ ("id",     toJSON <$> pure channelId)+              , ("guild_id", toJSON <$> pure channelGuild)+              , ("name",  toJSON <$> pure channelName)+              , ("position",   toJSON <$> pure channelPosition)+              , ("rate_limit_per_user", toJSON <$> pure channelUserRateLimit)+              , ("nsfw", toJSON <$> pure channelNSFW)+              , ("permission_overwrites",   toJSON <$> pure channelPermissions)+              , ("topic",   toJSON <$> pure channelTopic)+              , ("last_message_id",  toJSON <$> channelLastMessage)+              , ("parent_id",  toJSON <$> pure channelParentId)+              ] ]+  toJSON ChannelNews{..} = object [(name,value) | (name, Just value) <-+              [ ("id",     toJSON <$> pure channelId)+              , ("guild_id", toJSON <$> pure channelGuild)+              , ("name",  toJSON <$> pure channelName)+              , ("position",   toJSON <$> pure channelPosition)+              , ("permission_overwrites",   toJSON <$> pure channelPermissions)+              , ("nsfw", toJSON <$> pure channelNSFW)+              , ("topic",   toJSON <$> pure channelTopic)+              , ("last_message_id",  toJSON <$> channelLastMessage)+              ] ]+  toJSON ChannelStorePage{..} = object [(name,value) | (name, Just value) <-+              [ ("id",     toJSON <$> pure channelId)+              , ("guild_id", toJSON <$> pure channelGuild)+              , ("name",  toJSON <$> pure channelName)+              , ("nsfw", toJSON <$> pure channelNSFW)+              , ("position",   toJSON <$> pure channelPosition)+              , ("permission_overwrites",   toJSON <$> pure channelPermissions)+              ] ]+  toJSON ChannelDirectMessage{..} = object [(name,value) | (name, Just value) <-+              [ ("id",     toJSON <$> pure channelId)+              , ("recipients",   toJSON <$> pure channelRecipients)+              , ("last_message_id",  toJSON <$> channelLastMessage)+              ] ]+  toJSON ChannelVoice{..} = object [(name,value) | (name, Just value) <-+              [ ("id",     toJSON <$> pure channelId)+              , ("guild_id", toJSON <$> pure channelGuild)+              , ("name",  toJSON <$> pure channelName)+              , ("position",   toJSON <$> pure channelPosition)+              , ("nsfw", toJSON <$> pure channelNSFW)+              , ("permission_overwrites",   toJSON <$> pure channelPermissions)+              , ("bitrate",   toJSON <$> pure channelBitRate)+              , ("user_limit",  toJSON <$> pure channelUserLimit)+              ] ]+  toJSON ChannelGroupDM{..} = object [(name,value) | (name, Just value) <-+              [ ("id",     toJSON <$> pure channelId)+              , ("recipients",   toJSON <$> pure channelRecipients)+              , ("last_message_id",  toJSON <$> channelLastMessage)+              ] ]+  toJSON ChannelGuildCategory{..} = object [(name,value) | (name, Just value) <-+              [ ("id",     toJSON <$> pure channelId)+              , ("name", toJSON <$> pure channelName)+              , ("guild_id", toJSON <$> pure channelGuild)+              ] ]+  toJSON ChannelStage{..} = object [(name,value) | (name, Just value) <-+              [ ("id",     toJSON <$> pure channelId)+              , ("guild_id", toJSON <$> pure channelGuild)+              , ("channel_id", toJSON <$> pure channelStageId)+              , ("topic", toJSON <$> pure channelStageTopic)+              ] ]+  toJSON ChannelUnknownType{..} = object [(name,value) | (name, Just value) <-+              [ ("id",     toJSON <$> pure channelId)+              , ("json", toJSON <$> pure channelJSON)+              ] ]+ -- | If the channel is part of a guild (has a guild id field) channelIsInGuild :: Channel -> Bool channelIsInGuild c = case c of@@ -171,9 +243,9 @@ -- | Permission overwrites for a channel. data Overwrite = Overwrite   { overwriteId    :: OverwriteId -- ^ 'Role' or 'User' id-  , overwriteType  :: T.Text    -- ^ Either "role" or "member-  , overwriteAllow :: Integer   -- ^ Allowed permission bit set-  , overwriteDeny  :: Integer   -- ^ Denied permission bit set+  , overwriteType  :: Integer    -- ^ Either role (0) or member (1)+  , overwriteAllow :: T.Text   -- ^ Allowed permission bit set+  , overwriteDeny  :: T.Text   -- ^ Denied permission bit set   } deriving (Show, Read, Eq, Ord)  instance FromJSON Overwrite where@@ -193,42 +265,55 @@  -- | Represents information about a message in a Discord channel. data Message = Message-  { messageId           :: MessageId       -- ^ The id of the message-  , messageChannel      :: ChannelId       -- ^ Id of the channel the message-                                           --   was sent in-  , messageAuthor       :: User            -- ^ The 'User' the message was sent-                                           --   by-  , messageText         :: Text            -- ^ Contents of the message-  , messageTimestamp    :: UTCTime         -- ^ When the message was sent-  , messageEdited       :: Maybe UTCTime   -- ^ When/if the message was edited-  , messageTts          :: Bool            -- ^ Whether this message was a TTS-                                           --   message-  , messageEveryone     :: Bool            -- ^ Whether this message mentions-                                           --   everyone-  , messageMentions     :: [User]          -- ^ 'User's specifically mentioned in-                                           --   the message-  , messageMentionRoles :: [RoleId]        -- ^ 'Role's specifically mentioned in-                                           --   the message-  , messageAttachments  :: [Attachment]    -- ^ Any attached files-  , messageEmbeds       :: [Embed]         -- ^ Any embedded content-  , messageReactions    :: [MessageReaction] -- ^ Any reactions to message-  , messageNonce        :: Maybe Nonce     -- ^ Used for validating if a message-                                           --   was sent-  , messagePinned       :: Bool            -- ^ Whether this message is pinned-  , messageGuild        :: Maybe GuildId   -- ^ The guild the message went to-  , messageReference    :: Maybe MessageReference -- ^ Reference IDs of the original message-  , referencedMessage   :: Maybe Message   -- ^ The full original message+  { messageId                 :: MessageId                -- ^ The id of the message+  , messageChannelId          :: ChannelId                -- ^ Id of the channel the message+                                                          --   was sent in+  , messageGuildId            :: Maybe GuildId            -- ^ The guild the message went to+  , messageAuthor             :: User                     -- ^ The 'User' the message was sent+                                                          --   by+  , messageMember             :: Maybe GuildMember        -- ^ A partial guild member object+  , messageContent            :: Text                     -- ^ Contents of the message+  , messageTimestamp          :: UTCTime                  -- ^ When the message was sent+  , messageEdited             :: Maybe UTCTime            -- ^ When/if the message was edited+  , messageTts                :: Bool                     -- ^ Whether this message was a TTS+                                                          --   message+  , messageEveryone           :: Bool                     -- ^ Whether this message mentions+                                                          --   everyone+  , messageMentions           :: [User]                   -- ^ 'User's specifically mentioned in+                                                          --   the message+  , messageMentionRoles       :: [RoleId]                 -- ^ 'Role's specifically mentioned in+                                                          --   the message+  , messageAttachments        :: [Attachment]             -- ^ Any attached files+  , messageEmbeds             :: [Embed]                  -- ^ Any embedded content+  , messageReactions          :: [MessageReaction]        -- ^ Any reactions to message+  , messageNonce              :: Maybe Nonce              -- ^ Used for validating if a message+                                                          --   was sent+  , messagePinned             :: Bool                     -- ^ Whether this message is pinned+  , messageWebhookId          :: Maybe WebhookId          -- ^ The webhook id of the webhook that made the message+  , messageType               :: MessageType              -- ^ What type of message is this.+  , messageActivity           :: Maybe MessageActivity    -- ^ sent with Rich Presence-related chat embeds+  -- , messageApplication  :: Maybe ??? -- ^ a partial application object+  , messageApplicationId      :: Maybe ApplicationId      -- ^ if the message is a response to an Interaction, this is the id of the interaction's application+  , messageReference          :: Maybe MessageReference   -- ^ Reference IDs of the original message+  , messageFlags              :: Maybe MessageFlags       -- ^ Various message flags+  , messageReferencedMessage  :: Maybe Message            -- ^ The full original message+  , messageInteraction        :: Maybe MessageInteraction -- ^ sent if message is an interaction response+  , messageThread             :: Maybe Channel            -- ^ the thread that was started from this message, includes thread member object+  , messageComponents         :: Maybe [Component]        -- ^ 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, Read, Eq, Ord)  instance FromJSON Message where   parseJSON = withObject "Message" $ \o ->     Message <$> o .:  "id"             <*> o .:  "channel_id"+            <*> o .:? "guild_id" .!= Nothing             <*> (do isW <- o .:? "webhook_id"                     a <- o .: "author"                     case isW :: Maybe WebhookId of                       Nothing -> pure a                       Just _ -> pure $ a { userIsWebhook = True })+            <*> o .:? "member"             <*> o .:? "content" .!= ""             <*> o .:? "timestamp" .!= epochTime             <*> o .:? "edited_timestamp"@@ -241,11 +326,84 @@             <*> o .:? "reactions" .!= []             <*> o .:? "nonce"             <*> o .:? "pinned" .!= False-            <*> o .:? "guild_id" .!= Nothing+            <*> o .:? "webhook_id"+            <*> o .:  "type"+            <*> o .:? "activity"+            -- <*> o .:? "application"+            <*> o .:? "application_id"             <*> o .:? "message_reference" .!= Nothing+            <*> o .:? "flags"             <*> o .:? "referenced_message" .!= Nothing+            <*> o .:? "interaction"+            <*> o .:? "thread"+            <*> o .:? "components"+            <*> o .:? "sticker_items"  +instance ToJSON Message where+  toJSON Message {..} = object [(name, value) | (name, Just value) <-+      [ ("id",                  toJSON <$> pure messageId)+      , ("channel_id",          toJSON <$> pure messageChannelId)+      , ("guild_id",            toJSON <$>      messageGuildId)+      , ("author",              toJSON <$> pure messageAuthor)+      , ("member",              toJSON <$>      messageMember)+      , ("content",             toJSON <$> pure messageContent)+      , ("timestamp",           toJSON <$> pure messageTimestamp)+      , ("edited_timestamp",    toJSON <$>      messageEdited)+      , ("tts",                 toJSON <$> pure messageTts)+      , ("mention_everyone",    toJSON <$> pure messageEveryone)+      , ("mentions",            toJSON <$> pure messageMentions)+      , ("mention_roles",       toJSON <$> pure messageMentionRoles)+      , ("attachments",         toJSON <$> pure messageAttachments)+      , ("embeds",              toJSON <$> pure messageEmbeds)+      , ("reactions",           toJSON <$> pure messageReactions)+      , ("nonce",               toJSON <$>      messageNonce)+      , ("pinned",              toJSON <$> pure messagePinned)+      , ("webhook_id",          toJSON <$>      messageWebhookId)+      , ("type",                toJSON <$> pure messageType)+      , ("activity",            toJSON <$>      messageActivity)+      -- , ("application",            toJSON <$>      messageApplication)+      , ("application_id",      toJSON <$>      messageApplicationId)+      , ("message_reference",   toJSON <$>      messageReference)+      , ("flags",               toJSON <$>      messageFlags)+      , ("referenced_message",  toJSON <$>      messageReferencedMessage)+      , ("interaction",         toJSON <$>      messageInteraction)+      , ("thread",              toJSON <$>      messageThread)+      , ("components",          toJSON <$>      messageComponents)+      , ("sticker_items",       toJSON <$>      messageStickerItems)+      ] ]++-- | Data constructor for a part of MessageDetailedOpts.+data AllowedMentions = AllowedMentions+  { mentionEveryone    :: Bool+  , mentionUsers       :: Bool+  , mentionRoles       :: Bool+  , mentionUserIds     :: [UserId]+  , mentionRoleIds     :: [RoleId]+  , mentionRepliedUser :: Bool+  } deriving (Show, Read, Eq, Ord)++instance Default AllowedMentions where+  def = AllowedMentions { mentionEveryone    = False+                        , mentionUsers       = True+                        , mentionRoles       = True+                        , mentionUserIds     = []+                        , mentionRoleIds     = []+                        , mentionRepliedUser = True+                        }++instance ToJSON AllowedMentions where+  toJSON AllowedMentions{..} = object [+                                 ("parse" .= [name :: T.Text | (name, True) <-+                                     [ ("everyone", mentionEveryone),+                                       ("users",    mentionUsers && mentionUserIds == []),+                                       ("roles",    mentionRoles && mentionRoleIds == []) ] ]),+                                 -- https://discord.com/developers/docs/resources/channel#allowed-mentions-object+                                 --  parse.users and users list cannot both be active, prioritize id list+                                 ("roles"        .= mentionRoleIds),+                                 ("users"        .= mentionUserIds),+                                 ("replied_user" .= mentionRepliedUser) ]+ data MessageReaction = MessageReaction   { messageReactionCount :: Int   , messageReactionMeIncluded :: Bool@@ -258,29 +416,56 @@                     <*> o .: "me"                     <*> o .: "emoji" --- | Represents an emoticon (emoji)-data Emoji = Emoji-  { emojiId       :: Maybe EmojiId  -- ^ The emoji id-  , emojiName     :: T.Text         -- ^ The emoji name-  , emojiRoles    :: Maybe [RoleId] -- ^ Roles the emoji is active for-  , emojiUser     :: Maybe User     -- ^ User that created this emoji-  , emojiManaged  :: Maybe Bool     -- ^ Whether this emoji is managed-  , emojiAnimated :: Maybe Bool     -- ^ Whether this emoji is animated-  } deriving (Show, Read, Eq, Ord)+instance ToJSON MessageReaction where+  toJSON MessageReaction{..} = object [(name, value) | (name, Just value) <-+      [ ("count", toJSON <$> pure messageReactionCount)+      , ("me",    toJSON <$> pure messageReactionMeIncluded)+      , ("emoji", toJSON <$> pure messageReactionEmoji)+      ]] -instance FromJSON Emoji where-  parseJSON = withObject "Emoji" $ \o ->-    Emoji <$> o .:  "id"-          <*> o .:  "name"-          <*> o .:? "roles"-          <*> o .:? "user"-          <*> o .:? "managed"-          <*> o .:? "animated"+-- TODO: expand stickers and have full objects+data StickerItem = StickerItem+  { stickerItemId :: StickerId+  , stickerItemName :: T.Text+  , stickerItemFormatType :: StickerFormatType+  }  deriving (Show, Read, Eq, Ord) +instance FromJSON StickerItem where+  parseJSON = withObject "StickerItem" $ \o ->+    StickerItem <$> o .: "id"+                <*> o .: "name"+                <*> o .: "format_type" +instance ToJSON StickerItem where+  toJSON StickerItem{..} = object [(name, value) | (name, Just value) <-+      [ ("id",          toJSON <$> pure stickerItemId)+      , ("name",        toJSON <$> pure stickerItemName)+      , ("format_type", toJSON <$> pure stickerItemFormatType)+      ]]++data StickerFormatType =+    StickerFormatTypePNG+  | StickerFormatTypeAPNG+  | StickerFormatTypeLOTTIE+  deriving (Show, Read, Eq, Ord, Data)++instance Enum StickerFormatType where+  fromEnum StickerFormatTypePNG = 1+  fromEnum StickerFormatTypeAPNG = 2+  fromEnum StickerFormatTypeLOTTIE = 3+  toEnum a = fromJust $ lookup a table+    where+      table = makeTable StickerFormatTypePNG++instance ToJSON StickerFormatType where+  toJSON = toJSON . fromEnum++instance FromJSON StickerFormatType where+  parseJSON = withScientific "StickerFormatType" (return . toEnum . round)+ -- | Represents an attached to a message file. data Attachment = Attachment-  { attachmentId       :: Snowflake     -- ^ Attachment id+  { attachmentId       :: AttachmentId     -- ^ Attachment id   , attachmentFilename :: T.Text        -- ^ Name of attached file   , attachmentSize     :: Integer       -- ^ Size of file (in bytes)   , attachmentUrl      :: T.Text        -- ^ Source of file@@ -299,7 +484,16 @@                <*> o .:? "height"                <*> o .:? "width" -+instance ToJSON Attachment where+  toJSON Attachment {..} = object [(name, value) | (name, Just value) <-+      [ ("id",        toJSON <$> pure attachmentId)+      , ("filename",  toJSON <$> pure attachmentFilename)+      , ("size",      toJSON <$> pure attachmentSize)+      , ("url",       toJSON <$> pure attachmentUrl)+      , ("proxy_url", toJSON <$> pure attachmentProxy)+      , ("height",    toJSON <$>      attachmentHeight)+      , ("width",     toJSON <$>      attachmentWidth)+      ] ]  newtype Nonce = Nonce T.Text   deriving (Show, Read, Eq, Ord)@@ -309,7 +503,10 @@   parseJSON (Number nonce) = pure . Nonce . T.pack . show $ nonce   parseJSON _ = empty +instance ToJSON Nonce where+  toJSON (Nonce t) = String t + -- | Represents a Message Reference data MessageReference = MessageReference   { referenceMessageId      :: Maybe MessageId  -- ^ id of the originating message@@ -339,3 +536,166 @@                          , referenceGuildId   = Nothing                          , failIfNotExists    = False                          }+++data MessageType+  = MessageTypeDefault +  | MessageTypeRecipientAdd +  | MessageTypeRecipientRemove +  | MessageTypeCall+  | MessageTypeChannelNameChange+  | MessageTypeChannelIconChange+  | MessageTypeChannelPinnedMessage+  | MessageTypeGuildMemberJoin+  | MessageTypeUserPremiumGuildSubscription+  | MessageTypeUserPremiumGuildSubscriptionTier1+  | MessageTypeUserPremiumGuildSubscriptionTier2+  | MessageTypeUserPremiumGuildSubscriptionTier3+  | MessageTypeChannelFollowAdd+  | MessageTypeGuildDiscoveryDisqualified+  | MessageTypeGuildDiscoveryRequalified+  | MessageTypeGuildDiscoveryGracePeriodInitialWarning+  | MessageTypeGuildDiscoveryGracePeriodFinalWarning+  | MessageTypeThreadCreated+  | MessageTypeReply+  | MessageTypeChatInputCommand+  | MessageTypeThreadStarterMessage+  | MessageTypeGuildInviteReminder+  | MessageTypeContextMenuCommand+  deriving (Show, Read, Data, Eq, Ord)++instance Enum MessageType where+  fromEnum MessageTypeDefault = 0+  fromEnum MessageTypeRecipientAdd = 1+  fromEnum MessageTypeRecipientRemove = 2+  fromEnum MessageTypeCall = 3+  fromEnum MessageTypeChannelNameChange = 4+  fromEnum MessageTypeChannelIconChange = 5+  fromEnum MessageTypeChannelPinnedMessage = 6+  fromEnum MessageTypeGuildMemberJoin = 7+  fromEnum MessageTypeUserPremiumGuildSubscription = 8+  fromEnum MessageTypeUserPremiumGuildSubscriptionTier1 = 9+  fromEnum MessageTypeUserPremiumGuildSubscriptionTier2 = 10+  fromEnum MessageTypeUserPremiumGuildSubscriptionTier3 = 11+  fromEnum MessageTypeChannelFollowAdd = 12+  fromEnum MessageTypeGuildDiscoveryDisqualified = 14+  fromEnum MessageTypeGuildDiscoveryRequalified = 15+  fromEnum MessageTypeGuildDiscoveryGracePeriodInitialWarning = 16+  fromEnum MessageTypeGuildDiscoveryGracePeriodFinalWarning = 17+  fromEnum MessageTypeThreadCreated = 18+  fromEnum MessageTypeReply = 19+  fromEnum MessageTypeChatInputCommand = 20+  fromEnum MessageTypeThreadStarterMessage = 21+  fromEnum MessageTypeGuildInviteReminder = 22+  fromEnum MessageTypeContextMenuCommand = 23+  toEnum a = fromJust $ lookup a table+    where+      table = makeTable MessageTypeDefault++instance ToJSON MessageType where+  toJSON = toJSON . fromEnum++instance FromJSON MessageType where+  parseJSON = withScientific "MessageType" (return . toEnum . round)++data MessageActivity = MessageActivity+  { messageActivityType :: MessageActivityType+  , messageActivityPartyId :: Maybe T.Text+  }+  deriving (Show, Read, Data, Eq, Ord)++instance FromJSON MessageActivity where+  parseJSON = withObject "MessageActivity" $ \o ->+    MessageActivity <$> o .:   "type"+                     <*> o .:? "party_id"++instance ToJSON MessageActivity where+  toJSON MessageActivity{..} = object [(name,value) | (name, Just value) <-+              [ ("type",     toJSON <$> pure messageActivityType)+              , ("party_id", toJSON <$>      messageActivityPartyId)+              ] ]++data MessageActivityType+  = MessageActivityTypeJoin -- ^ Join a Rich Presence event+  | MessageActivityTypeSpectate -- ^ Spectate a Rich Presence event+  | MessageActivityTypeListen -- ^ Listen to a Rich Presence event+  | MessageActivityTypeJoinRequest -- ^ Request to join a Rich Presence event+  deriving (Show, Read, Data, Eq, Ord)++instance Enum MessageActivityType where+  fromEnum MessageActivityTypeJoin = 1+  fromEnum MessageActivityTypeSpectate = 2+  fromEnum MessageActivityTypeListen = 3+  fromEnum MessageActivityTypeJoinRequest = 4+  toEnum a = fromJust $ lookup a table+    where+      table = makeTable MessageActivityTypeJoin++instance ToJSON MessageActivityType where+  toJSON = toJSON . fromEnum++instance FromJSON MessageActivityType where+  parseJSON = withScientific "MessageActivityType" (return . toEnum . round)++-- | Types of flags to attach to the message.+data MessageFlag = +    MessageFlagCrossposted+  | MessageFlagIsCrosspost+  | MessageFlagSupressEmbeds+  | MessageFlagSourceMessageDeleted+  | MessageFlagUrgent+  | MessageFlagHasThread+  | MessageFlagEphemeral+  | MessageFlagLoading+  deriving (Show, Read, Eq, Data, Ord)++newtype MessageFlags = MessageFlags [MessageFlag]+  deriving (Show, Read, Eq, Ord)++instance Enum MessageFlag where+  fromEnum MessageFlagCrossposted = 1 `shift` 0+  fromEnum MessageFlagIsCrosspost = 1 `shift` 1+  fromEnum MessageFlagSupressEmbeds = 1 `shift` 2+  fromEnum MessageFlagSourceMessageDeleted = 1 `shift` 3+  fromEnum MessageFlagUrgent = 1 `shift` 4+  fromEnum MessageFlagHasThread = 1 `shift` 5+  fromEnum MessageFlagEphemeral = 1 `shift` 6+  fromEnum MessageFlagLoading = 1 `shift` 7+  toEnum a = fromJust $ lookup a table+    where+      table = makeTable MessageFlagCrossposted++instance ToJSON MessageFlags where+  toJSON (MessageFlags fs) = Number $ fromInteger $ fromIntegral $ foldr (.|.) 0 (fromEnum <$> fs)++-- TODO: maybe make this a type class or something - the ability to handle flags automatically would be Very Good.++instance FromJSON MessageFlags where+  parseJSON = withScientific "MessageFlags" (\s -> let i = round s in if i /= (i .&. range) then fail "could not get message flags" else return $ MessageFlags (snd <$> filter (\(i',_) -> i .&. i' == i') table))+    where +      table = makeTable MessageFlagCrossposted+      range = sum $ fst <$> table++data MessageInteraction = MessageInteraction+  { messageInteractionId :: InteractionId+  , messageInteractionType :: InteractionType+  , messageInteractionName :: T.Text+  , messageInteractionUser :: User+  } deriving (Show, Eq, Ord, Read)++instance ToJSON MessageInteraction where+  toJSON MessageInteraction{..} = object [(name,value) | (name, Just value) <-+              [ ("id",     toJSON <$> pure messageInteractionId)+              , ("type",   toJSON <$> pure messageInteractionType)+              , ("name",   toJSON <$> pure messageInteractionName)+              , ("user",   toJSON <$> pure messageInteractionUser)+              ] ]+++instance FromJSON MessageInteraction where+  parseJSON = withObject "MessageInteraction" $ \o ->+    MessageInteraction <$> o .: "id"+                       <*> o .: "type"+                       <*> o .: "name"+                       <*> o .: "user"+

@@ -0,0 +1,296 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Discord.Internal.Types.Components where++import Data.Aeson+import Data.Data (Data)+import Data.Maybe (fromJust, fromMaybe)+import qualified Data.Text as T+import Data.Tuple (swap)+import Discord.Internal.Types.Prelude (EmojiId, Internals (..), RoleId, makeTable, toMaybeJSON)+import Discord.Internal.Types.User (User)+import qualified Network.HTTP.Req as R++-- | Component type for a button, split into URL button and not URL button.+--+-- Don't directly send button components - they need to be within an action row.+data ComponentButton+  = ComponentButton+      { componentButtonCustomId :: T.Text,+        componentButtonDisabled :: Bool,+        componentButtonStyle :: ButtonStyle,+        componentButtonLabel :: T.Text,+        componentButtonEmoji :: Maybe Emoji+      }+  | ComponentButtonUrl+      { componentButtonUrl :: R.Url 'R.Https,+        componentButtonDisabled :: Bool,+        componentButtonLabel :: T.Text,+        componentButtonEmoji :: Maybe Emoji+      }+  deriving (Show, Eq)++data ButtonStyle = ButtonStylePrimary | ButtonStyleSecondary | ButtonStyleSuccess | ButtonStyleDanger+  deriving (Show, Eq, Read)++buttonStyles :: [(ButtonStyle, InternalButtonStyle)]+buttonStyles =+  [ (ButtonStylePrimary, InternalButtonStylePrimary),+    (ButtonStyleSecondary, InternalButtonStyleSecondary),+    (ButtonStyleSuccess, InternalButtonStyleSuccess),+    (ButtonStyleDanger, InternalButtonStyleDanger)+  ]++instance Internals ButtonStyle InternalButtonStyle where+  toInternal a = fromJust (lookup a buttonStyles)+  fromInternal b = lookup b (swap <$> buttonStyles)++-- | Component type for a select menus.+--+-- Don't directly send select menus - they need to be within an action row.+data ComponentSelectMenu = ComponentSelectMenu+  { componentSelectMenuCustomId :: T.Text,+    componentSelectMenuDisabled :: Bool,+    componentSelectMenuOptions :: [SelectOption],+    componentSelectMenuPlaceholder :: Maybe T.Text,+    componentSelectMenuMinValues :: Maybe Integer,+    componentSelectMenuMaxValues :: Maybe Integer+  }+  deriving (Show, Eq, Read)++data ComponentActionRow = ComponentActionRowButton [ComponentButton] | ComponentActionRowSelectMenu ComponentSelectMenu+  deriving (Show, Eq)++validPartialEmoji :: Emoji -> Maybe Emoji+validPartialEmoji Emoji {..} = do+  eid <- emojiId+  ean <- emojiAnimated+  return $ Emoji (Just eid) emojiName Nothing Nothing Nothing (Just ean)++instance Internals ComponentActionRow Component where+  toInternal (ComponentActionRowButton as) = Component ComponentTypeActionRow Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing (Just (toInternal' <$> as))+    where+      toInternal' ComponentButtonUrl {..} = Component ComponentTypeButton Nothing (Just componentButtonDisabled) (Just InternalButtonStyleLink) (Just componentButtonLabel) componentButtonEmoji (Just (R.renderUrl componentButtonUrl)) Nothing Nothing Nothing Nothing Nothing+      toInternal' ComponentButton {..} = Component ComponentTypeButton (Just componentButtonCustomId) (Just componentButtonDisabled) (Just (toInternal componentButtonStyle)) (Just componentButtonLabel) componentButtonEmoji Nothing Nothing Nothing Nothing Nothing Nothing+  toInternal (ComponentActionRowSelectMenu ComponentSelectMenu {..}) = Component ComponentTypeActionRow Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing (Just [Component ComponentTypeSelectMenu (Just componentSelectMenuCustomId) (Just componentSelectMenuDisabled) Nothing Nothing Nothing Nothing (Just componentSelectMenuOptions) componentSelectMenuPlaceholder componentSelectMenuMinValues componentSelectMenuMaxValues Nothing])++  fromInternal Component {componentType = ComponentTypeActionRow, componentComponents = (Just (Component {componentType = ComponentTypeSelectMenu, ..} : _))} = do+    cid <- componentCustomId+    cd <- componentDisabled+    co <- componentOptions+    return $ ComponentActionRowSelectMenu $ ComponentSelectMenu cid cd co componentPlaceholder componentMinValues componentMaxValues+  fromInternal Component {componentType = ComponentTypeActionRow, componentComponents = compComps} = compComps >>= mapM fromInternal' >>= Just . ComponentActionRowButton+    where+      fromInternal' Component {componentType = ComponentTypeButton, componentStyle = Just InternalButtonStyleLink, ..} = do+        url <- R.https <$> componentUrl+        label <- componentLabel+        return $ ComponentButtonUrl url (fromMaybe False componentDisabled) label componentEmoji+      fromInternal' Component {componentType = ComponentTypeButton, ..} = do+        customId <- componentCustomId+        label <- componentLabel+        style <- componentStyle >>= fromInternal+        return $ ComponentButton customId (fromMaybe False componentDisabled) style label componentEmoji+      fromInternal' _ = Nothing+  fromInternal _ = Nothing++data Component = Component+  { componentType :: ComponentType,+    -- | Buttons and Select Menus only+    componentCustomId :: Maybe T.Text,+    -- | Buttons and Select Menus only+    componentDisabled :: Maybe Bool,+    -- | Button only+    componentStyle :: Maybe InternalButtonStyle,+    -- | Button only+    componentLabel :: Maybe T.Text,+    -- | Button only+    componentEmoji :: Maybe Emoji,+    -- | Button only, link buttons only+    componentUrl :: Maybe T.Text,+    -- | Select Menus only, max 25+    componentOptions :: Maybe [SelectOption],+    -- | Select Menus only, max 100 chars+    componentPlaceholder :: Maybe T.Text,+    -- | Select Menus only, min values to choose, default 1+    componentMinValues :: Maybe Integer,+    -- | Select Menus only, max values to choose, default 1+    componentMaxValues :: Maybe Integer,+    -- | Action Rows only+    componentComponents :: Maybe [Component]+  }+  deriving (Show, Eq, Ord, Read)++instance FromJSON Component where+  parseJSON = withObject "Component" $ \o ->+    Component <$> o .: "type"+      <*> o .:? "custom_id"+      <*> o .:? "disabled"+      <*> o .:? "style"+      <*> o .:? "label"+      <*> o .:? "emoji"+      <*> o .:? "url"+      <*> o .:? "options"+      <*> o .:? "placeholder"+      <*> o .:? "min_values"+      <*> o .:? "max_values"+      <*> o .:? "components"++instance ToJSON Component where+  toJSON Component {..} =+    object+      [ (name, value)+        | (name, Just value) <-+            [ ("type", toMaybeJSON componentType),+              ("custom_id", toJSON <$> componentCustomId),+              ("disabled", toJSON <$> componentDisabled),+              ("style", toJSON <$> componentStyle),+              ("label", toJSON <$> componentLabel),+              ("emoji", toJSON <$> componentEmoji),+              ("url", toJSON <$> componentUrl),+              ("options", toJSON <$> componentOptions),+              ("placeholder", toJSON <$> componentPlaceholder),+              ("min_values", toJSON <$> componentMinValues),+              ("max_values", toJSON <$> componentMaxValues),+              ("components", toJSON <$> componentComponents)+            ]+      ]++-- | The different types of components+data ComponentType+  = -- | A container for other components+    ComponentTypeActionRow+  | -- | A button+    ComponentTypeButton+  | -- | A select menu for picking from choices+    ComponentTypeSelectMenu+  deriving (Show, Read, Eq, Ord, Data)++instance Enum ComponentType where+  fromEnum ComponentTypeActionRow = 1+  fromEnum ComponentTypeButton = 2+  fromEnum ComponentTypeSelectMenu = 3+  toEnum a = fromJust $ lookup a table+    where+      table = makeTable ComponentTypeActionRow++instance ToJSON ComponentType where+  toJSON = toJSON . fromEnum++instance FromJSON ComponentType where+  parseJSON = withScientific "StickerFormatType" (return . toEnum . round)++data InternalButtonStyle+  = -- | Blurple button+    InternalButtonStylePrimary+  | -- | Grey button+    InternalButtonStyleSecondary+  | -- | Green button+    InternalButtonStyleSuccess+  | -- | Red button+    InternalButtonStyleDanger+  | -- | Grey button, navigates to URL+    InternalButtonStyleLink+  deriving (Show, Read, Eq, Ord, Data)++instance Enum InternalButtonStyle where+  fromEnum InternalButtonStylePrimary = 1+  fromEnum InternalButtonStyleSecondary = 2+  fromEnum InternalButtonStyleSuccess = 3+  fromEnum InternalButtonStyleDanger = 4+  fromEnum InternalButtonStyleLink = 5+  toEnum a = fromJust $ lookup a table+    where+      table = makeTable InternalButtonStylePrimary++instance ToJSON InternalButtonStyle where+  toJSON = toJSON . fromEnum++instance FromJSON InternalButtonStyle where+  parseJSON = withScientific "InternalButtonStyle" (return . toEnum . round)++-- | Represents an emoticon (emoji)+data Emoji = Emoji+  { -- | The emoji id+    emojiId :: Maybe EmojiId,+    -- | The emoji name+    emojiName :: T.Text,+    -- | Roles the emoji is active for+    emojiRoles :: Maybe [RoleId],+    -- | User that created this emoji+    emojiUser :: Maybe User,+    -- | Whether this emoji is managed+    emojiManaged :: Maybe Bool,+    -- | Whether this emoji is animated+    emojiAnimated :: Maybe Bool+  }+  deriving (Show, Read, Eq, Ord)++instance FromJSON Emoji where+  parseJSON = withObject "Emoji" $ \o ->+    Emoji <$> o .:? "id"+      <*> o .: "name"+      <*> o .:? "roles"+      <*> o .:? "user"+      <*> o .:? "managed"+      <*> o .:? "animated"++instance ToJSON Emoji where+  toJSON Emoji {..} =+    object+      [ (name, value)+        | (name, Just value) <-+            [ ("id", toJSON <$> emojiId),+              ("name", toMaybeJSON emojiName),+              ("roles", toJSON <$> emojiRoles),+              ("user", toJSON <$> emojiUser),+              ("managed", toJSON <$> emojiManaged),+              ("animated", toJSON <$> emojiAnimated)+            ]+      ]++data SelectOption = SelectOption+  { -- | User facing option name+    selectOptionLabel :: T.Text,+    -- | Dev facing option value+    selectOptionValue :: T.Text,+    -- | additional description+    selectOptionDescription :: Maybe T.Text,+    -- | A partial emoji to show with the object (id, name, animated)+    selectOptionEmoji :: Maybe Emoji,+    -- | Use this value by default+    selectOptionDefault :: Maybe Bool+  }+  deriving (Show, Eq, Ord, Read)++instance FromJSON SelectOption where+  parseJSON = withObject "SelectOption" $ \o ->+    SelectOption <$> o .: "label"+      <*> o .: "value"+      <*> o .:? "description"+      <*> o .:? "emoji"+      <*> o .:? "default"++instance ToJSON SelectOption where+  toJSON SelectOption {..} =+    object+      [ (name, value)+        | (name, Just value) <-+            [ ("label", toMaybeJSON selectOptionLabel),+              ("value", toMaybeJSON selectOptionValue),+              ("description", toJSON <$> selectOptionDescription),+              ("emoji", toJSON <$> selectOptionEmoji),+              ("default", toJSON <$> selectOptionDefault)+            ]+      ]++filterOutIncorrectEmoji :: Component -> Component+filterOutIncorrectEmoji c@Component {componentType = ComponentTypeActionRow, componentComponents = (Just cs)} = c {componentComponents = Just (filterOutIncorrectEmoji <$> cs)}+filterOutIncorrectEmoji c@Component {componentType = ComponentTypeSelectMenu, componentOptions = (Just os)} = c {componentOptions = Just ((\so -> so {selectOptionEmoji = selectOptionEmoji so >>= validPartialEmoji}) <$> os)}+filterOutIncorrectEmoji c@Component {componentType = ComponentTypeButton, componentEmoji = (Just e)} = c {componentEmoji = validPartialEmoji e}+filterOutIncorrectEmoji c = c

@@ -15,13 +15,15 @@  import Discord.Internal.Types.Prelude import Discord.Internal.Types.Channel-import Discord.Internal.Types.Guild-import Discord.Internal.Types.User (User)+import Discord.Internal.Types.Guild     ( Role, GuildInfo, GuildUnavailable, Guild )+import Discord.Internal.Types.User (User, GuildMember)+import Discord.Internal.Types.Interactions (InternalInteraction, Interaction)+import Discord.Internal.Types.Components (Emoji)   -- | 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+    Ready                   Int User [Channel] [GuildUnavailable] T.Text (Maybe Shard) PartialApplication   | Resumed                 [T.Text]   | ChannelCreate           Channel   | ChannelUpdate           Channel@@ -52,13 +54,14 @@   | PresenceUpdate          PresenceInfo   | TypingStart             TypingInfo   | UserUpdate              User+  | InteractionCreate       Interaction   -- | VoiceStateUpdate   -- | VoiceServerUpdate   | UnknownEvent     T.Text Object   deriving (Show, Read, Eq)  data EventInternalParse =-    InternalReady                   Int User [Channel] [GuildUnavailable] T.Text+    InternalReady                   Int User [Channel] [GuildUnavailable] T.Text (Maybe Shard) PartialApplication   | InternalResumed                 [T.Text]   | InternalChannelCreate           Channel   | InternalChannelUpdate           Channel@@ -89,11 +92,20 @@   | InternalPresenceUpdate          PresenceInfo   | InternalTypingStart             TypingInfo   | InternalUserUpdate              User+  | InternalInteractionCreate       InternalInteraction   -- | InternalVoiceStateUpdate   -- | InternalVoiceServerUpdate   | InternalUnknownEvent     T.Text Object   deriving (Show, Read, Eq) +data PartialApplication = PartialApplication+  { partialApplicationID :: ApplicationId+  , partialApplicationFlags :: Int+  } deriving (Show, Eq, Read)++instance FromJSON PartialApplication where+  parseJSON = withObject "PartialApplication" (\v -> PartialApplication <$> v .: "id" <*> v .: "flags")+ data ReactionInfo = ReactionInfo   { reactionUserId    :: UserId   , reactionGuildId   :: Maybe GuildId@@ -169,6 +181,8 @@                                          <*> o .: "private_channels"                                          <*> o .: "guilds"                                          <*> o .: "session_id"+                                         <*> o .: "shard"+                                         <*> o .: "application"     "RESUMED"                   -> InternalResumed <$> o .: "_trace"     "CHANNEL_CREATE"            -> InternalChannelCreate             <$> reparse o     "CHANNEL_UPDATE"            -> InternalChannelUpdate             <$> reparse o@@ -202,10 +216,11 @@     "MESSAGE_REACTION_REMOVE"   -> InternalMessageReactionRemove <$> reparse o     "MESSAGE_REACTION_REMOVE_ALL" -> InternalMessageReactionRemoveAll <$> o .: "channel_id"                                                                       <*> o .: "message_id"-    "MESSAGE_REACTION_REMOVE_EMOJI"-> InternalMessageReactionRemoveEmoji <$> reparse o+    "MESSAGE_REACTION_REMOVE_EMOJI" -> InternalMessageReactionRemoveEmoji <$> reparse o     "PRESENCE_UPDATE"           -> InternalPresenceUpdate            <$> reparse o     "TYPING_START"              -> InternalTypingStart               <$> reparse o     "USER_UPDATE"               -> InternalUserUpdate                <$> reparse o  -- "VOICE_STATE_UPDATE"        -> InternalVoiceStateUpdate          <$> reparse o  -- "VOICE_SERVER_UPDATE"       -> InternalVoiceServerUpdate         <$> reparse o+    "INTERACTION_CREATE"        -> InternalInteractionCreate         <$> reparse o     _other_event                -> InternalUnknownEvent t            <$> reparse o

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}  -- | Types relating to Discord Guilds (servers) module Discord.Internal.Types.Guild where@@ -9,45 +10,28 @@ import qualified Data.Text as T  import Discord.Internal.Types.Prelude-import Discord.Internal.Types.Channel (Channel, Emoji)-import Discord.Internal.Types.User (User)+import Discord.Internal.Types.Channel (Channel)+import Discord.Internal.Types.User (User, GuildMember)+import Discord.Internal.Types.Components (Emoji) --- | Representation of a guild member.-data GuildMember = GuildMember-      { memberUser     :: User-      , memberNick     :: Maybe T.Text-      , memberRoles    :: [Snowflake]-      , memberJoinedAt :: UTCTime-      , memberDeaf     :: Bool-      , memberMute     :: Bool-      } deriving (Show, Read, Eq, Ord) -instance FromJSON GuildMember where-  parseJSON = withObject "GuildMember" $ \o ->-    GuildMember <$> o .:  "user"-                <*> o .:? "nick"-                <*> o .:  "roles"-                <*> o .:  "joined_at"-                <*> o .:  "deaf"-                <*> o .:  "mute" ---- https://discord.com/developers/docs/resources/guild#guild-object- -- | Guilds in Discord represent a collection of users and channels into an isolated --   "Server"+--+-- 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 Integer+      , guildPermissions         :: Maybe T.Text       , guildRegion              :: Maybe T.Text    -- ^ Guild voice region       , guildAfkId               :: Maybe ChannelId -- ^ Id of afk channel       , guildAfkTimeout          :: Integer         -- ^ Afk timeout in seconds-      , guildEmbedEnabled        :: Maybe Bool      -- ^ Id of embedded channel-      , guildEmbedChannel        :: Maybe ChannelId -- ^ Id of embedded channel+      , 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@@ -69,8 +53,8 @@           <*> o .:? "region"           <*> o .:? "afk_channel_id"           <*> o .:  "afk_timeout"-          <*> o .:? "embed_enabled"-          <*> o .:? "embed_channel_id"+          <*> o .:? "widget_enabled"+          <*> o .:? "widget_channel_id"           <*> o .:  "verification_level"           <*> o .:  "default_message_notifications"           <*> o .:  "explicit_content_filter"@@ -112,7 +96,7 @@       , partialGuildName        :: T.Text       , partialGuildIcon        :: Maybe T.Text       , partialGuildOwner       :: Bool-      , partialGuildPermissions :: Integer+      , partialGuildPermissions :: T.Text       } deriving (Show, Read, Eq, Ord)  instance FromJSON PartialGuild where@@ -135,7 +119,7 @@       , roleColor   :: ColorInteger              -- ^ Integer representation of color code       , roleHoist   :: Bool                      -- ^ If the role is pinned in the user listing       , rolePos     :: Integer                   -- ^ Position of this role-      , rolePerms   :: Integer                   -- ^ Permission bit set+      , rolePerms   :: T.Text                   -- ^ Permission bit set       , roleManaged :: Bool                      -- ^ Whether this role is managed by an integration       , roleMention :: Bool                      -- ^ Whether this role is mentionable     } deriving (Show, Read, Eq, Ord)@@ -261,17 +245,17 @@     IntegrationAccount <$> o .: "id" <*> o .: "name"  -- | Represents an image to be used in third party sites to link to a discord channel-data GuildEmbed = GuildEmbed-      { embedEnabled :: Bool      -- ^ Whether the embed is enabled-      , embedChannel :: ChannelId -- ^ The embed channel id+data GuildWidget = GuildWidget+      { widgetEnabled :: Bool      -- ^ Whether the widget is enabled+      , widgetChannelId :: ChannelId -- ^ The widget channel id       } deriving (Show, Read, Eq, Ord) -instance FromJSON GuildEmbed where-  parseJSON = withObject "GuildEmbed" $ \o ->-    GuildEmbed <$> o .: "enabled" <*> o .: "snowflake"+instance FromJSON GuildWidget where+  parseJSON = withObject "GuildWidget" $ \o ->+    GuildWidget <$> o .: "enabled" <*> o .: "channel_id" -instance ToJSON GuildEmbed where-  toJSON (GuildEmbed enabled snowflake) = object+instance ToJSON GuildWidget where+  toJSON (GuildWidget enabled snowflake) = object     [ "enabled"   .= enabled-    , "snowflake" .= snowflake+    , "channel_id" .= snowflake     ]

@@ -0,0 +1,614 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Discord.Internal.Types.Interactions+  ( Interaction (..),+    InteractionDataComponent (..),+    InteractionDataApplicationCommand (..),+    InteractionDataApplicationCommandOptions (..),+    InteractionDataApplicationCommandOptionSubcommandOrGroup (..),+    InteractionDataApplicationCommandOptionSubcommand (..),+    InteractionDataApplicationCommandOptionValue (..),+    ApplicationCommandInteractionDataValue (..),+    InternalInteraction (..),+    InteractionToken,+    InteractionType,+    InternalInteractionData (..),+    ResolvedData (..),+    InternalInteractionDataApplicationCommandOption (..),+    InteractionResponse (..),+    interactionResponseBasic,+    InteractionCallbackType (..),+    InteractionCallbackData (..),+    InteractionCallbackAutocomplete,+    InteractionCallbackMessages (..),+    interactionCallbackMessagesBasic,+    InteractionCallbackDataFlags (..),+    InteractionCallbackDataFlag (..),+  )+where++import Control.Applicative (Alternative ((<|>)))+import Data.Aeson+import Data.Aeson.Types (Parser)+import Data.Bits (Bits (shift, (.|.)))+import Data.Data (Data)+import Data.Maybe (fromJust, fromMaybe)+import Data.Scientific (Scientific)+import qualified Data.Text as T+import Discord.Internal.Types.ApplicationCommands+  (+    InternalApplicationCommandOptionChoice,+    ApplicationCommandOptionType (..),+    ApplicationCommandType (..),+  )+import Discord.Internal.Types.Channel (AllowedMentions, Attachment, Message)+import Discord.Internal.Types.Components (Component, ComponentType (..))+import Discord.Internal.Types.Embed (Embed)+import Discord.Internal.Types.Prelude (ApplicationId, ApplicationCommandId, ChannelId, GuildId, InteractionId, InteractionToken, InteractionType (..), Internals (..), MessageId, Snowflake, UserId, makeTable, toMaybeJSON)+import Discord.Internal.Types.User (GuildMember, User)++import Debug.Trace++data Interaction+  = InteractionComponent+      { interactionId :: InteractionId,+        interactionApplicationId :: ApplicationId,+        interactionDataComponent :: Maybe InteractionDataComponent, -- referenced as Data in API+        interactionGuildId :: Maybe GuildId,+        interactionChannelId :: Maybe ChannelId,+        interactionMember :: Maybe GuildMember,+        interactionUser :: Maybe User,+        interactionToken :: InteractionToken,+        interactionVersion :: Int,+        interactionMessage :: Message+      }+  | InteractionPing+      { interactionId :: InteractionId,+        interactionApplicationId :: ApplicationId,+        interactionToken :: InteractionToken,+        interactionVersion :: Int+      }+  | InteractionApplicationCommand+      { interactionId :: InteractionId,+        interactionApplicationId :: ApplicationId,+        interactionDataApplicationCommand :: Maybe InteractionDataApplicationCommand, -- referenced as Data in API+        interactionGuildId :: Maybe GuildId,+        interactionChannelId :: Maybe ChannelId,+        interactionMember :: Maybe GuildMember,+        interactionUser :: Maybe User,+        interactionToken :: InteractionToken,+        interactionVersion :: Int+      }+  | InteractionApplicationCommandAutocomplete+      { interactionId :: InteractionId,+        interactionApplicationId :: ApplicationId,+        interactionDataApplicationCommand :: Maybe InteractionDataApplicationCommand, -- referenced as Data in API+        interactionGuildId :: Maybe GuildId,+        interactionChannelId :: Maybe ChannelId,+        interactionMember :: Maybe GuildMember,+        interactionUser :: Maybe User,+        interactionToken :: InteractionToken,+        interactionVersion :: Int+      }+  | InteractionUnknown InternalInteraction+  deriving (Show, Read, Eq)++data InteractionDataComponent+  = InteractionDataComponentButton+      { -- | Component only, the unique id+        interactionDataComponentCustomId :: T.Text+      }+  | InteractionDataComponentSelectMenu+      { interactionDataComponentCustomId :: T.Text,+        interactionDataComponentValues :: [T.Text]+      }+  deriving (Show, Read, Eq)++data InteractionDataApplicationCommand+  = InteractionDataApplicationCommandUser+      { -- | id of the invoked command+        interactionDataApplicationCommandId :: ApplicationCommandId,+        -- | name of the invoked command+        interactionDataApplicationCommandName :: T.Text,+        -- | the resolved data in the command+        interactionDataApplicationCommandResolvedData :: Maybe ResolvedData,+        -- | the target of the command+        interactionDataApplicationCommandTargetId :: UserId+      }+  | InteractionDataApplicationCommandMessage+      { -- | Application command only, id of the invoked command+        interactionDataApplicationCommandId :: ApplicationCommandId,+        -- | Application command only, name of the invoked command+        interactionDataApplicationCommandName :: T.Text,+        interactionDataApplicationCommandResolvedData :: Maybe ResolvedData,+        interactionDataApplicationCommandTargetId :: MessageId+      }+  | InteractionDataApplicationCommandChatInput+      { -- | Application command only, id of the invoked command+        interactionDataApplicationCommandId :: ApplicationCommandId,+        -- | Application command only, name of the invoked command+        interactionDataApplicationCommandName :: T.Text,+        interactionDataApplicationCommandResolvedData :: Maybe ResolvedData,+        interactionDataApplicationCommandOptions :: Maybe InteractionDataApplicationCommandOptions+      }+  deriving (Show, Read, Eq)++data InteractionDataApplicationCommandOptions+  = InteractionDataApplicationCommandOptionsSubcommands [InteractionDataApplicationCommandOptionSubcommandOrGroup]+  | InteractionDataApplicationCommandOptionsValues [InteractionDataApplicationCommandOptionValue]+  deriving (Show, Read, Eq)++data InteractionDataApplicationCommandOptionSubcommandOrGroup+  = InteractionDataApplicationCommandOptionSubcommandGroup+      { interactionDataApplicationCommandOptionSubcommandGroupName :: T.Text,+        interactionDataApplicationCommandOptionSubcommandGroupOptions :: [InteractionDataApplicationCommandOptionSubcommand],+        interactionDataApplicationCommandOptionSubcommandGroupFocused :: Maybe Bool+      }+  | InteractionDataApplicationCommandOptionSubcommandOrGroupSubcommand InteractionDataApplicationCommandOptionSubcommand+  deriving (Show, Read, Eq)++data InteractionDataApplicationCommandOptionSubcommand = InteractionDataApplicationCommandOptionSubcommand+  { interactionDataApplicationCommandOptionSubcommandName :: T.Text,+    interactionDataApplicationCommandOptionSubcommandOptions :: [InteractionDataApplicationCommandOptionValue],+    interactionDataApplicationCommandOptionSubcommandFocused :: Maybe Bool+  }+  deriving (Show, Read, Eq)++data InteractionDataApplicationCommandOptionValue = InteractionDataApplicationCommandOptionValue+  { interactionDataApplicationCommandOptionValueName :: T.Text,+    interactionDataApplicationCommandOptionValueValue :: ApplicationCommandInteractionDataValue,+    interactionDataApplicationCommandOptionValueFocused :: Maybe Bool+  }+  deriving (Show, Read, Eq)++instance Internals InteractionDataApplicationCommandOptionValue InternalInteractionDataApplicationCommandOption where+  toInternal InteractionDataApplicationCommandOptionValue {..} = InternalInteractionDataApplicationCommandOption interactionDataApplicationCommandOptionValueName (getTypeFromACIDV interactionDataApplicationCommandOptionValueValue) (Just interactionDataApplicationCommandOptionValueValue) Nothing interactionDataApplicationCommandOptionValueFocused++  fromInternal InternalInteractionDataApplicationCommandOption {..}+    | internalInteractionDataApplicationCommandOptionType `elem` [ApplicationCommandOptionTypeSubcommand, ApplicationCommandOptionTypeSubcommandGroup] = Nothing+    | otherwise = do+      v <- trace ("this" ++ show internalInteractionDataApplicationCommandOptionValue) internalInteractionDataApplicationCommandOptionValue+      return $ InteractionDataApplicationCommandOptionValue internalInteractionDataApplicationCommandOptionName v internalInteractionDataApplicationCommandOptionFocused++instance Internals InteractionDataApplicationCommandOptionSubcommand InternalInteractionDataApplicationCommandOption where+  toInternal InteractionDataApplicationCommandOptionSubcommand {..} =+    InternalInteractionDataApplicationCommandOption interactionDataApplicationCommandOptionSubcommandName ApplicationCommandOptionTypeSubcommand Nothing (Just $ toInternal <$> interactionDataApplicationCommandOptionSubcommandOptions) interactionDataApplicationCommandOptionSubcommandFocused++  fromInternal InternalInteractionDataApplicationCommandOption {internalInteractionDataApplicationCommandOptionType = ApplicationCommandOptionTypeSubcommand, ..} = do+    o <- internalInteractionDataApplicationCommandOptionOptions+    o' <- mapM fromInternal o+    return $ InteractionDataApplicationCommandOptionSubcommand internalInteractionDataApplicationCommandOptionName o' internalInteractionDataApplicationCommandOptionFocused+  fromInternal _ = Nothing++instance Internals InteractionDataApplicationCommandOptionSubcommandOrGroup InternalInteractionDataApplicationCommandOption where+  toInternal InteractionDataApplicationCommandOptionSubcommandGroup {..} =+    InternalInteractionDataApplicationCommandOption interactionDataApplicationCommandOptionSubcommandGroupName ApplicationCommandOptionTypeSubcommand Nothing (Just $ toInternal <$> interactionDataApplicationCommandOptionSubcommandGroupOptions) interactionDataApplicationCommandOptionSubcommandGroupFocused+  toInternal (InteractionDataApplicationCommandOptionSubcommandOrGroupSubcommand s) = toInternal s++  fromInternal InternalInteractionDataApplicationCommandOption {internalInteractionDataApplicationCommandOptionType = ApplicationCommandOptionTypeSubcommandGroup, ..} = do+    o <- internalInteractionDataApplicationCommandOptionOptions+    o' <- mapM fromInternal o+    return $ InteractionDataApplicationCommandOptionSubcommandGroup internalInteractionDataApplicationCommandOptionName o' internalInteractionDataApplicationCommandOptionFocused+  fromInternal i@InternalInteractionDataApplicationCommandOption {internalInteractionDataApplicationCommandOptionType = ApplicationCommandOptionTypeSubcommand, ..} = InteractionDataApplicationCommandOptionSubcommandOrGroupSubcommand <$> fromInternal i+  fromInternal _ = Nothing++instance Internals InteractionDataApplicationCommandOptions [InternalInteractionDataApplicationCommandOption] where+  toInternal (InteractionDataApplicationCommandOptionsSubcommands lst) = toInternal <$> lst+  toInternal (InteractionDataApplicationCommandOptionsValues lst) = toInternal <$> lst++  fromInternal is = (InteractionDataApplicationCommandOptionsSubcommands <$> mapM fromInternal is) <|> (InteractionDataApplicationCommandOptionsValues <$> mapM fromInternal is)++instance Internals InteractionDataApplicationCommand InternalInteractionData where+  toInternal InteractionDataApplicationCommandUser {..} = InternalInteractionData (Just interactionDataApplicationCommandId) (Just interactionDataApplicationCommandName) (Just ApplicationCommandTypeUser) interactionDataApplicationCommandResolvedData Nothing Nothing Nothing Nothing Nothing+  toInternal InteractionDataApplicationCommandMessage {..} = InternalInteractionData (Just interactionDataApplicationCommandId) (Just interactionDataApplicationCommandName) (Just ApplicationCommandTypeMessage) interactionDataApplicationCommandResolvedData Nothing Nothing Nothing Nothing Nothing+  toInternal InteractionDataApplicationCommandChatInput {..} = InternalInteractionData (Just interactionDataApplicationCommandId) (Just interactionDataApplicationCommandName) (Just ApplicationCommandTypeMessage) interactionDataApplicationCommandResolvedData (toInternal <$> interactionDataApplicationCommandOptions) Nothing Nothing Nothing Nothing++  fromInternal InternalInteractionData {internalInteractionDataApplicationCommandType = Just ApplicationCommandTypeUser, ..} = do+    aid <- internalInteractionDataApplicationCommandId+    name <- internalInteractionDataApplicationCommandName+    tid <- internalInteractionDataTargetId+    return $ InteractionDataApplicationCommandUser aid name internalInteractionDataResolved tid+  fromInternal InternalInteractionData {internalInteractionDataApplicationCommandType = Just ApplicationCommandTypeMessage, ..} = do+    aid <- internalInteractionDataApplicationCommandId+    name <- internalInteractionDataApplicationCommandName+    tid <- internalInteractionDataTargetId+    return $ InteractionDataApplicationCommandMessage aid name internalInteractionDataResolved tid+  fromInternal InternalInteractionData {internalInteractionDataApplicationCommandType = Just ApplicationCommandTypeChatInput, ..} = do+    aid <- internalInteractionDataApplicationCommandId+    name <- internalInteractionDataApplicationCommandName+    return $ InteractionDataApplicationCommandChatInput aid name internalInteractionDataResolved (internalInteractionDataOptions >>= fromInternal)+  fromInternal _ = Nothing++instance Internals InteractionDataComponent InternalInteractionData where+  toInternal InteractionDataComponentButton {..} = InternalInteractionData Nothing Nothing Nothing Nothing Nothing (Just interactionDataComponentCustomId) (Just ComponentTypeButton) Nothing Nothing+  toInternal InteractionDataComponentSelectMenu {..} = InternalInteractionData Nothing Nothing Nothing Nothing Nothing (Just interactionDataComponentCustomId) (Just ComponentTypeSelectMenu) (Just interactionDataComponentValues) Nothing++  fromInternal InternalInteractionData {internalInteractionDataComponentType = Just ComponentTypeButton, ..} = InteractionDataComponentButton <$> internalInteractionDataCustomId+  fromInternal InternalInteractionData {internalInteractionDataComponentType = Just ComponentTypeSelectMenu, ..} = InteractionDataComponentSelectMenu <$> internalInteractionDataCustomId <*> internalInteractionDataValues+  fromInternal _ = Nothing++instance Internals Interaction InternalInteraction where+  toInternal InteractionPing {..} = InternalInteraction interactionId interactionApplicationId InteractionTypePing Nothing Nothing Nothing Nothing Nothing interactionToken interactionVersion Nothing+  toInternal InteractionComponent {..} = InternalInteraction interactionId interactionApplicationId InteractionTypeMessageComponent (toInternal <$> interactionDataComponent) interactionGuildId interactionChannelId interactionMember interactionUser interactionToken interactionVersion (Just interactionMessage)+  toInternal InteractionApplicationCommand {..} = InternalInteraction interactionId interactionApplicationId InteractionTypeApplicationCommand (toInternal <$> interactionDataApplicationCommand) interactionGuildId interactionChannelId interactionMember interactionUser interactionToken interactionVersion Nothing+  toInternal InteractionApplicationCommandAutocomplete {..} = InternalInteraction interactionId interactionApplicationId InteractionTypeApplicationCommandAutocomplete (toInternal <$> interactionDataApplicationCommand) interactionGuildId interactionChannelId interactionMember interactionUser interactionToken interactionVersion Nothing+  toInternal (InteractionUnknown i) = i++  fromInternal InternalInteraction {internalInteractionType = InteractionTypePing, ..} = Just $ InteractionPing internalInteractionId internalInteractionApplicationId internalInteractionToken internalInteractionVersion+  fromInternal i@InternalInteraction {internalInteractionType = InteractionTypeMessageComponent, ..} = Just $ fromMaybe (InteractionUnknown i) $ internalInteractionMessage >>= Just . InteractionComponent internalInteractionId internalInteractionApplicationId (internalInteractionData >>= fromInternal) internalInteractionGuildId internalInteractionChannelId internalInteractionMember internalInteractionUser internalInteractionToken internalInteractionVersion+  fromInternal i@InternalInteraction {internalInteractionType=InteractionTypeApplicationCommandAutocomplete,..} = Just $ fromMaybe (InteractionUnknown i) $ process internalInteractionData+    where process Nothing = Just $ InteractionApplicationCommandAutocomplete internalInteractionId internalInteractionApplicationId Nothing internalInteractionGuildId internalInteractionChannelId internalInteractionMember internalInteractionUser internalInteractionToken internalInteractionVersion+          process (Just d) = fromInternal d >>= \d' -> Just $ InteractionApplicationCommandAutocomplete internalInteractionId internalInteractionApplicationId (Just d') internalInteractionGuildId internalInteractionChannelId internalInteractionMember internalInteractionUser internalInteractionToken internalInteractionVersion+  fromInternal i@InternalInteraction {internalInteractionType=InteractionTypeApplicationCommand,..} = Just $ fromMaybe (InteractionUnknown i) $ process internalInteractionData+    where process Nothing = Just $ InteractionApplicationCommand internalInteractionId internalInteractionApplicationId Nothing internalInteractionGuildId internalInteractionChannelId internalInteractionMember internalInteractionUser internalInteractionToken internalInteractionVersion+          process (Just d) = fromInternal d >>= \d' -> Just $ InteractionApplicationCommand internalInteractionId internalInteractionApplicationId (Just d') internalInteractionGuildId internalInteractionChannelId internalInteractionMember internalInteractionUser internalInteractionToken internalInteractionVersion+    -- Just $ InteractionApplicationCommand internalInteractionId internalInteractionApplicationId (internalInteractionType == InteractionTypeApplicationCommandAutocomplete) (internalInteractionData >>= fromInternal) internalInteractionGuildId internalInteractionChannelId internalInteractionMember internalInteractionUser internalInteractionToken internalInteractionVersion++-- instance Internals Interaction InternalInteraction where++-- application command id+-- application command name+-- application command type -- this should be defined in the constructor!+-- resolved data -- this should be formalised and integrated, instead of being+--  left as values+-- options -- only present if type is subcommand or subcommand group++-- | This is the data that is recieved when an interaction occurs.+--+-- https://discord.com/developers/docs/interactions/receiving-and-responding#interaction-object-interaction-structure+data InternalInteraction = InternalInteraction+  { internalInteractionId :: InteractionId,+    internalInteractionApplicationId :: ApplicationId,+    internalInteractionType :: InteractionType, -- referenced as Type in API+    internalInteractionData :: Maybe InternalInteractionData, -- referenced as Data in API+    internalInteractionGuildId :: Maybe GuildId,+    internalInteractionChannelId :: Maybe ChannelId,+    internalInteractionMember :: Maybe GuildMember,+    internalInteractionUser :: Maybe User,+    internalInteractionToken :: InteractionToken,+    internalInteractionVersion :: Int,+    internalInteractionMessage :: Maybe Message+  }+  deriving (Show, Read, Eq)++instance ToJSON InternalInteraction where+  toJSON InternalInteraction {..} =+    object+      [ (name, value)+        | (name, Just value) <-+            [ ("id", toMaybeJSON internalInteractionId),+              ("application_id", toMaybeJSON internalInteractionApplicationId),+              ("type", toMaybeJSON internalInteractionType),+              ("data", toJSON <$> internalInteractionData),+              ("guild_id", toJSON <$> internalInteractionGuildId),+              ("channel_id", toJSON <$> internalInteractionChannelId),+              ("member", toJSON <$> internalInteractionMember),+              ("user", toJSON <$> internalInteractionUser),+              ("token", toMaybeJSON internalInteractionToken),+              ("version", toMaybeJSON internalInteractionVersion),+              ("message", toJSON <$> internalInteractionMessage)+            ]+      ]++instance FromJSON InternalInteraction where+  parseJSON =+    withObject+      "InternalInteraction"+      ( \v ->+          InternalInteraction+            <$> v .: "id"+            <*> v .: "application_id"+            <*> v .: "type"+            <*> v .:? "data"+            <*> v .:? "guild_id"+            <*> v .:? "channel_id"+            <*> v .:? "member"+            <*> v .:? "user"+            <*> v .: "token"+            <*> v .: "version"+            <*> v .:? "message"+      )++-- | This is received if the interaction was a component or application command.+--+-- https://discord.com/developers/docs/interactions/receiving-and-responding#interaction-object-interaction-data-structure+data InternalInteractionData = InternalInteractionData+  { -- | Application command only, id of the invoked command+    internalInteractionDataApplicationCommandId :: Maybe ApplicationCommandId,+    -- | Application command only, name of the invoked command+    internalInteractionDataApplicationCommandName :: Maybe T.Text,+    -- | Application command only, the type of the invoked command+    internalInteractionDataApplicationCommandType :: Maybe ApplicationCommandType,+    -- | Application command only, converted users, roles, channels+    internalInteractionDataResolved :: Maybe ResolvedData,+    -- | Application command only, params and values+    internalInteractionDataOptions :: Maybe [InternalInteractionDataApplicationCommandOption],+    -- | Component only, the unique id+    internalInteractionDataCustomId :: Maybe T.Text,+    -- | Component only, the type of the component+    internalInteractionDataComponentType :: Maybe ComponentType,+    -- | Component only, the selected options if component is the select type+    internalInteractionDataValues :: Maybe [T.Text],+    -- | This is the id of the user or message being targetted by a user command+    -- or a message command+    internalInteractionDataTargetId :: Maybe Snowflake+  }+  deriving (Show, Read, Eq)++instance ToJSON InternalInteractionData where+  toJSON InternalInteractionData {..} =+    object+      [ (name, value)+        | (name, Just value) <-+            [ ("id", toJSON <$> internalInteractionDataApplicationCommandId),+              ("name", toJSON <$> internalInteractionDataApplicationCommandName),+              ("type", toJSON <$> internalInteractionDataApplicationCommandType),+              ("resolved", toJSON <$> internalInteractionDataResolved),+              ("options", toJSON <$> internalInteractionDataOptions),+              ("custom_id", toJSON <$> internalInteractionDataCustomId),+              ("component_type", toJSON <$> internalInteractionDataComponentType),+              ("values", toJSON <$> internalInteractionDataValues),+              ("target_id", toJSON <$> internalInteractionDataTargetId)+            ]+      ]++instance FromJSON InternalInteractionData where+  parseJSON =+    withObject+      "InternalInteractionData"+      ( \v ->+          InternalInteractionData+            <$> v .:? "id"+            <*> v .:? "name"+            <*> v .:? "type"+            <*> v .:? "resolved"+            <*> v .:? "options"+            <*> v .:? "custom_id"+            <*> v .:? "component_type"+            <*> v .:? "values"+            <*> v .:? "target_id"+      )++-- | I'm not sure what this stuff is, so you're on your own.+--+-- It's not worth the time working out how to create this stuff.+-- If you need to extract from these values, check out the link below.+--+-- https://discord.com/developers/docs/interactions/receiving-and-responding#interaction-object-resolved-data-structure+data ResolvedData = ResolvedData+  { resolvedDataUsers :: Maybe Value,+    resolvedDataMembers :: Maybe Value,+    resolvedDataRoles :: Maybe Value,+    resolvedDataChannels :: Maybe Value+  }+  deriving (Show, Read, Eq)++instance ToJSON ResolvedData where+  toJSON ResolvedData {..} =+    object+      [ (name, value)+        | (name, Just value) <-+            [ ("users", resolvedDataUsers),+              ("members", resolvedDataMembers),+              ("roles", resolvedDataRoles),+              ("channels", resolvedDataChannels)+            ]+      ]++instance FromJSON ResolvedData where+  parseJSON =+    withObject+      "ResolvedData"+      ( \v ->+          ResolvedData+            <$> v .:? "users"+            <*> v .:? "members"+            <*> v .:? "roles"+            <*> v .:? "channels"+      )++-- | The application command payload for an interaction.+data InternalInteractionDataApplicationCommandOption = InternalInteractionDataApplicationCommandOption+  { internalInteractionDataApplicationCommandOptionName :: T.Text,+    internalInteractionDataApplicationCommandOptionType :: ApplicationCommandOptionType,+    -- | The value itself. Mutually exclusive with options. Docs are wrong that it's only numbers and strings.+    internalInteractionDataApplicationCommandOptionValue :: Maybe ApplicationCommandInteractionDataValue,+    -- | Only present in group subcommands and subcommands. Mutually exclusive with value.+    internalInteractionDataApplicationCommandOptionOptions :: Maybe [InternalInteractionDataApplicationCommandOption],+    -- | Whether this is the field that the user is currently typing in.+    internalInteractionDataApplicationCommandOptionFocused :: Maybe Bool+  }+  deriving (Show, Read, Eq)++instance ToJSON InternalInteractionDataApplicationCommandOption where+  toJSON InternalInteractionDataApplicationCommandOption {..} =+    object+      [ (name, value)+        | (name, Just value) <-+            [ ("name", toMaybeJSON internalInteractionDataApplicationCommandOptionName),+              ("type", toMaybeJSON internalInteractionDataApplicationCommandOptionType),+              ("value", toJSON <$> internalInteractionDataApplicationCommandOptionValue),+              ("options", toJSON <$> internalInteractionDataApplicationCommandOptionOptions),+              ("focused", toJSON <$> internalInteractionDataApplicationCommandOptionFocused)+            ]+      ]++instance FromJSON InternalInteractionDataApplicationCommandOption where+  parseJSON =+    withObject+      "InternalInteractionDataApplicationCommandOption"+      ( \v ->+          InternalInteractionDataApplicationCommandOption+            <$> v .: "name"+            <*> typeParser v+            <*> (typeParser v >>= \t -> v .:? "value" >>= valueParser t)+            <*> v .:? "options"+            <*> v .:? "focused"+      )+    where+      typeParser v = v .: "type"+      valueParser t (Just v) = parseJSONACIDV t v+      valueParser _ Nothing = return Nothing++-- | The data to respond to an interaction with. Unless specified otherwise, you+-- only have three seconds to reply to an interaction before a failure state is+-- given.+data InteractionResponse = InteractionResponse+  { interactionResponseType :: InteractionCallbackType,+    interactionResponseData :: Maybe InteractionCallbackData+  }+  deriving (Show, Read, Eq)++interactionResponseBasic :: T.Text -> InteractionResponse+interactionResponseBasic t = InteractionResponse InteractionCallbackTypeChannelMessageWithSource (Just . InteractionCallbackDataMessages $ interactionCallbackMessagesBasic t)++instance ToJSON InteractionResponse where+  toJSON InteractionResponse {..} =+    object+      [ (name, value)+        | (name, Just value) <-+            [ ("type", toMaybeJSON interactionResponseType),+              ("data", toJSON <$> interactionResponseData)+            ]+      ]++-- | What's the type of the response?+data InteractionCallbackType+  = -- | Responds to a PING.+    InteractionCallbackTypePong+  | -- | Respond with a message to the interaction+    InteractionCallbackTypeChannelMessageWithSource+  | -- | Respond with a message to the interaction, after a delay. Sending this+    -- back means the interaction token lasts for 15 minutes.+    InteractionCallbackTypeDeferredChannelMessageWithSource+  | -- | For components, edit the original message later.+    InteractionCallbackTypeDeferredUpdateMessage+  | -- | For components, edit the original message.+    InteractionCallbackTypeUpdateMessage+  | -- | Respond to an autocomplete interaction with suggested choices.+    InteractionCallbackTypeApplicationCommandAutocompleteResult+  deriving (Show, Read, Eq, Data)++instance Enum InteractionCallbackType where+  fromEnum InteractionCallbackTypePong = 1+  fromEnum InteractionCallbackTypeChannelMessageWithSource = 4+  fromEnum InteractionCallbackTypeDeferredChannelMessageWithSource = 5+  fromEnum InteractionCallbackTypeDeferredUpdateMessage = 6+  fromEnum InteractionCallbackTypeUpdateMessage = 7+  fromEnum InteractionCallbackTypeApplicationCommandAutocompleteResult = 8+  toEnum a = fromJust $ lookup a table+    where+      table = makeTable InteractionCallbackTypePong++instance ToJSON InteractionCallbackType where+  toJSON = toJSON . fromEnum++-- | Convenience wrapper for two separate types of callback.+data InteractionCallbackData+  = InteractionCallbackDataMessages InteractionCallbackMessages+  | InteractionCallbackDataAutocomplete InteractionCallbackAutocomplete+  deriving (Show, Read, Eq)++instance ToJSON InteractionCallbackData where+  toJSON (InteractionCallbackDataMessages icdm) = toJSON icdm+  toJSON (InteractionCallbackDataAutocomplete icda) = toJSON icda++type InteractionCallbackAutocomplete = [InternalApplicationCommandOptionChoice]++-- | A cut down message structure.+data InteractionCallbackMessages = InteractionCallbackMessages+  { interactionCallbackMessagesTTS :: Maybe Bool,+    interactionCallbackMessagesContent :: Maybe T.Text,+    interactionCallbackMessagesEmbeds :: Maybe [Embed],+    interactionCallbackMessagesAllowedMentions :: Maybe AllowedMentions,+    interactionCallbackMessagesFlags :: Maybe InteractionCallbackDataFlags,+    interactionCallbackMessagesComponents :: Maybe [Component],+    interactionCallbackMessagesAttachments :: Maybe [Attachment]+  }+  deriving (Show, Read, Eq)++interactionCallbackMessagesBasic :: T.Text -> InteractionCallbackMessages+interactionCallbackMessagesBasic t = InteractionCallbackMessages Nothing (Just t) Nothing Nothing Nothing Nothing Nothing++instance ToJSON InteractionCallbackMessages where+  toJSON InteractionCallbackMessages {..} =+    object+      [ (name, value)+        | (name, Just value) <-+            [ ("tts", toJSON <$> interactionCallbackMessagesTTS),+              ("content", toJSON <$> interactionCallbackMessagesContent),+              ("embeds", toJSON <$> interactionCallbackMessagesEmbeds),+              ("allowed_mentions", toJSON <$> interactionCallbackMessagesAllowedMentions),+              ("flags", toJSON <$> interactionCallbackMessagesFlags),+              ("components", toJSON <$> interactionCallbackMessagesComponents),+              ("attachments", toJSON <$> interactionCallbackMessagesAttachments)+            ]+      ]++-- | Types of flags to attach to the interaction message.+--+-- Currently the only flag is EPHERMERAL, which means only the user can see the+-- message.+data InteractionCallbackDataFlag = InteractionCallbackDataFlagEphermeral+  deriving (Show, Read, Eq)++newtype InteractionCallbackDataFlags = InteractionCallbackDataFlags [InteractionCallbackDataFlag]+  deriving (Show, Read, Eq)++instance Enum InteractionCallbackDataFlag where+  fromEnum InteractionCallbackDataFlagEphermeral = 1 `shift` 6+  toEnum i+    | i == 1 `shift` 6 = InteractionCallbackDataFlagEphermeral+    | otherwise = error $ "could not find InteractionCallbackDataFlag `" ++ show i ++ "`"++instance ToJSON InteractionCallbackDataFlags where+  toJSON (InteractionCallbackDataFlags fs) = Number $ fromInteger $ fromIntegral $ foldr (.|.) 0 (fromEnum <$> fs)++data ApplicationCommandInteractionDataValue+  = ApplicationCommandInteractionDataValueString T.Text+  | ApplicationCommandInteractionDataValueInteger Integer+  | ApplicationCommandInteractionDataValueBoolean Bool+  | ApplicationCommandInteractionDataValueUser Snowflake+  | ApplicationCommandInteractionDataValueChannel Snowflake+  | ApplicationCommandInteractionDataValueRole Snowflake+  | ApplicationCommandInteractionDataValueMentionable Snowflake+  | ApplicationCommandInteractionDataValueNumber Scientific+  deriving (Show, Eq, Ord, Read)++getTypeFromACIDV :: ApplicationCommandInteractionDataValue -> ApplicationCommandOptionType+getTypeFromACIDV acidv = case acidv of+  ApplicationCommandInteractionDataValueString _ -> ApplicationCommandOptionTypeString+  ApplicationCommandInteractionDataValueInteger _ -> ApplicationCommandOptionTypeInteger+  ApplicationCommandInteractionDataValueBoolean _ -> ApplicationCommandOptionTypeBoolean+  ApplicationCommandInteractionDataValueUser _ -> ApplicationCommandOptionTypeUser+  ApplicationCommandInteractionDataValueChannel _ -> ApplicationCommandOptionTypeChannel+  ApplicationCommandInteractionDataValueRole _ -> ApplicationCommandOptionTypeRole+  ApplicationCommandInteractionDataValueMentionable _ -> ApplicationCommandOptionTypeMentionable+  ApplicationCommandInteractionDataValueNumber _ -> ApplicationCommandOptionTypeNumber++instance ToJSON ApplicationCommandInteractionDataValue where+  toJSON (ApplicationCommandInteractionDataValueString t) = String t+  toJSON (ApplicationCommandInteractionDataValueNumber t) = Number t+  toJSON (ApplicationCommandInteractionDataValueInteger t) = Number $ fromInteger t+  toJSON (ApplicationCommandInteractionDataValueBoolean t) = Bool t+  toJSON (ApplicationCommandInteractionDataValueUser t) = toJSON t+  toJSON (ApplicationCommandInteractionDataValueChannel t) = toJSON t+  toJSON (ApplicationCommandInteractionDataValueRole t) = toJSON t+  toJSON (ApplicationCommandInteractionDataValueMentionable t) = toJSON t++parseJSONACIDV :: ApplicationCommandOptionType -> Value -> Parser (Maybe ApplicationCommandInteractionDataValue)+parseJSONACIDV ApplicationCommandOptionTypeString (String t) = return $ return (ApplicationCommandInteractionDataValueString t)+parseJSONACIDV ApplicationCommandOptionTypeInteger n = Just . ApplicationCommandInteractionDataValueInteger <$> parseJSON n+parseJSONACIDV ApplicationCommandOptionTypeNumber (Number t) = return $ return (ApplicationCommandInteractionDataValueNumber t)+parseJSONACIDV ApplicationCommandOptionTypeBoolean (Bool t) = return $ return (ApplicationCommandInteractionDataValueBoolean t)+parseJSONACIDV ApplicationCommandOptionTypeUser t = Just . ApplicationCommandInteractionDataValueUser <$> parseJSON t+parseJSONACIDV ApplicationCommandOptionTypeChannel t = Just . ApplicationCommandInteractionDataValueChannel <$> parseJSON t+parseJSONACIDV ApplicationCommandOptionTypeRole t = Just . ApplicationCommandInteractionDataValueRole <$> parseJSON t+parseJSONACIDV ApplicationCommandOptionTypeMentionable t = Just . ApplicationCommandInteractionDataValueMentionable <$> parseJSON t+parseJSONACIDV t v = fail $ "could not parse type " ++ show t ++ " from " ++ show v

@@ -1,5 +1,8 @@+{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE FlexibleInstances  #-}  -- | Provides base types and utility functions needed for modules in Discord.Internal.Types module Discord.Internal.Types.Prelude where@@ -15,6 +18,9 @@  import Data.Functor.Compose (Compose(Compose, getCompose)) import Data.Bifunctor (first)+import Text.Read (readMaybe)+import Data.Data (Data (dataTypeOf), dataTypeConstrs, fromConstr)+import Data.Maybe (fromJust)  -- | Authorization token for the Discord API data Auth = Auth T.Text@@ -41,20 +47,29 @@   toJSON (Snowflake snowflake) = String . T.pack $ show snowflake  instance FromJSON Snowflake where-  parseJSON (String snowflake) = pure . read $ T.unpack snowflake+  parseJSON (String snowflake) = case readMaybe (T.unpack snowflake) of+    Nothing -> fail "null snowflake"+    (Just i) -> pure i   parseJSON _ = mzero  type ChannelId = Snowflake type StageId = Snowflake type GuildId = Snowflake type MessageId = Snowflake+type AttachmentId = Snowflake type EmojiId = Snowflake+type StickerId = Snowflake type UserId = Snowflake type OverwriteId = Snowflake type RoleId = Snowflake type IntegrationId = Snowflake type WebhookId = Snowflake type ParentId = Snowflake+type ApplicationId = Snowflake +type ApplicationCommandId = Snowflake+type InteractionId = Snowflake+type InteractionToken = T.Text+type Shard = (Int, Int)  -- | Gets a creation date from a snowflake. snowflakeCreationDate :: Snowflake -> UTCTime@@ -66,3 +81,41 @@ epochTime = posixSecondsToUTCTime 0  type ColorInteger = Integer++makeTable :: (Data t, Enum t) => t -> [(Int, t)]+makeTable t = map (\cData -> let c = fromConstr cData in (fromEnum c, c)) (dataTypeConstrs $ dataTypeOf t)++toMaybeJSON :: (ToJSON a) => a -> Maybe Value+toMaybeJSON = return . toJSON++-- | What type of interaction has a user requested? Each requires its own type+-- of response.+data InteractionType+  = InteractionTypePing+  | InteractionTypeApplicationCommand+  | InteractionTypeMessageComponent+  | InteractionTypeApplicationCommandAutocomplete+  deriving (Show, Read, Data, Eq, Ord)++instance Enum InteractionType where+  fromEnum InteractionTypePing = 1+  fromEnum InteractionTypeApplicationCommand = 2+  fromEnum InteractionTypeMessageComponent = 3+  fromEnum InteractionTypeApplicationCommandAutocomplete = 4+  toEnum a = fromJust $ lookup a table+    where+      table = makeTable InteractionTypePing++instance ToJSON InteractionType where+  toJSON = toJSON . fromEnum++instance FromJSON InteractionType where+  parseJSON = withScientific "InteractionType" (return . toEnum . round)++class Internals a b where+  toInternal :: a -> b+  fromInternal :: b -> Maybe a++instance Internals a a where+  toInternal = id+  fromInternal = Just

@@ -8,55 +8,79 @@ import Data.Text (Text) import qualified Data.Text as T import Discord.Internal.Types.Prelude+import Data.Time (UTCTime)  -- | Represents information about a user. data User = User-  { userId       :: UserId       -- ^ The user's id.-  , userName     :: T.Text       -- ^ The user's username (not unique)-  , userDiscrim  :: T.Text       -- ^ The user's 4-digit discord-tag.-  , userAvatar   :: Maybe T.Text -- ^ The user's avatar hash.-  , userIsBot    :: Bool         -- ^ User is an OAuth2 application.-  , userIsWebhook:: Bool         -- ^ User is a webhook-  , userMfa      :: Maybe Bool   -- ^ User has two factor authentication enabled on the account.-  , userVerified :: Maybe Bool   -- ^ Whether the email has been verified.-  , userEmail    :: Maybe T.Text -- ^ The user's email.+  { userId          :: UserId             -- ^ The user's id.+  , userName        :: T.Text             -- ^ The user's username (not unique)+  , userDiscrim     :: Maybe T.Text       -- ^ The user's 4-digit discord-tag.+  , userAvatar      :: Maybe T.Text       -- ^ The user's avatar hash.+  , userIsBot       :: Bool               -- ^ User is an OAuth2 application.+  , userIsWebhook   :: Bool               -- ^ User is a webhook.+  , userIsSystem    :: Maybe Bool         -- ^ User is an official discord system user.+  , userMfa         :: Maybe Bool         -- ^ User has two factor authentication enabled on the account.+  , userBanner      :: Maybe T.Text       -- ^ User's banner hash+  , userAccentColor :: Maybe Int          -- ^ User's banner color+  , userLocale      :: Maybe T.Text       -- ^ User's chosen language+  , userVerified    :: Maybe Bool         -- ^ Whether the email has been verified.+  , userEmail       :: Maybe T.Text       -- ^ The user's email.+  , userFlags       :: Maybe Integer      -- ^ The user's flags.+  , userPremiumType :: Maybe Integer      -- ^ The user's premium type.+  , userPublicFlags :: Maybe Integer      -- ^ The user's public flags.+  , userMember      :: Maybe GuildMember  -- ^ Some guild member info (message create/update)   } deriving (Show, Read, Eq, Ord)  instance FromJSON User where   parseJSON = withObject "User" $ \o ->     User <$> o .:  "id"          <*> o .:  "username"-         <*> o .:  "discriminator"+         <*> o .:? "discriminator" -- possibly not there in the case of webhooks          <*> o .:? "avatar"          <*> o .:? "bot" .!= False          <*> pure False -- webhook+         <*> o .:? "system"          <*> o .:? "mfa_enabled"+         <*> o .:? "banner"+         <*> o .:? "accent_color"+         <*> o .:? "locale"          <*> o .:? "verified"          <*> o .:? "email"+         <*> o .:? "flags"+         <*> o .:? "premium_type"+         <*> o .:? "public_flags"+         <*> o .:? "member"  instance ToJSON User where   toJSON User{..} = object [(name,value) | (name, Just value) <-               [ ("id",            toJSON <$> pure userId)               , ("username",      toJSON <$> pure userName)-              , ("discriminator", toJSON <$> pure userDiscrim)+              , ("discriminator", toJSON <$>      userDiscrim)               , ("avatar",        toJSON <$>      userAvatar)               , ("bot",           toJSON <$> pure userIsBot)-              , ("webhook",       toJSON <$> pure userIsWebhook)+              , ("system",        toJSON <$>      userIsSystem)               , ("mfa_enabled",   toJSON <$>      userMfa)+              , ("banner",        toJSON <$>      userBanner)+              , ("accent_color",  toJSON <$>      userAccentColor)               , ("verified",      toJSON <$>      userVerified)               , ("email",         toJSON <$>      userEmail)+              , ("flags",         toJSON <$>      userFlags)+              , ("premium_type",  toJSON <$>      userPremiumType)+              , ("public_flags",  toJSON <$>      userPublicFlags)+              , ("member",        toJSON <$>      userPublicFlags)               ] ] +-- TODO: fully update webhook structure data Webhook = Webhook   { webhookId :: WebhookId-  , webhookToken :: Text+  , webhookToken :: Maybe Text   , webhookChannelId :: ChannelId   } deriving (Show, Read, Eq, Ord)  instance FromJSON Webhook where   parseJSON = withObject "Webhook" $ \o ->     Webhook <$> o .:  "id"-            <*> o .:  "token"+            <*> o .:? "token"             <*> o .:  "channel_id"  data ConnectionObject = ConnectionObject@@ -83,3 +107,45 @@                <*> o .: "friend_sync"                <*> o .: "show_activity"                <*> ( (==) (1::Int) <$> o .: "visibility")+++-- | Representation of a guild member.+data GuildMember = GuildMember+      { memberUser     :: Maybe User -- ^ User object - not included in message_create or update+      , memberNick     :: Maybe T.Text -- ^ User's guild nickname+      , memberAvatar   :: Maybe T.Text -- ^ User's guild avatar hash+      , memberRoles    :: [RoleId] -- ^ Array of role ids+      , memberJoinedAt :: UTCTime -- ^ When the user joined the guild+      , memberPremiumSince :: Maybe UTCTime -- ^ When the user started boosting the guild+      , memberDeaf     :: Bool -- ^ Whether the user is deafened+      , memberMute     :: Bool -- ^ Whether the user is muted+      , memberPending     :: Bool -- ^ Whether the user has passed the guild's membership screening+      , memberPermissions     :: Maybe T.Text -- ^ total permissions of the member+      } deriving (Show, Read, Eq, Ord)++instance FromJSON GuildMember where+  parseJSON = withObject "GuildMember" $ \o ->+    GuildMember <$> o .:? "user"+                <*> o .:? "nick"+                <*> o .:? "avatar"+                <*> o .:  "roles"+                <*> o .:  "joined_at"+                <*> o .:? "premium_since"+                <*> o .:  "deaf"+                <*> o .:  "mute"+                <*> o .:? "pending" .!= False+                <*> o .:? "permissions"++instance ToJSON GuildMember where+  toJSON GuildMember {..} = object [(name, value) | (name, Just value) <-+      [ ("user",      toJSON <$>      memberUser)+      , ("nick",      toJSON <$>      memberNick)+      , ("avatar",    toJSON <$>      memberAvatar)+      , ("roles",     toJSON <$> pure memberRoles)+      , ("joined_at", toJSON <$> pure memberJoinedAt)+      , ("premium_since",    toJSON <$>      memberPremiumSince)+      , ("deaf",      toJSON <$> pure memberDeaf)+      , ("mute",      toJSON <$> pure memberMute)+      , ("pending",      toJSON <$> pure memberPending)+      , ("permissions",    toJSON <$>      memberPermissions)+      ] ]

@@ -6,6 +6,8 @@   , module Discord.Internal.Rest.User   , module Discord.Internal.Rest.Voice   , module Discord.Internal.Rest.Webhook+  , module Discord.Internal.Rest.ApplicationCommands+  , module Discord.Internal.Rest.Interactions   ) where  import Discord.Internal.Rest.Channel@@ -15,3 +17,5 @@ import Discord.Internal.Rest.User import Discord.Internal.Rest.Voice import Discord.Internal.Rest.Webhook+import Discord.Internal.Rest.ApplicationCommands+import Discord.Internal.Rest.Interactions