10 files changed, 946 insertions, 0 deletions
diff --git a/deps/discord-haskell/examples/ExampleUtils.hs b/deps/discord-haskell/examples/ExampleUtils.hs
new file mode 100644
index 0000000..517178b
--- /dev/null
+++ b/deps/discord-haskell/examples/ExampleUtils.hs
@@ -0,0 +1,29 @@
+module ExampleUtils where
+
+import qualified Data.Text as T
+import qualified Data.Text.IO as TIO
+import Discord
+import qualified Discord.Requests as R
+import Discord.Types
+import Text.Read (readMaybe)
+
+getToken :: IO T.Text
+getToken = TIO.readFile "./examples/auth-token.secret"
+
+getGuildId :: IO GuildId
+getGuildId = do
+  gids <- readFile "./examples/guildid.secret"
+  case readMaybe gids of
+    Just g -> pure g
+    Nothing -> error "could not read guild id from `guildid.secret`"
+
+-- | Given the test server and an action operating on a channel id, get the
+-- first text channel of that server and use the action on that channel.
+actionWithChannelId :: GuildId -> (ChannelId -> DiscordHandler a) -> DiscordHandler a
+actionWithChannelId testserverid f = do
+  Right chans <- restCall $ R.GetGuildChannels testserverid
+  (f . channelId) (head (filter isTextChannel chans))
+  where
+    isTextChannel :: Channel -> Bool
+    isTextChannel ChannelText {} = True
+    isTextChannel _ = False
diff --git a/deps/discord-haskell/examples/cache.hs b/deps/discord-haskell/examples/cache.hs
new file mode 100644
index 0000000..2e26f53
--- /dev/null
+++ b/deps/discord-haskell/examples/cache.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+import UnliftIO (liftIO)
+
+import Discord
+
+import ExampleUtils (getToken)
+
+main :: IO ()
+main = cacheExample
+
+-- There's not much information in the Cache for now
+--   but this program will show you what its got
+
+-- | Print cached Gateway info
+cacheExample :: IO ()
+cacheExample = do
+  tok <- getToken
+
+  _ <- runDiscord $ def { discordToken = tok
+                        , discordOnStart = do
+                               cache <- readCache
+                               liftIO $ putStrLn ("Cached info from gateway: " <> show cache)
+                               stopDiscord
+                        }
+  pure ()
+
diff --git a/deps/discord-haskell/examples/embed-photo.jpg b/deps/discord-haskell/examples/embed-photo.jpg
new file mode 100644
index 0000000..99d7199
--- /dev/null
+++ b/deps/discord-haskell/examples/embed-photo.jpg
diff --git a/deps/discord-haskell/examples/example-setup b/deps/discord-haskell/examples/example-setup
new file mode 100644
index 0000000..51458cc
--- /dev/null
+++ b/deps/discord-haskell/examples/example-setup
@@ -0,0 +1,7 @@
+create a file named auth-token.secret and add your token (not the secret id) from
+https://discord.com/developers/applications/me
+
+This is the Bot token (NOT CLIENT SECRET) from developer portal under the settings tab
+
+create a file named guildid.secret and add the guild id (server id) of your test server there.
+your bot may need certain permissions to run specific examples, like the interaction-commands example.
diff --git a/deps/discord-haskell/examples/gateway.hs b/deps/discord-haskell/examples/gateway.hs
new file mode 100644
index 0000000..57e2e75
--- /dev/null
+++ b/deps/discord-haskell/examples/gateway.hs
@@ -0,0 +1,53 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+import Control.Monad (forever)
+import Control.Concurrent (forkIO, killThread)
+import UnliftIO (liftIO)
+import Control.Concurrent.Chan
+import qualified Data.Text.IO as TIO
+
+import Discord
+import Discord.Types
+
+import ExampleUtils (getToken, getGuildId)
+
+main :: IO ()
+main = gatewayExample
+
+-- | Prints every event as it happens
+gatewayExample :: IO ()
+gatewayExample = do
+  tok <- getToken
+  testserverid <- getGuildId
+
+  outChan <- newChan :: IO (Chan String)
+
+  -- Events are processed in new threads, but stdout isn't
+  -- synchronized. We get ugly output when multiple threads
+  -- write to stdout at the same time
+  threadId <- forkIO $ forever $ readChan outChan >>= putStrLn
+
+  err <- runDiscord $ def { discordToken = tok
+                          , discordOnStart = startHandler testserverid
+                          , discordOnEvent = eventHandler outChan
+                          , discordOnEnd = killThread threadId
+                          }
+  TIO.putStrLn err
+
+-- Events are enumerated in the discord docs
+-- https://discord.com/developers/docs/topics/gateway#commands-and-events-gateway-events
+eventHandler :: Chan String -> Event -> DiscordHandler ()
+eventHandler out event = liftIO $ writeChan out (show event <> "\n")
+
+
+startHandler :: GuildId -> DiscordHandler ()
+startHandler testserverid = do
+  let opts = RequestGuildMembersOpts
+        { requestGuildMembersOptsGuildId = testserverid
+        , requestGuildMembersOptsLimit = 100
+        , requestGuildMembersOptsNamesStartingWith = ""
+        }
+
+  -- gateway commands are enumerated in the discord docs
+  -- https://discord.com/developers/docs/topics/gateway#commands-and-events-gateway-commands
+  sendCommand (RequestGuildMembers opts)
diff --git a/deps/discord-haskell/examples/interaction-commands-simple.hs b/deps/discord-haskell/examples/interaction-commands-simple.hs
new file mode 100644
index 0000000..bf46321
--- /dev/null
+++ b/deps/discord-haskell/examples/interaction-commands-simple.hs
@@ -0,0 +1,125 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+import Discord
+import Discord.Types
+import Discord.Interactions
+import UnliftIO (liftIO)
+import Data.List (find)
+import Control.Monad (forM_)
+import ExampleUtils (getToken, getGuildId)
+import Data.Text (Text)
+import Control.Monad (void)
+import Control.Monad.IO.Class (MonadIO)
+import qualified Discord.Requests as R
+import qualified Data.Text as T
+import qualified Data.Text.IO as TIO
+
+
+-- MAIN
+
+main :: IO ()
+main = do
+  tok <- getToken
+  testGuildId <- getGuildId
+
+  botTerminationError <- runDiscord $ def
+    { discordToken = tok
+    , discordOnEvent = onDiscordEvent testGuildId
+    -- If you are using application commands, you might not need
+    -- message contents at all
+    , discordGatewayIntent = def { gatewayIntentMessageContent = False }
+    }
+
+  echo $ "A fatal error occurred: " <> botTerminationError
+
+
+-- UTILS
+
+echo :: MonadIO m => Text -> m ()
+echo = liftIO . TIO.putStrLn
+
+showT :: Show a => a -> Text
+showT = T.pack . show
+
+
+-- COMMANDS
+
+data SlashCommand = SlashCommand
+  { name :: Text
+  , registration :: Maybe CreateApplicationCommand
+  , handler :: Interaction -> Maybe OptionsData -> DiscordHandler ()
+  }
+
+mySlashCommands :: [SlashCommand]
+mySlashCommands = [ping]
+
+ping :: SlashCommand
+ping = SlashCommand
+  { name = "ping"
+  , registration = createChatInput "ping" "responds pong"
+  , handler = \intr _options ->
+      void . restCall $
+        R.CreateInteractionResponse
+          (interactionId intr)
+          (interactionToken intr)
+          (interactionResponseBasic  "pong")
+  }
+
+
+-- EVENTS
+
+onDiscordEvent :: GuildId -> Event -> DiscordHandler ()
+onDiscordEvent testGuildId = \case
+  Ready _ _ _ _ _ _ (PartialApplication appId _) -> onReady appId testGuildId
+  InteractionCreate intr                         -> onInteractionCreate intr
+  _                                              -> pure ()
+
+onReady :: ApplicationId -> GuildId -> DiscordHandler ()
+onReady appId testGuildId = do
+  echo "Bot ready!"
+
+  appCmdRegistrations <- mapM tryRegistering mySlashCommands
+
+  case sequence appCmdRegistrations of
+    Left err ->
+      echo $ "[!] Failed to register some commands" <> showT err
+
+    Right cmds -> do
+      echo $ "Registered " <> showT (length cmds) <> " command(s)."
+      unregisterOutdatedCmds cmds
+
+  where
+  tryRegistering cmd = case registration cmd of
+    Just reg -> restCall $ R.CreateGuildApplicationCommand appId testGuildId reg
+    Nothing  -> pure . Left $ RestCallErrorCode 0 "" ""
+
+  unregisterOutdatedCmds validCmds = do
+    registered <- restCall $ R.GetGuildApplicationCommands appId testGuildId
+    case registered of
+      Left err ->
+        echo $ "Failed to get registered slash commands: " <> showT err
+
+      Right cmds ->
+        let validIds    = map applicationCommandId validCmds
+            outdatedIds = filter (`notElem` validIds)
+                        . map applicationCommandId
+                        $ cmds
+         in forM_ outdatedIds $
+              restCall . R.DeleteGuildApplicationCommand appId testGuildId
+
+onInteractionCreate :: Interaction -> DiscordHandler ()
+onInteractionCreate = \case
+  cmd@InteractionApplicationCommand
+    { applicationCommandData = input@ApplicationCommandDataChatInput {} } ->
+      case
+        find (\c -> applicationCommandDataName input == name c) mySlashCommands
+      of
+        Just found ->
+          handler found cmd (optionsData input)
+
+        Nothing ->
+          echo "Somehow got unknown slash command (registrations out of date?)"
+
+  _ ->
+    pure () -- Unexpected/unsupported interaction type
diff --git a/deps/discord-haskell/examples/interaction-commands.hs b/deps/discord-haskell/examples/interaction-commands.hs
new file mode 100644
index 0000000..7d22825
--- /dev/null
+++ b/deps/discord-haskell/examples/interaction-commands.hs
@@ -0,0 +1,483 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ViewPatterns #-}
+
+import Control.Monad (when)
+import qualified Data.ByteString as B
+import Data.Char (isDigit)
+import Data.Functor ((<&>))
+import Data.List (transpose)
+import qualified Data.Text as T
+import qualified Data.Text.IO as TIO
+import Discord
+import Discord.Interactions
+import qualified Discord.Requests as R
+import Discord.Types
+import UnliftIO (liftIO)
+import UnliftIO.Concurrent
+
+import ExampleUtils (getToken, getGuildId, actionWithChannelId)
+
+main :: IO ()
+main = interactionCommandExample
+
+void :: DiscordHandler (Either RestCallErrorCode b) -> DiscordHandler ()
+void =
+  ( >>=
+      ( \case
+          Left e -> liftIO $ print e
+          Right _ -> return ()
+      )
+  )
+
+-- | Creates and manages a variety of interactions, including a tic tac toe example.
+interactionCommandExample :: IO ()
+interactionCommandExample = do
+  tok <- getToken
+  testserverid <- getGuildId
+
+  -- open ghci and run  [[ :info RunDiscordOpts ]] to see available fields
+  t <-
+    runDiscord $
+      def
+        { discordToken = tok,
+          discordOnStart = startHandler testserverid,
+          discordOnEnd = liftIO $ putStrLn "Ended",
+          discordOnEvent = eventHandler testserverid,
+          discordOnLog = \s -> TIO.putStrLn s >> TIO.putStrLn "",
+          discordGatewayIntent = def {gatewayIntentMembers = True, gatewayIntentPresences = True}
+        }
+  TIO.putStrLn t
+
+-- If the start handler throws an exception, discord-haskell will gracefully shutdown
+--     Use place to execute commands you know you want to complete
+startHandler :: GuildId -> DiscordHandler ()
+startHandler testserverid = do
+  let activity =
+        def
+          { activityName = "ping-pong",
+            activityType = ActivityTypeGame
+          }
+  let opts =
+        UpdateStatusOpts
+          { updateStatusOptsSince = Nothing,
+            updateStatusOptsGame = Just activity,
+            updateStatusOptsNewStatus = UpdateStatusOnline,
+            updateStatusOptsAFK = False
+          }
+  sendCommand (UpdateStatus opts)
+
+  actionWithChannelId testserverid $ \cid ->
+    void $
+      restCall $
+        R.CreateMessage
+          cid
+          "Hello! I will reply to pings with pongs"
+
+-- | Example user command
+exampleUserCommand :: Maybe CreateApplicationCommand
+exampleUserCommand = createUser "usercomm"
+
+-- | Example slash command that has subcommands and multiple types of fields.
+newExampleSlashCommand :: Maybe CreateApplicationCommand
+newExampleSlashCommand =
+  createChatInput
+    "subtest"
+    "testing out subcommands"
+    >>= \d ->
+      Just $
+        d
+          { createOptions =
+              Just
+                ( OptionsSubcommands
+                    [ OptionSubcommandGroup
+                        "frstsubcmdgrp"
+                        Nothing
+                        "the sub command group"
+                        Nothing
+                        [ OptionSubcommand
+                            "frstsubcmd"
+                            Nothing
+                            "the first sub sub command"
+                            Nothing
+                            [ OptionValueString
+                                "onestringinput"
+                                Nothing
+                                "two options"
+                                Nothing
+                                True
+                                ( Right
+                                    [ Choice "green" Nothing "green",
+                                      Choice "red" Nothing "red"
+                                    ]
+                                )
+                                Nothing
+                                Nothing,
+                              OptionValueInteger "oneintinput" Nothing "choices galore" Nothing False (Left False) Nothing Nothing
+                            ]
+                        ],
+                      OptionSubcommandOrGroupSubcommand $
+                        OptionSubcommand
+                          "frstsubcmd"
+                          Nothing
+                          "the first subcommand"
+                          Nothing
+                          [ OptionValueString
+                              "onestringinput"
+                              Nothing
+                              "two options"
+                              Nothing
+                              True
+                              ( Right
+                                  [ Choice "yellow" Nothing "yellow",
+                                    Choice "blue" Nothing "blue"
+                                  ]
+                              )
+                              Nothing
+                              Nothing
+                          ],
+                      OptionSubcommandOrGroupSubcommand $
+                        OptionSubcommand
+                          "sndsubcmd"
+                          Nothing
+                          "the second subcommand"
+                          Nothing
+                          [ OptionValueBoolean
+                              "trueorfalse"
+                              Nothing
+                              "true or false"
+                              Nothing
+                              True,
+                            OptionValueNumber
+                              "numbercomm"
+                              Nothing
+                              "number option"
+                              Nothing
+                              False
+                              (Left True)
+                              (Just 3.1415)
+                              (Just 101),
+                            OptionValueInteger
+                              "numbercomm2"
+                              Nothing
+                              "another number option"
+                              Nothing
+                              False
+                              (Right [Choice "one" Nothing 1, Choice "two" Nothing 2, Choice "minus 1" Nothing (-1)])
+                              (Just $ -1)
+                              (Just $ -2),
+                            OptionValueInteger
+                              "numbercomm3"
+                              Nothing
+                              "another another number option"
+                              Nothing
+                              False
+                              (Left True)
+                              (Just $ -50)
+                              (Just 50),
+                            OptionValueUser
+                              "user"
+                              Nothing
+                              "testing asking for a user"
+                              Nothing
+                              False,
+                            OptionValueChannel
+                              "channel"
+                              Nothing
+                              "testing asking for a channel"
+                              Nothing
+                              False
+                              (Just [ChannelTypeOptionGuildVoice]),
+                            OptionValueMentionable
+                              "mentionable"
+                              Nothing
+                              "testing asking for a mentionable"
+                              Nothing
+                              False
+                          ]
+                    ]
+                )
+          }
+
+-- | An example slash command.
+exampleSlashCommand :: Maybe CreateApplicationCommand
+exampleSlashCommand =
+  createChatInput
+    "test"
+    "here is a description"
+    >>= \cac ->
+      return $
+        cac
+          { createOptions =
+              Just $
+                OptionsValues
+                  [ OptionValueString
+                      "randominput"
+                      Nothing
+                      "I shall not"
+                      Nothing
+                      True
+                      (Right [Choice "firstOpt" Nothing "yay", Choice "secondOpt" Nothing "nay"])
+                      Nothing
+                      Nothing
+                  ]
+          }
+
+exampleInteractionResponse :: OptionsData -> InteractionResponse
+exampleInteractionResponse (OptionsDataValues [OptionDataValueString {optionDataValueString = s}]) =
+  interactionResponseBasic (T.pack $ "Here's the reply! You chose: " ++ show s)
+exampleInteractionResponse _ =
+  interactionResponseBasic
+    "Something unexpected happened - the value was not what I expected!"
+
+getImage :: IO B.ByteString
+getImage = return "\137PNG\r\n\SUB\n\NUL\NUL\NUL\rIHDR\NUL\NUL\NUL\SOH\NUL\NUL\NUL\SOH\b\STX\NUL\NUL\NUL\144wS\222\NUL\NUL\NUL\SOHsRGB\NUL\174\206\FS\233\NUL\NUL\NUL\EOTgAMA\NUL\NUL\177\143\v\252a\ENQ\NUL\NUL\NUL\tpHYs\NUL\NUL\SO\195\NUL\NUL\SO\195\SOH\199o\168d\NUL\NUL\NUL\fIDAT\CANWc\248\239\180\t\NUL\EOT7\SOH\244\162\155\ENQ\235\NUL\NUL\NUL\NULIEND\174B`\130"
+
+
+-- If an event handler throws an exception, discord-haskell will continue to run
+eventHandler :: GuildId -> Event -> DiscordHandler ()
+eventHandler testserverid event = case event of
+  MessageCreate m -> when (not (fromBot m) && isPing m) $ do
+    void $ restCall (R.CreateReaction (messageChannelId m, messageId m) "eyes")
+    threadDelay (2 * 10 ^ (6 :: Int))
+
+    -- A very simple message.
+    void $ restCall (R.CreateMessage (messageChannelId m) "Pong!")
+    exampleImage <- liftIO getImage
+
+    -- A more complex message. Text-to-speech, does not mention everyone nor
+    -- the user, and uses Discord native replies.
+    -- Use ":info" in ghci to explore the type
+    let opts :: R.MessageDetailedOpts
+        opts =
+          def
+            { R.messageDetailedContent = "Here's a more complex message, but doesn't ping @everyone!",
+              R.messageDetailedTTS = True,
+              R.messageDetailedAllowedMentions =
+                Just $
+                  def
+                    { R.mentionEveryone = False,
+                      R.mentionRepliedUser = False
+                    },
+              R.messageDetailedReference =
+                Just $
+                  def {referenceMessageId = Just $ messageId m}
+            }
+    void $ restCall (R.CreateMessageDetailed (messageChannelId m) opts)
+    let opts' :: R.MessageDetailedOpts
+        opts' =
+          def
+            { R.messageDetailedContent = "An example of a message with buttons!",
+              R.messageDetailedComponents =
+                Just
+                  [ ActionRowButtons
+                      [ Button "Button 1" False ButtonStylePrimary (Just "Button 1") (Just (mkEmoji "🔥")),
+                        Button "Button 2" True ButtonStyleSuccess (Just "Button 2") Nothing,
+                        ButtonUrl
+                          "https://github.com/discord-haskell/discord-haskell"
+                          False
+                          (Just "Button 3")
+                          Nothing
+                      ],
+                    ActionRowSelectMenu
+                      ( SelectMenu
+                          "action select menu"
+                          False
+                          (SelectMenuDataText [ SelectOption "First option" "opt1" (Just "the only desc") Nothing Nothing,
+                            SelectOption "Second option" "opt2" Nothing (Just (mkEmoji "😭")) (Just True),
+                            SelectOption "third option" "opt3" Nothing Nothing Nothing,
+                            SelectOption "fourth option" "opt4" Nothing Nothing Nothing,
+                            SelectOption "fifth option" "opt5" Nothing Nothing Nothing
+                          ])
+                          (Just "this is a place holder")
+                          (Just 2)
+                          (Just 5)
+                      ),
+                    ActionRowSelectMenu
+                      ( SelectMenu
+                          "user select menu"
+                          False
+                          (SelectMenuDataUser)
+                          (Just "this is a place holder")
+                          (Just 3)
+                          (Just 3)
+                      ),
+                    ActionRowSelectMenu
+                      ( SelectMenu
+                          "channel select menu"
+                          False
+                          (SelectMenuDataChannels [ChannelTypeOptionGuildText,ChannelTypeOptionGuildPublicThread,ChannelTypeOptionGuildCategory])
+                          (Just "this is a place holder")
+                          (Just 1)
+                          (Just 1)
+                      )
+                  ],
+              R.messageDetailedEmbeds =
+                Just
+                  [ def
+                      { createEmbedTitle = "Title",
+                        createEmbedDescription = "the description",
+                        createEmbedAuthorName = "Author name is Required",
+                        createEmbedImage = Just (CreateEmbedImageUrl "https://media.discordapp.net/attachments/365969021083975681/936055590415921172/Warning.png"),
+                        createEmbedColor = Just DiscordColorLuminousVividPink,
+                        createEmbedAuthorIcon = Just (CreateEmbedImageUpload exampleImage)
+                      },
+                    def {createEmbedTitle = "a different Title", createEmbedDescription = "another desc"}
+                  ]
+            }
+        tictactoe :: R.MessageDetailedOpts
+        tictactoe =
+          def
+            { R.messageDetailedContent = "Playing tic tac toe! Player 0",
+              R.messageDetailedComponents = Just $ updateTicTacToe Nothing []
+            }
+    void $ restCall (R.CreateMessageDetailed (messageChannelId m) opts')
+    void $ restCall (R.CreateMessageDetailed (messageChannelId m) tictactoe)
+  Ready _ _ _ _ _ _ (PartialApplication i _) -> do
+    vs <-
+      mapM
+        (maybe (return (Left $ RestCallErrorCode 0 "" "")) (restCall . R.CreateGuildApplicationCommand i testserverid))
+        [exampleSlashCommand, exampleUserCommand, newExampleSlashCommand, createChatInput "modal" "modal test"]
+    liftIO (putStrLn $ "number of application commands added " ++ show (length vs))
+    acs <- restCall (R.GetGuildApplicationCommands i testserverid)
+    case acs of
+      Left r -> liftIO $ print r
+      Right ls -> liftIO $ putStrLn $ "number of application commands total " ++ show (length ls)
+  InteractionCreate InteractionComponent {componentData = cb@ButtonData {componentDataCustomId = (T.take 3 -> "ttt")}, ..} -> case processTicTacToe cb interactionMessage of
+    [r] ->
+      void
+        ( restCall
+            ( R.CreateInteractionResponse
+                interactionId
+                interactionToken
+                (InteractionResponseUpdateMessage r)
+            )
+        )
+    r : rs ->
+      void
+        ( restCall $
+            R.CreateInteractionResponse
+              interactionId
+              interactionToken
+              (InteractionResponseUpdateMessage r)
+        )
+        >> mapM_
+          ( restCall
+              . R.CreateFollowupInteractionMessage
+                interactionApplicationId
+                interactionToken
+          )
+          rs
+    _ -> return ()
+  InteractionCreate InteractionApplicationCommand {applicationCommandData = ApplicationCommandDataUser {applicationCommandDataName = nm, applicationCommandDataTargetUserId = uid, ..}, ..} ->
+    void $
+      restCall
+        (R.CreateInteractionResponse interactionId interactionToken (interactionResponseBasic $ "Command " <> nm <> T.pack (" selected user: " ++ show uid)))
+  InteractionCreate InteractionApplicationCommand {applicationCommandData = ApplicationCommandDataChatInput {applicationCommandDataName = "test", optionsData = Just d, ..}, ..} ->
+    void $
+      restCall
+        (R.CreateInteractionResponse interactionId interactionToken (exampleInteractionResponse d))
+  InteractionCreate InteractionApplicationCommand {applicationCommandData = ApplicationCommandDataChatInput {applicationCommandDataName = "subtest", optionsData = Just d, ..}, ..} -> void $ restCall (R.CreateInteractionResponse interactionId interactionToken (interactionResponseBasic (T.pack $ "oh boy, subcommands! welp, here's everything I got from that: " <> show d)))
+  InteractionCreate InteractionComponent {componentData = ButtonData {..}, ..} ->
+    void $
+      restCall
+        ( R.CreateInteractionResponse interactionId interactionToken $
+            InteractionResponseChannelMessage
+              ( ( interactionResponseMessageBasic $ "You pressed the button " <> componentDataCustomId
+                )
+                  { interactionResponseMessageFlags = Just (InteractionResponseMessageFlags [InteractionResponseMessageFlagEphermeral])
+                  }
+              )
+        )
+  InteractionCreate InteractionComponent {componentData = SelectMenuData {componentDataValues = vs}, ..} ->
+    void
+      ( do
+          exampleImage <- liftIO getImage
+          aid <- readCache <&> cacheApplication <&> partialApplicationID
+          _ <- restCall (R.CreateInteractionResponse interactionId interactionToken InteractionResponseDeferChannelMessage)
+          restCall
+            ( R.CreateFollowupInteractionMessage
+                aid
+                interactionToken
+                (interactionResponseMessageBasic (T.pack $ "oh dear, select menu. thank you for waiting" <> show vs))
+                  { interactionResponseMessageEmbeds =
+                      Just
+                        [ def
+                            { createEmbedTitle = "Select menu title",
+                              createEmbedDescription = "Here is the select menu embed desc",
+                              createEmbedAuthorName = "someunknownentity",
+                              createEmbedImage = Just (CreateEmbedImageUrl "https://media.discordapp.net/attachments/365969021083975681/936055590415921172/Warning.png"),
+                              createEmbedColor = Just DiscordColorDiscordBlurple,
+                              createEmbedAuthorIcon = Just (CreateEmbedImageUpload exampleImage)
+                            }
+                        ]
+                  }
+            )
+      )
+  InteractionCreate InteractionApplicationCommandAutocomplete {applicationCommandData = ApplicationCommandDataChatInput {applicationCommandDataName = "subtest", optionsData = Just _, ..}, ..} -> void (restCall $ R.CreateInteractionResponse interactionId interactionToken (InteractionResponseAutocompleteResult (InteractionResponseAutocompleteInteger [Choice "five" Nothing 5])))
+  InteractionCreate i@InteractionApplicationCommand {applicationCommandData = ApplicationCommandDataChatInput {applicationCommandDataName = "modal"}} ->
+    void $
+      restCall
+        ( R.CreateInteractionResponse
+            (interactionId i)
+            (interactionToken i)
+            ( InteractionResponseModal
+                ( InteractionResponseModalData
+                    "customidmodal"
+                    "modal title"
+                    [mkTextInput "textcid" "textlabel"]
+                )
+            )
+        )
+  InteractionCreate i@InteractionModalSubmit {modalData = idm} -> void $ restCall (R.CreateInteractionResponse (interactionId i) (interactionToken i) (interactionResponseBasic (T.pack (show idm))))
+  _ -> return ()
+
+processTicTacToe :: ComponentData -> Message -> [InteractionResponseMessage]
+processTicTacToe (ButtonData cid) m = case messageComponents m of
+  Nothing -> [interactionResponseMessageBasic "Sorry, I couldn't get the components on that message."]
+  (Just cs) ->
+    let newComp = newComp' cs
+     in ( ( interactionResponseMessageBasic
+              ("Some Tic Tac Toe! Player " <> (if '0' == T.last (messageContent m) then "1" else "0"))
+          )
+            { interactionResponseMessageComponents = Just ((if checkTicTacToe newComp then (disableAll <$>) else id) newComp)
+            }
+        ) :
+          [interactionResponseMessageBasic ("Player " <> T.singleton player <> " has won!") | checkTicTacToe newComp]
+  where
+    player = T.last (messageContent m)
+    newComp' = updateTicTacToe (Just (cid, '0' == player))
+    disableAll (ActionRowButtons cs) = ActionRowButtons $ (\c -> c {buttonDisabled = True}) <$> cs
+    disableAll c = c
+processTicTacToe _ _ = [interactionResponseMessageBasic "Sorry, I couldn't understand that button."]
+
+checkTicTacToe :: [ActionRow] -> Bool
+checkTicTacToe xs = checkRows unwrapped || checkRows unwrappedT || checkRows [diagonal unwrapped, diagonal (reverse <$> unwrapped)]
+  where
+    checkRows = any (\cbs -> all (\cb -> cb == head cbs && cb /= ButtonStyleSecondary) cbs)
+    unwrapped = (\(ActionRowButtons cbs) -> (\Button {buttonStyle = style} -> style) <$> cbs) <$> xs
+    unwrappedT = transpose unwrapped
+    diagonal [] = []
+    diagonal ([] : _) = []
+    diagonal (ys : yss) = head ys : diagonal (tail <$> yss)
+
+updateTicTacToe :: Maybe (T.Text, Bool) -> [ActionRow] -> [ActionRow]
+updateTicTacToe Nothing _ = (\y -> ActionRowButtons $ (\x -> Button (T.pack $ "ttt " <> show x <> show y) False ButtonStyleSecondary (Just "[ ]") Nothing) <$> [0 .. 4]) <$> [0 .. 4]
+updateTicTacToe (Just (tttxy, isFirst)) car
+  | not (checkIsValid tttxy) = car
+  | otherwise = (\(ActionRowButtons cbs) -> ActionRowButtons (changeIf <$> cbs)) <$> car
+  where
+    checkIsValid tttxy' = T.length tttxy' == 6 && all isDigit [T.index tttxy' 4, T.index tttxy' 5]
+    getxy tttxy' = (T.index tttxy' 4, T.index tttxy' 5)
+    (style, symbol) = if isFirst then (ButtonStyleSuccess, "[X]") else (ButtonStyleDanger, "[O]")
+    changeIf cb@Button {..}
+      | checkIsValid buttonCustomId && getxy tttxy == getxy buttonCustomId = cb {buttonDisabled = True, buttonStyle = style, buttonLabel = Just symbol}
+      | otherwise = cb
+    changeIf cb = cb
+
+fromBot :: Message -> Bool
+fromBot = userIsBot . messageAuthor
+
+isPing :: Message -> Bool
+isPing = ("ping" `T.isPrefixOf`) . T.toLower . messageContent
diff --git a/deps/discord-haskell/examples/ping-pong.hs b/deps/discord-haskell/examples/ping-pong.hs
new file mode 100644
index 0000000..87ec08b
--- /dev/null
+++ b/deps/discord-haskell/examples/ping-pong.hs
@@ -0,0 +1,97 @@
+{-# LANGUAGE OverloadedStrings #-}  -- allows "strings" to be Data.Text
+
+import Control.Monad (when, void)
+import qualified Data.Text as T
+import qualified Data.Text.IO as TIO
+
+import UnliftIO (liftIO)
+import UnliftIO.Concurrent
+
+import Discord
+import Discord.Types
+import qualified Discord.Requests as R
+
+import ExampleUtils (getToken, getGuildId, actionWithChannelId)
+
+-- Allows this code to be an executable. See discord-haskell.cabal
+main :: IO ()
+main = pingpongExample
+
+-- | Replies "pong" to every message that starts with "ping"
+pingpongExample :: IO ()
+pingpongExample = do
+  tok <- getToken
+  testserverid <- getGuildId
+
+  -- open ghci and run  [[ :info RunDiscordOpts ]] to see available fields
+  err <- runDiscord $ def { discordToken = tok
+                          , discordOnStart = startHandler testserverid
+                          , discordOnEnd = liftIO $ threadDelay (round (0.4 * 10^6)) >>  putStrLn "Ended"
+                          , discordOnEvent = eventHandler
+                          , discordOnLog = \s -> TIO.putStrLn s >> TIO.putStrLn ""
+                          , discordGatewayIntent = def {gatewayIntentMembers = True, gatewayIntentPresences =True}
+                          }
+
+  -- 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 :: GuildId -> DiscordHandler ()
+startHandler testserverid = do
+  liftIO $ putStrLn "Started ping-pong bot"
+
+  let activity = def { activityName = "ping-pong"
+                     , activityType = ActivityTypeGame
+                     }
+  let opts = UpdateStatusOpts { updateStatusOptsSince = Nothing
+                              , updateStatusOptsGame = Just activity
+                              , updateStatusOptsNewStatus = UpdateStatusOnline
+                              , updateStatusOptsAFK = False
+                              }
+  sendCommand (UpdateStatus opts)
+
+  actionWithChannelId testserverid $ \cid ->
+    void $
+      restCall $
+        R.CreateMessage
+          cid
+          "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 (messageChannelId m, messageId m) "eyes")
+        threadDelay (2 * 10 ^ (6 :: Int))
+
+        -- A very simple message.
+        Right m' <- restCall (R.CreateMessage (messageChannelId m) "Pong")
+        void $ restCall (R.EditMessage (messageChannelId m, messageId m') (def {R.messageDetailedContent=messageContent m' <> "!"}))
+
+        latency <- getGatewayLatency
+        mLatency <- measureLatency
+
+        -- A more complex message. Text-to-speech, does not mention everyone nor
+        -- the user, and uses Discord native replies.
+        -- Use ":info" in ghci to explore the type
+        let opts :: R.MessageDetailedOpts
+            opts = def { R.messageDetailedContent = "Here's a more complex message, but doesn't ping @everyone!. Here's the current gateway latency: " <> (T.pack . show) ([latency, mLatency])
+                       , R.messageDetailedTTS = True
+                       , R.messageDetailedAllowedMentions = Just $
+                          def { R.mentionEveryone = False
+                              , R.mentionRepliedUser = False
+                              }
+                       , R.messageDetailedReference = Just $
+                          def { referenceMessageId = Just $ messageId m }
+                       }
+        void $ restCall (R.CreateMessageDetailed (messageChannelId m) opts)
+      _ -> return ()
+
+fromBot :: Message -> Bool
+fromBot = userIsBot . messageAuthor
+
+isPing :: Message -> Bool
+isPing = ("ping" `T.isPrefixOf`) . T.toLower . messageContent
diff --git a/deps/discord-haskell/examples/rest-without-gateway.hs b/deps/discord-haskell/examples/rest-without-gateway.hs
new file mode 100644
index 0000000..5627f06
--- /dev/null
+++ b/deps/discord-haskell/examples/rest-without-gateway.hs
@@ -0,0 +1,50 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+import qualified Data.Text as T
+import qualified Data.Text.IO as TIO
+
+import           Control.Monad (forever)
+import           Control.Concurrent      -- Chans and Threads
+
+import           Discord.Types
+import qualified Discord.Requests as R
+
+import           Discord.Internal.Rest (startRestThread, writeRestCall, RestCallInternalException(..))
+
+import ExampleUtils (getToken, getGuildId)
+
+{-
+Peel back the `runDiscord` abstraction
+
+Send an HTTP restcall without logging into the gateway
+-}
+main :: IO ()
+main = do
+  tok <- getToken
+  testserverid <- getGuildId
+
+  -- SETUP LOG
+  printQueue <- newChan :: IO (Chan T.Text)
+  printThreadId <- forkIO $ forever $ readChan printQueue >>= TIO.putStrLn
+
+  -- START REST LOOP THREAD
+  (restChan, restThreadId) <- startRestThread (Auth tok) printQueue
+
+  -- a rest call to get the channels in which we will post a message
+  Right cs <- writeRestCall restChan (R.GetGuildChannels testserverid)
+
+  -- ONE REST CALL
+  resp <- writeRestCall restChan (R.CreateMessage (channelId (head $ filter isTextChannel cs)) "Message")
+  case resp of
+    Right msg -> print $ "created message: " <> show msg
+    Left (RestCallInternalErrorCode _code _status _body) -> print "4XX style http error code"
+    Left (RestCallInternalHttpException _err) -> print "http exception (likely no connection)"
+    Left (RestCallInternalNoParse _err _jsondata) -> print "can't parse return JSON"
+
+  -- CLEANUP
+  killThread printThreadId
+  killThread restThreadId
+  where
+    isTextChannel :: Channel -> Bool
+    isTextChannel ChannelText {} = True
+    isTextChannel _ = False
diff --git a/deps/discord-haskell/examples/state-counter.hs b/deps/discord-haskell/examples/state-counter.hs
new file mode 100644
index 0000000..f017d9c
--- /dev/null
+++ b/deps/discord-haskell/examples/state-counter.hs
@@ -0,0 +1,75 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+import Control.Monad (when, void, forever)
+import UnliftIO (try, IOException) -- liftIO
+import UnliftIO.MVar
+import UnliftIO.Chan
+import UnliftIO.Concurrent (forkIO, killThread)
+import qualified Data.Text as T
+import qualified Data.Text.IO as TIO
+
+import Discord
+import Discord.Types
+import qualified Discord.Requests as R
+
+import ExampleUtils (getToken)
+
+main :: IO ()
+main = stateExample
+
+data State = State { pingCount :: Integer }
+  deriving (Show, Read, Eq, Ord)
+
+-- | Counts how many pings we've seen across sessions
+stateExample :: IO ()
+stateExample = do
+  tok <- getToken
+
+  -- eventHandler is called concurrently, need to sync stdout
+  printQueue <- newChan :: IO (Chan T.Text)
+  threadId <- forkIO $ forever $ readChan printQueue >>= TIO.putStrLn
+
+  -- try to read previous state, otherwise use 0
+  state :: MVar (State) <- do
+        mfile <- try $ read . T.unpack <$> TIO.readFile "./cachedState"
+        s <- case mfile of
+            Right file -> do
+                    writeChan printQueue "loaded state from file"
+                    pure file
+            Left (_ :: IOException) -> do
+                    writeChan printQueue "created new state"
+                    pure $ State { pingCount = 0 }
+        newMVar s
+
+  t <- runDiscord $ def { discordToken = tok
+                        , discordOnStart = writeChan printQueue "starting ping loop"
+                        , discordOnEvent = eventHandler state printQueue
+                        , discordOnEnd = do killThread threadId
+                                            --
+                                            s <- readMVar state
+                                            TIO.writeFile "./cachedState" (T.pack (show s))
+                        }
+  TIO.putStrLn t
+
+
+eventHandler :: MVar State -> Chan T.Text -> Event -> DiscordHandler ()
+eventHandler state printQueue event = case event of
+  -- respond to message, and modify state
+  MessageCreate m -> when (not (fromBot m) && isPing m) $ do
+    writeChan printQueue "got a ping!"
+
+    s <- takeMVar state
+
+    void $ restCall (R.CreateMessage (messageChannelId m) (T.pack ("Pong #" <> show (pingCount s))))
+
+    putMVar state $ State { pingCount = pingCount s + 1 }
+
+  _ -> pure ()
+
+
+fromBot :: Message -> Bool
+fromBot = userIsBot . messageAuthor
+
+isPing :: Message -> Bool
+isPing = ("ping" `T.isPrefixOf`) . T.toLower . messageContent