2R6RBGYN6CEXNP5PD4CYFXVGC4WY6CLNQ2P3NN6UU3I7PGD76FIQC
fileRequest :: (MonadIO m) => Text -> m (Maybe ByteString)
fileRequest input = runReq defaultHttpConfig $ do
uri <- mkURI $ Text.dropWhileEnd (== '&') input
case useHttpsURI uri of
Nothing -> return Nothing
Just (url, options) -> do
bs <- req GET url NoReqBody bsResponse options
return . Just $ responseBody bs
handleDiff ::
Interaction -> Maybe OptionsData -> Maybe ResolvedData -> DiscordHandler ()
handleDiff intr opts resolved = do
let oldId = keyList >>= lookup "old"
newId = keyList >>= lookup "new"
atts = resolved >>= attachments
oldUrl = atts >>= (\x -> oldId >>= \y -> lookup (showT y) x)
newUrl = atts >>= (\x -> newId >>= \y -> lookup (showT y) x)
case (oldUrl, newUrl) of
(Just oldReq, Just newReq) -> do
oldBytes <- fileRequest oldReq
newBytes <- fileRequest newReq
slashDiffCommand :: Maybe CreateApplicationCommand
slashDiffCommand = options <$> createChatInput "diff" "Check the diff of two decklists"
case (oldBytes, newBytes) of
(Just oldContent, Just newContent) ->
let res =
((,) <$> fromByteString oldContent <*> fromByteString newContent)
<&> view . eval . uncurry diff . uncurry evalDiffs
in case res of
Left _ ->
createResponse
"Something went wrong, make sure the files are in the correct format"
Right report -> createResponse report
_ -> createResponse "Unable to fetch the files"
_ -> createResponse "Malformed URI's"
where
createResponse response =
void $
restCall $
Request.CreateInteractionResponse
(interactionId intr)
(interactionToken intr)
(interactionResponseBasic response)
keyList = values =<< opts
values (OptionsDataValues vals) =
mapM
( \case
OptionDataValueAttachment {optionDataValueName, optionDataValueAttachment} -> Just (optionDataValueName, optionDataValueAttachment)
_ -> Nothing
)
vals
values _ = Nothing
attachments :: ResolvedData -> Maybe [(Text, Text)]
attachments (ResolvedData {resolvedDataAttachments = vals}) = case vals of
Nothing -> Nothing
Just val -> parseMaybe parseAttachments val
parseAttachments = withObject "<attachment>" $ \obj ->
let kvs = toList obj
parsed = mapM parseUrl kvs
in parsed
parseUrl = withObject "<url>" $ \obj -> do
attachmentId <- obj .: "id"
attachmentUrl <- obj .: "url"
return (attachmentId, attachmentUrl)
slashDiffCommand :: SlashCommand
slashDiffCommand = SlashCommand "diff" mkOptions handleDiff
InteractionCreate intr -> liftIO $ print intr
InteractionCreate intr -> case intr of
cmd@InteractionApplicationCommand
{ applicationCommandData =
ApplicationCommandDataChatInput
{ applicationCommandDataName
, resolvedData
, optionsData
}
} ->
case find (\c -> applicationCommandDataName == name c) slashCommands of
Nothing -> echo "The command could not be found in the commands, out of sync"
Just found -> handler found cmd optionsData resolvedData
_ -> pure ()
onReady appId = case slashDiffCommand of
Nothing -> pure ()
Just command -> do
res <- restCall $ Request.CreateGlobalApplicationCommand appId command
case res of
Left e -> liftIO $ print e
Right validCmds -> do
liftIO $ putStrLn "Command successfully registered"
registered <- restCall $ Request.GetGlobalApplicationCommands appId
case registered of
Left _ -> liftIO $ putStrLn "error occured"
Right cmds -> do
let validId = applicationCommandId validCmds
outdatedIds = filter (/= validId) . map applicationCommandId $ cmds
in forM_ outdatedIds $
restCall . Request.DeleteGlobalApplicationCommand appId
onReady appId = do
registerCommands <- mapM tryRegistering slashCommands
case sequence registerCommands of
Left err -> echo $ "[!] Unable to register some slash commands: " <> showT err
Right cmds -> do
echo $ "Registered " <> showT (length cmds) <> " command(s)"
unregisterOutdatedCommands cmds
where
tryRegistering cmd =
case register cmd of
Nothing -> return . Left $ RestCallErrorCode 0 "" ""
Just reg -> restCall $ Request.CreateGlobalApplicationCommand appId reg
unregisterOutdatedCommands validCmds = do
registered <- restCall $ Request.GetGlobalApplicationCommands appId
case registered of
Left err -> echo $ "Failed to get commands: " <> showT err
Right cmds ->
let validIds = map applicationCommandId validCmds
outdatedIds = filter (`notElem` validIds) . map applicationCommandId $ cmds
in forM_ outdatedIds $ restCall . Request.DeleteGlobalApplicationCommand appId