blob: bf4632117ca4945c2f53a298fef74532dc46649b (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
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
|
