mirror of
https://gitlab.com/upRootNutrition/dotfiles.git
synced 2025-12-06 21:17:14 -06:00
chore: moved zookeeper and website to packages
This commit is contained in:
Nick
parent
cc288ad959
commit
cf8516c54f
976 changed files with 40485 additions and 0 deletions
1
packages/zookeeper/.envrc
Executable file
1
packages/zookeeper/.envrc
Executable file
|
|
@ -0,0 +1 @@
|
|||
use flake
|
||||
BIN
packages/zookeeper/assets/avatar.png
Executable file
BIN
packages/zookeeper/assets/avatar.png
Executable file
Binary file not shown.
|
After Width: | Height: | Size: 445 KiB |
25
packages/zookeeper/default.nix
Executable file
25
packages/zookeeper/default.nix
Executable file
|
|
@ -0,0 +1,25 @@
|
|||
{
|
||||
perSystem =
|
||||
{ pkgs, ... }:
|
||||
let
|
||||
hp = pkgs.haskellPackages;
|
||||
zookeeper = hp.callCabal2nix "zookeeper" ./. { };
|
||||
in
|
||||
{
|
||||
devShells.zookeeper = hp.shellFor {
|
||||
nativeBuildInputs = builtins.attrValues {
|
||||
inherit (pkgs)
|
||||
nil
|
||||
stylish-haskell
|
||||
;
|
||||
inherit (hp)
|
||||
cabal-install
|
||||
cabal-gild
|
||||
haskell-language-server
|
||||
;
|
||||
};
|
||||
packages = _: [ zookeeper ];
|
||||
};
|
||||
packages = { inherit zookeeper; };
|
||||
};
|
||||
}
|
||||
12
packages/zookeeper/fourmolu.yaml
Executable file
12
packages/zookeeper/fourmolu.yaml
Executable file
|
|
@ -0,0 +1,12 @@
|
|||
indentation: 2
|
||||
comma-style: trailing
|
||||
import-export-style: diff-friendly
|
||||
respectful: false
|
||||
column-limit: 80
|
||||
function-arrows: trailing
|
||||
haddock-style: single-line
|
||||
let-style: inline
|
||||
in-style: right-align
|
||||
unicode: never
|
||||
pragma-style: leading
|
||||
newlines-between-decls: 1
|
||||
326
packages/zookeeper/src/Main.hs
Executable file
326
packages/zookeeper/src/Main.hs
Executable file
|
|
@ -0,0 +1,326 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Main where
|
||||
|
||||
import Control.Monad (void, when)
|
||||
import Data.Text (Text, isPrefixOf, pack, strip, toLower, unpack)
|
||||
import Data.Text.IO as TIO
|
||||
import Data.Word
|
||||
import Discord
|
||||
import Discord.Internal.Types.ApplicationCommands
|
||||
import Discord.Internal.Types.Interactions
|
||||
import Discord.Requests as R
|
||||
import Discord.Types
|
||||
import UnliftIO.Concurrent
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
tokenRaw <- TIO.readFile "/run/secrets/env"
|
||||
let token = strip tokenRaw
|
||||
userFacingError <-
|
||||
runDiscord $
|
||||
def
|
||||
{ discordToken = token,
|
||||
discordOnStart = do
|
||||
let appId = botId
|
||||
let guildId = serverId
|
||||
void $ restCall (CreateGuildApplicationCommand appId guildId baboonCommand)
|
||||
void $ restCall (CreateGuildApplicationCommand appId guildId unbaboonCommand),
|
||||
discordOnEvent = eventHandler,
|
||||
discordOnLog = \s -> TIO.putStrLn s >> TIO.putStrLn ""
|
||||
}
|
||||
TIO.putStrLn userFacingError
|
||||
|
||||
baboonCommand :: CreateApplicationCommand
|
||||
baboonCommand =
|
||||
CreateApplicationCommandChatInput
|
||||
{ createName = "baboon",
|
||||
createLocalizedName = Nothing,
|
||||
createDescription = "Make someone a baboon",
|
||||
createLocalizedDescription = Nothing,
|
||||
createOptions =
|
||||
Just $
|
||||
OptionsValues
|
||||
[ OptionValueUser
|
||||
"target"
|
||||
Nothing
|
||||
"Send a baboon to the safari"
|
||||
Nothing
|
||||
True
|
||||
],
|
||||
createDefaultMemberPermissions = Nothing,
|
||||
createDMPermission = Nothing
|
||||
}
|
||||
|
||||
unbaboonCommand :: CreateApplicationCommand
|
||||
unbaboonCommand =
|
||||
CreateApplicationCommandChatInput
|
||||
{ createName = "unbaboon",
|
||||
createLocalizedName = Nothing,
|
||||
createDescription = "Return a baboon to the wild",
|
||||
createLocalizedDescription = Nothing,
|
||||
createOptions =
|
||||
Just $
|
||||
OptionsValues
|
||||
[ OptionValueUser
|
||||
"target"
|
||||
Nothing
|
||||
"The baboon to rewild"
|
||||
Nothing
|
||||
True
|
||||
],
|
||||
createDefaultMemberPermissions = Nothing,
|
||||
createDMPermission = Nothing
|
||||
}
|
||||
|
||||
eventHandler :: Event -> DiscordHandler ()
|
||||
eventHandler event = case event of
|
||||
InteractionCreate interaction -> do
|
||||
case interaction of
|
||||
InteractionApplicationCommand
|
||||
{ interactionId = iId,
|
||||
interactionApplicationId = _appId,
|
||||
applicationCommandData = cmd,
|
||||
interactionGuildId = guildId,
|
||||
interactionChannelId = _chanId,
|
||||
interactionUser = user,
|
||||
interactionToken = iToken
|
||||
} -> do
|
||||
let invokerUid = case user of
|
||||
MemberOrUser (Left guildMember) ->
|
||||
maybe (error "No user") userId (memberUser guildMember)
|
||||
MemberOrUser (Right plainUser) -> userId plainUser
|
||||
|
||||
let invokerRoles = case user of
|
||||
MemberOrUser (Left guildMember) -> memberRoles guildMember
|
||||
MemberOrUser (Right _) -> []
|
||||
|
||||
let hasPermission = any (\r -> unSnowflake (unId r) == ownerRoleId || unSnowflake (unId r) == moderatorRoleId) invokerRoles
|
||||
|
||||
when (applicationCommandDataName cmd == "baboon") $ do
|
||||
if not hasPermission
|
||||
then do
|
||||
let response =
|
||||
InteractionResponseChannelMessage $
|
||||
InteractionResponseMessage
|
||||
{ interactionResponseMessageTTS = Nothing,
|
||||
interactionResponseMessageContent = Just "You don't have permission to baboonify!",
|
||||
interactionResponseMessageEmbeds = Nothing,
|
||||
interactionResponseMessageAllowedMentions = Nothing,
|
||||
interactionResponseMessageFlags = Just $ InteractionResponseMessageFlags [InteractionResponseMessageFlagEphermeral],
|
||||
interactionResponseMessageComponents = Nothing,
|
||||
interactionResponseMessageAttachments = Nothing
|
||||
}
|
||||
void $ restCall (CreateInteractionResponse iId iToken response)
|
||||
else do
|
||||
let options = optionsData cmd
|
||||
let targetUid = case options of
|
||||
Just (OptionsDataValues opts) -> extractUserOption opts "target"
|
||||
_ -> error "No target specified"
|
||||
|
||||
if invokerUid == targetUid
|
||||
then do
|
||||
let response =
|
||||
InteractionResponseChannelMessage $
|
||||
InteractionResponseMessage
|
||||
{ interactionResponseMessageTTS = Nothing,
|
||||
interactionResponseMessageContent = Just "You can't baboonify yourself!",
|
||||
interactionResponseMessageEmbeds = Nothing,
|
||||
interactionResponseMessageAllowedMentions = Nothing,
|
||||
interactionResponseMessageFlags = Just $ InteractionResponseMessageFlags [InteractionResponseMessageFlagEphermeral],
|
||||
interactionResponseMessageComponents = Nothing,
|
||||
interactionResponseMessageAttachments = Nothing
|
||||
}
|
||||
void $ restCall (CreateInteractionResponse iId iToken response)
|
||||
else do
|
||||
case guildId of
|
||||
Just gid -> do
|
||||
targetMemberRes <- restCall (GetGuildMember gid targetUid)
|
||||
case targetMemberRes of
|
||||
Right targetMember -> do
|
||||
let targetRoles = memberRoles targetMember
|
||||
let isImmune = any (\r -> unSnowflake (unId r) `elem` immuneRoles) targetRoles
|
||||
|
||||
if isImmune
|
||||
then do
|
||||
let response =
|
||||
InteractionResponseChannelMessage $
|
||||
InteractionResponseMessage
|
||||
{ interactionResponseMessageTTS = Nothing,
|
||||
interactionResponseMessageContent = Just "That user is immune to baboonification!",
|
||||
interactionResponseMessageEmbeds = Nothing,
|
||||
interactionResponseMessageAllowedMentions = Nothing,
|
||||
interactionResponseMessageFlags = Just $ InteractionResponseMessageFlags [InteractionResponseMessageFlagEphermeral],
|
||||
interactionResponseMessageComponents = Nothing,
|
||||
interactionResponseMessageAttachments = Nothing
|
||||
}
|
||||
void $ restCall (CreateInteractionResponse iId iToken response)
|
||||
else do
|
||||
let targetRoles = memberRoles targetMember
|
||||
mapM_ (\roleId -> restCall (RemoveGuildMemberRole gid targetUid roleId)) targetRoles
|
||||
void $ restCall (AddGuildMemberRole gid targetUid (DiscordId (Snowflake baboonRoleId)))
|
||||
let response =
|
||||
InteractionResponseChannelMessage $
|
||||
InteractionResponseMessage
|
||||
{ interactionResponseMessageTTS = Nothing,
|
||||
interactionResponseMessageContent = Just $ "<@" <> pack (show (unId targetUid)) <> "> has become a baboon!",
|
||||
interactionResponseMessageEmbeds = Nothing,
|
||||
interactionResponseMessageAllowedMentions = Nothing,
|
||||
interactionResponseMessageFlags = Nothing,
|
||||
interactionResponseMessageComponents = Nothing,
|
||||
interactionResponseMessageAttachments = Nothing
|
||||
}
|
||||
void $ restCall (CreateInteractionResponse iId iToken response)
|
||||
Left _ -> do
|
||||
let response =
|
||||
InteractionResponseChannelMessage $
|
||||
InteractionResponseMessage
|
||||
{ interactionResponseMessageTTS = Nothing,
|
||||
interactionResponseMessageContent = Just "Failed to get target member info!",
|
||||
interactionResponseMessageEmbeds = Nothing,
|
||||
interactionResponseMessageAllowedMentions = Nothing,
|
||||
interactionResponseMessageFlags = Just $ InteractionResponseMessageFlags [InteractionResponseMessageFlagEphermeral],
|
||||
interactionResponseMessageComponents = Nothing,
|
||||
interactionResponseMessageAttachments = Nothing
|
||||
}
|
||||
void $ restCall (CreateInteractionResponse iId iToken response)
|
||||
Nothing -> return ()
|
||||
|
||||
when (applicationCommandDataName cmd == "unbaboon") $ do
|
||||
if not hasPermission
|
||||
then do
|
||||
let response =
|
||||
InteractionResponseChannelMessage $
|
||||
InteractionResponseMessage
|
||||
{ interactionResponseMessageTTS = Nothing,
|
||||
interactionResponseMessageContent = Just "You don't have permission to use this command!",
|
||||
interactionResponseMessageEmbeds = Nothing,
|
||||
interactionResponseMessageAllowedMentions = Nothing,
|
||||
interactionResponseMessageFlags = Just $ InteractionResponseMessageFlags [InteractionResponseMessageFlagEphermeral],
|
||||
interactionResponseMessageComponents = Nothing,
|
||||
interactionResponseMessageAttachments = Nothing
|
||||
}
|
||||
void $ restCall (CreateInteractionResponse iId iToken response)
|
||||
else do
|
||||
let options = optionsData cmd
|
||||
let targetUid = case options of
|
||||
Just (OptionsDataValues opts) -> extractUserOption opts "target"
|
||||
_ -> error "No target specified"
|
||||
|
||||
if invokerUid == targetUid
|
||||
then do
|
||||
let response =
|
||||
InteractionResponseChannelMessage $
|
||||
InteractionResponseMessage
|
||||
{ interactionResponseMessageTTS = Nothing,
|
||||
interactionResponseMessageContent = Just "You can't unbaboonify yourself!",
|
||||
interactionResponseMessageEmbeds = Nothing,
|
||||
interactionResponseMessageAllowedMentions = Nothing,
|
||||
interactionResponseMessageFlags = Just $ InteractionResponseMessageFlags [InteractionResponseMessageFlagEphermeral],
|
||||
interactionResponseMessageComponents = Nothing,
|
||||
interactionResponseMessageAttachments = Nothing
|
||||
}
|
||||
void $ restCall (CreateInteractionResponse iId iToken response)
|
||||
else do
|
||||
case guildId of
|
||||
Just gid -> do
|
||||
targetMemberRes <- restCall (GetGuildMember gid targetUid)
|
||||
case targetMemberRes of
|
||||
Right targetMember -> do
|
||||
let targetRoles = memberRoles targetMember
|
||||
let hasBaboonRole = any (\r -> unSnowflake (unId r) == baboonRoleId) targetRoles
|
||||
|
||||
if not hasBaboonRole
|
||||
then do
|
||||
let response =
|
||||
InteractionResponseChannelMessage $
|
||||
InteractionResponseMessage
|
||||
{ interactionResponseMessageTTS = Nothing,
|
||||
interactionResponseMessageContent = Just "That user is not a baboon!",
|
||||
interactionResponseMessageEmbeds = Nothing,
|
||||
interactionResponseMessageAllowedMentions = Nothing,
|
||||
interactionResponseMessageFlags = Just $ InteractionResponseMessageFlags [InteractionResponseMessageFlagEphermeral],
|
||||
interactionResponseMessageComponents = Nothing,
|
||||
interactionResponseMessageAttachments = Nothing
|
||||
}
|
||||
void $ restCall (CreateInteractionResponse iId iToken response)
|
||||
else do
|
||||
void $ restCall (AddGuildMemberRole gid targetUid (DiscordId (Snowflake defaultRoleId)))
|
||||
void $ restCall (RemoveGuildMemberRole gid targetUid (DiscordId (Snowflake baboonRoleId)))
|
||||
let response =
|
||||
InteractionResponseChannelMessage $
|
||||
InteractionResponseMessage
|
||||
{ interactionResponseMessageTTS = Nothing,
|
||||
interactionResponseMessageContent = Just $ "<@" <> pack (show (unId targetUid)) <> "> is no longer a baboon!",
|
||||
interactionResponseMessageEmbeds = Nothing,
|
||||
interactionResponseMessageAllowedMentions = Nothing,
|
||||
interactionResponseMessageFlags = Nothing,
|
||||
interactionResponseMessageComponents = Nothing,
|
||||
interactionResponseMessageAttachments = Nothing
|
||||
}
|
||||
void $ restCall (CreateInteractionResponse iId iToken response)
|
||||
Left _ -> do
|
||||
let response =
|
||||
InteractionResponseChannelMessage $
|
||||
InteractionResponseMessage
|
||||
{ interactionResponseMessageTTS = Nothing,
|
||||
interactionResponseMessageContent = Just "Failed to get target member info!",
|
||||
interactionResponseMessageEmbeds = Nothing,
|
||||
interactionResponseMessageAllowedMentions = Nothing,
|
||||
interactionResponseMessageFlags = Just $ InteractionResponseMessageFlags [InteractionResponseMessageFlagEphermeral],
|
||||
interactionResponseMessageComponents = Nothing,
|
||||
interactionResponseMessageAttachments = Nothing
|
||||
}
|
||||
void $ restCall (CreateInteractionResponse iId iToken response)
|
||||
Nothing -> return ()
|
||||
_ -> return ()
|
||||
MessageCreate m -> do
|
||||
when (isPing m && not (fromBot m)) $ do
|
||||
void $ restCall (R.CreateReaction (messageChannelId m, messageId m) "eyes")
|
||||
threadDelay standardPause
|
||||
void $ restCall (R.CreateMessage (messageChannelId m) "Pong!")
|
||||
_ -> return ()
|
||||
|
||||
extractUserOption :: [OptionDataValue] -> Text -> UserId
|
||||
extractUserOption opts name =
|
||||
case [v | OptionDataValueUser n v <- opts, n == name] of
|
||||
(uid : _) -> uid
|
||||
[] -> error $ "Option not found: " <> unpack name
|
||||
|
||||
-- Role IDs
|
||||
|
||||
botId :: ApplicationId
|
||||
botId = DiscordId (Snowflake 1428951383494623262)
|
||||
|
||||
serverId :: GuildId
|
||||
serverId = DiscordId (Snowflake 692563032546476062)
|
||||
|
||||
baboonRoleId :: Word64
|
||||
baboonRoleId = 1160622954082738347
|
||||
|
||||
ownerRoleId :: Word64
|
||||
ownerRoleId = 827332588803850270
|
||||
|
||||
moderatorRoleId :: Word64
|
||||
moderatorRoleId = 827303828884946944
|
||||
|
||||
patronRoleId :: Word64
|
||||
patronRoleId = 827404707843538975
|
||||
|
||||
youTubeRoleId :: Word64
|
||||
youTubeRoleId = 993361806141706310
|
||||
|
||||
defaultRoleId :: Word64
|
||||
defaultRoleId = 964354344948494416
|
||||
|
||||
immuneRoles :: [Word64]
|
||||
immuneRoles = [ownerRoleId, moderatorRoleId, patronRoleId, youTubeRoleId]
|
||||
|
||||
fromBot :: Message -> Bool
|
||||
fromBot = userIsBot . messageAuthor
|
||||
|
||||
isPing :: Message -> Bool
|
||||
isPing = ("ping" `isPrefixOf`) . toLower . messageContent
|
||||
|
||||
standardPause :: Int
|
||||
standardPause = (2 * 5 ^ 3)
|
||||
14
packages/zookeeper/zookeeper.cabal
Executable file
14
packages/zookeeper/zookeeper.cabal
Executable file
|
|
@ -0,0 +1,14 @@
|
|||
cabal-version: 3.0
|
||||
name: zookeeper
|
||||
version: 0.1.0.0
|
||||
|
||||
executable main
|
||||
main-is: Main.hs
|
||||
build-depends:
|
||||
, base
|
||||
, discord-haskell
|
||||
, text
|
||||
, unliftio
|
||||
|
||||
default-language: Haskell2010
|
||||
hs-source-dirs: src
|
||||
Loading…
Add table
Add a link
Reference in a new issue