{-# LANGUAGE OverloadedStrings #-}
module Utils ( emojiToUsableText
, sendMessageChan
, sendReply
, sendMessageChanEmbed
, sendMessageChanPingsDisabled
, sendMessageDM
, sendFileChan
, sendAssetChan
, addReaction
, messageFromReaction
, pingUser
, pingRole
, pingAuthorOf
, pingWithUsername
, stripAllPings
, newCommand
, newDevCommand
, newModCommand
, linkChannel
, getMessageLink
, hasRoleByName
, hasRoleByID
, channelRequirement
, roleNameRequirement
, developerRequirement
, isMod
, devIDs
, assetDir
, (=~=)
, getTimestampFromMessage
, captureCommandOutput
, update
, snowflakeToInt
, moveChannel
, isEmojiValid
, isRoleInGuild
) where
import qualified Discord.Requests as R
import Discord.Types
import Discord
import Control.Exception ( catch
, IOException
)
import Control.Monad ( unless
, join
, void
)
import qualified Data.ByteString as B
import Data.Function ( on )
import Data.List.Split ( splitOn )
import qualified Data.Text as T
import qualified Data.Time.Format as TF
import System.Directory ( getXdgDirectory
, XdgDirectory ( XdgData )
)
import System.Exit ( ExitCode ( ExitSuccess
, ExitFailure )
)
import System.Process as Process
import UnliftIO ( liftIO )
import Text.Regex.TDFA ( (=~) )
import Owoifier ( owoify
, weakOwoify
)
import TemplateRE ( trailingWS )
import CSV ( readSingleColCSV )
import Data.Maybe ( fromJust )
import Data.Char ( isDigit )
import Command
devIDs :: FilePath
devIDs :: FilePath
devIDs = FilePath
"devs.csv"
repoDir :: FilePath
repoDir :: FilePath
repoDir = FilePath
"~/owenbot-hs/"
assetDir :: IO FilePath
assetDir :: IO FilePath
assetDir = IO FilePath -> IO FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> IO FilePath) -> IO FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ XdgDirectory -> FilePath -> IO FilePath
getXdgDirectory XdgDirectory
XdgData FilePath
"owen/assets/"
(=~=) :: T.Text -> T.Text -> Bool
=~= :: Text -> Text -> Bool
(=~=) = Text -> Text -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
RegexContext Regex source1 target) =>
source1 -> source -> target
(=~) (Text -> Text -> Bool) -> (Text -> Text) -> Text -> Text -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Text -> Text
weakOwoify
pingUser :: User -> T.Text
pingUser :: User -> Text
pingUser User
u = Text
"<@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (UserId -> FilePath
forall a. Show a => a -> FilePath
show (UserId -> FilePath) -> UserId -> FilePath
forall a b. (a -> b) -> a -> b
$ User -> UserId
userId User
u) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"
pingRole :: RoleId -> T.Text
pingRole :: UserId -> Text
pingRole UserId
r = Text
"<@&" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (UserId -> FilePath
forall a. Show a => a -> FilePath
show UserId
r) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"
pingAuthorOf :: Message -> T.Text
pingAuthorOf :: Message -> Text
pingAuthorOf = User -> Text
pingUser (User -> Text) -> (Message -> User) -> Message -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> User
messageAuthor
pingWithUsername :: T.Text -> GuildId -> DiscordHandler T.Text
pingWithUsername :: Text -> UserId -> DiscordHandler Text
pingWithUsername Text
uname UserId
gid = do
let timing :: GuildMembersTiming
timing = Maybe Int -> Maybe UserId -> GuildMembersTiming
R.GuildMembersTiming (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1000) Maybe UserId
forall a. Maybe a
Nothing
Either RestCallErrorCode [GuildMember]
membersM <- GuildRequest [GuildMember]
-> DiscordHandler (Either RestCallErrorCode [GuildMember])
forall a (r :: * -> *).
(FromJSON a, Request (r a)) =>
r a -> DiscordHandler (Either RestCallErrorCode a)
restCall (GuildRequest [GuildMember]
-> DiscordHandler (Either RestCallErrorCode [GuildMember]))
-> GuildRequest [GuildMember]
-> DiscordHandler (Either RestCallErrorCode [GuildMember])
forall a b. (a -> b) -> a -> b
$ UserId -> GuildMembersTiming -> GuildRequest [GuildMember]
R.ListGuildMembers UserId
gid GuildMembersTiming
timing
let members :: [GuildMember]
members = case Either RestCallErrorCode [GuildMember]
membersM of
Right [GuildMember]
success -> [GuildMember]
success
Left RestCallErrorCode
_ -> []
let users :: [User]
users = GuildMember -> User
memberUser (GuildMember -> User) -> [GuildMember] -> [User]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GuildMember]
members
let usersWithUsername :: [User]
usersWithUsername = (User -> Bool) -> [User] -> [User]
forall a. (a -> Bool) -> [a] -> [a]
filter (\User
u -> User -> Text
userName User
u Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
uname) [User]
users
Text -> DiscordHandler Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> DiscordHandler Text) -> Text -> DiscordHandler Text
forall a b. (a -> b) -> a -> b
$ case [User]
usersWithUsername of
[] -> Text
""
[User
u] -> User -> Text
pingUser User
u
[User]
_ -> Text
""
isUnicodeEmoji :: T.Text -> Bool
isUnicodeEmoji :: Text -> Bool
isUnicodeEmoji Text
emojiT = (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isInEmojiBlock ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
emojiT)
where
isInEmojiBlock :: Char -> Bool
isInEmojiBlock Char
c = Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x00A9' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x1FADF'
isRoleInGuild :: (MonadDiscord m) => T.Text -> GuildId -> m (Maybe RoleId)
isRoleInGuild :: Text -> UserId -> m (Maybe UserId)
isRoleInGuild Text
roleFragment UserId
gid = do
[Role]
roles <- UserId -> m [Role]
forall (m :: * -> *). MonadDiscord m => UserId -> m [Role]
getGuildRoles UserId
gid
let matchingRoles :: [Role]
matchingRoles = (Role -> Bool) -> [Role] -> [Role]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Role
role -> Text -> Text
T.toUpper Text
roleFragment Text -> Text -> Bool
`T.isInfixOf` Text -> Text
T.toUpper (Role -> Text
roleName Role
role)) [Role]
roles
Maybe UserId -> m (Maybe UserId)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe UserId -> m (Maybe UserId))
-> Maybe UserId -> m (Maybe UserId)
forall a b. (a -> b) -> a -> b
$ case [Role]
matchingRoles of
[] -> Maybe UserId
forall a. Maybe a
Nothing
Role
role:[Role]
rs -> UserId -> Maybe UserId
forall a. a -> Maybe a
Just (UserId -> Maybe UserId) -> UserId -> Maybe UserId
forall a b. (a -> b) -> a -> b
$ Role -> UserId
roleId Role
role
discordEmojiTextToId :: T.Text -> EmojiId
discordEmojiTextToId :: Text -> UserId
discordEmojiTextToId Text
emojiT
= case Text -> FilePath
T.unpack (Text -> FilePath) -> (Text -> Text) -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.reverse (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.takeWhile Char -> Bool
isDigit (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop Int
1
(Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.reverse Text
emojiT of
FilePath
"" -> UserId
0
FilePath
num -> FilePath -> UserId
forall a. Read a => FilePath -> a
read FilePath
num
isEmojiValid :: T.Text -> GuildId -> DiscordHandler Bool
isEmojiValid :: Text -> UserId -> DiscordHandler Bool
isEmojiValid Text
emojiT UserId
gid = do
Right Guild
guild <- GuildRequest Guild
-> DiscordHandler (Either RestCallErrorCode Guild)
forall a (r :: * -> *).
(FromJSON a, Request (r a)) =>
r a -> DiscordHandler (Either RestCallErrorCode a)
restCall (GuildRequest Guild
-> DiscordHandler (Either RestCallErrorCode Guild))
-> GuildRequest Guild
-> DiscordHandler (Either RestCallErrorCode Guild)
forall a b. (a -> b) -> a -> b
$ UserId -> GuildRequest Guild
R.GetGuild UserId
gid
let emojis :: [Emoji]
emojis = Guild -> [Emoji]
guildEmojis Guild
guild
let emojiID :: UserId
emojiID = Text -> UserId
discordEmojiTextToId Text
emojiT
let matchingEmojis :: [Emoji]
matchingEmojis = (Emoji -> Bool) -> [Emoji] -> [Emoji]
forall a. (a -> Bool) -> [a] -> [a]
filter ((UserId
emojiID UserId -> UserId -> Bool
forall a. Eq a => a -> a -> Bool
==) (UserId -> Bool) -> (Emoji -> UserId) -> Emoji -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe UserId -> UserId
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe UserId -> UserId)
-> (Emoji -> Maybe UserId) -> Emoji -> UserId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Emoji -> Maybe UserId
emojiId) [Emoji]
emojis
let isInvalid :: Bool
isInvalid = case (Text
emojiT, [Emoji]
matchingEmojis) of
(Text
"", [Emoji]
_) -> Bool
True
(Text
_, []) -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
isUnicodeEmoji Text
emojiT
(Text, [Emoji])
_ -> Bool
False
Bool -> DiscordHandler Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> DiscordHandler Bool)
-> (Bool -> Bool) -> Bool -> DiscordHandler Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> DiscordHandler Bool) -> Bool -> DiscordHandler Bool
forall a b. (a -> b) -> a -> b
$ Bool
isInvalid
converge :: Eq a => (a -> a) -> a -> a
converge :: (a -> a) -> a -> a
converge = ((a -> a) -> (a -> a -> Bool) -> a -> Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)) ((a -> a) -> a -> Bool)
-> ((a -> Bool) -> (a -> a) -> a -> a) -> (a -> a) -> a -> a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> Bool) -> (a -> a) -> a -> a
forall a. (a -> Bool) -> (a -> a) -> a -> a
until
stripAllPings :: T.Text -> T.Text
stripAllPings :: Text -> Text
stripAllPings = FilePath -> Text
T.pack (FilePath -> Text) -> (Text -> FilePath) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath) -> FilePath -> FilePath
forall a. Eq a => (a -> a) -> a -> a
converge FilePath -> FilePath
stripOnePing (FilePath -> FilePath) -> (Text -> FilePath) -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack
where
pingRE :: String
pingRE :: FilePath
pingRE = FilePath
"^@[&!]?[0-9]{8,}>"
stripOnePing :: String -> String
stripOnePing :: FilePath -> FilePath
stripOnePing [] = []
stripOnePing [Char
ch] = [Char
ch]
stripOnePing (Char
'<':FilePath
xs) = if FilePath
xs FilePath -> FilePath -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
RegexContext Regex source1 target) =>
source1 -> source -> target
=~ FilePath
pingRE
then Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'>') FilePath
xs
else Char
'<'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
xs
stripOnePing (Char
x:FilePath
xs) = Char
x Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
stripOnePing FilePath
xs
linkChannel :: ChannelId -> T.Text
linkChannel :: UserId -> Text
linkChannel UserId
c = Text
"<#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (UserId -> FilePath
forall a. Show a => a -> FilePath
show UserId
c) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"
getMessageLink :: Message -> DiscordHandler T.Text
getMessageLink :: Message -> DiscordHandler Text
getMessageLink Message
m = do
Channel
chan <- UserId -> ReaderT DiscordHandle IO Channel
forall (m :: * -> *). MonadDiscord m => UserId -> m Channel
getChannel (Message -> UserId
messageChannel Message
m)
let serverIDT :: Text
serverIDT = FilePath -> Text
T.pack (FilePath -> Text) -> (UserId -> FilePath) -> UserId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserId -> FilePath
forall a. Show a => a -> FilePath
show (UserId -> Text) -> UserId -> Text
forall a b. (a -> b) -> a -> b
$ Channel -> UserId
channelGuild Channel
chan
let channelIDT :: Text
channelIDT = FilePath -> Text
T.pack (FilePath -> Text) -> (UserId -> FilePath) -> UserId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserId -> FilePath
forall a. Show a => a -> FilePath
show (UserId -> Text) -> UserId -> Text
forall a b. (a -> b) -> a -> b
$ Message -> UserId
messageChannel Message
m
let messageIDT :: Text
messageIDT = FilePath -> Text
T.pack (FilePath -> Text) -> (UserId -> FilePath) -> UserId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserId -> FilePath
forall a. Show a => a -> FilePath
show (UserId -> Text) -> UserId -> Text
forall a b. (a -> b) -> a -> b
$ Message -> UserId
messageId Message
m
Text -> DiscordHandler Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> DiscordHandler Text) -> Text -> DiscordHandler Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [ Text
"https://discord.com/channels/",
Text
serverIDT, Text
"/",
Text
channelIDT, Text
"/",
Text
messageIDT ]
emojiToUsableText :: Emoji -> T.Text
emojiToUsableText :: Emoji -> Text
emojiToUsableText Emoji
r = do
let name :: Text
name = Emoji -> Text
emojiName Emoji
r
case Emoji -> Maybe UserId
emojiId Emoji
r of
Maybe UserId
Nothing -> Text
name
Just UserId
id -> Text
"<:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (UserId -> FilePath
forall a. Show a => a -> FilePath
show UserId
id) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"
sendMessageChan :: (MonadDiscord m) => ChannelId -> T.Text -> m ()
sendMessageChan :: UserId -> Text -> m ()
sendMessageChan UserId
c Text
xs = m Message -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Message -> m ()) -> m Message -> m ()
forall a b. (a -> b) -> a -> b
$ UserId -> Text -> m Message
forall (m :: * -> *). MonadDiscord m => UserId -> Text -> m Message
createMessage UserId
c Text
xs
sendMessageChanPingsDisabled :: (MonadDiscord m) => ChannelId -> T.Text -> m ()
sendMessageChanPingsDisabled :: UserId -> Text -> m ()
sendMessageChanPingsDisabled UserId
cid Text
t = do
let opts :: MessageDetailedOpts
opts = MessageDetailedOpts
forall a. Default a => a
def { messageDetailedContent :: Text
R.messageDetailedContent = Text
t
, messageDetailedAllowedMentions :: Maybe AllowedMentions
R.messageDetailedAllowedMentions = AllowedMentions -> Maybe AllowedMentions
forall a. a -> Maybe a
Just
(AllowedMentions -> Maybe AllowedMentions)
-> AllowedMentions -> Maybe AllowedMentions
forall a b. (a -> b) -> a -> b
$ AllowedMentions
forall a. Default a => a
def { mentionEveryone :: Bool
R.mentionEveryone = Bool
False
, mentionUsers :: Bool
R.mentionUsers = Bool
False
, mentionRoles :: Bool
R.mentionRoles = Bool
False
}
}
m Message -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Message -> m ()) -> m Message -> m ()
forall a b. (a -> b) -> a -> b
$ UserId -> MessageDetailedOpts -> m Message
forall (m :: * -> *).
MonadDiscord m =>
UserId -> MessageDetailedOpts -> m Message
createMessageDetailed UserId
cid MessageDetailedOpts
opts
sendReply :: (MonadDiscord m) => Message -> Bool -> T.Text -> m ()
sendReply :: Message -> Bool -> Text -> m ()
sendReply Message
m Bool
mention Text
xs =
m Message -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Message -> m ()) -> m Message -> m ()
forall a b. (a -> b) -> a -> b
$ UserId -> MessageDetailedOpts -> m Message
forall (m :: * -> *).
MonadDiscord m =>
UserId -> MessageDetailedOpts -> m Message
createMessageDetailed (Message -> UserId
messageChannel Message
m)
(MessageDetailedOpts -> m Message)
-> MessageDetailedOpts -> m Message
forall a b. (a -> b) -> a -> b
$ MessageDetailedOpts
forall a. Default a => a
def { messageDetailedContent :: Text
R.messageDetailedContent = Text
xs
, messageDetailedReference :: Maybe MessageReference
R.messageDetailedReference = MessageReference -> Maybe MessageReference
forall a. a -> Maybe a
Just
(MessageReference -> Maybe MessageReference)
-> MessageReference -> Maybe MessageReference
forall a b. (a -> b) -> a -> b
$ MessageReference
forall a. Default a => a
def { referenceMessageId :: Maybe UserId
referenceMessageId = UserId -> Maybe UserId
forall a. a -> Maybe a
Just (UserId -> Maybe UserId) -> UserId -> Maybe UserId
forall a b. (a -> b) -> a -> b
$ Message -> UserId
messageId Message
m }
, messageDetailedAllowedMentions :: Maybe AllowedMentions
R.messageDetailedAllowedMentions = AllowedMentions -> Maybe AllowedMentions
forall a. a -> Maybe a
Just
(AllowedMentions -> Maybe AllowedMentions)
-> AllowedMentions -> Maybe AllowedMentions
forall a b. (a -> b) -> a -> b
$ AllowedMentions
forall a. Default a => a
def { mentionRepliedUser :: Bool
R.mentionRepliedUser = Bool
mention }
}
sendMessageChanEmbed :: (MonadDiscord m) => ChannelId -> T.Text -> CreateEmbed -> m ()
sendMessageChanEmbed :: UserId -> Text -> CreateEmbed -> m ()
sendMessageChanEmbed UserId
c Text
xs CreateEmbed
e = m Message -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Message -> m ()) -> m Message -> m ()
forall a b. (a -> b) -> a -> b
$ UserId -> Text -> CreateEmbed -> m Message
forall (m :: * -> *).
MonadDiscord m =>
UserId -> Text -> CreateEmbed -> m Message
createMessageEmbed UserId
c Text
xs CreateEmbed
e
sendMessageDM :: (MonadDiscord m) => UserId -> T.Text -> m ()
sendMessageDM :: UserId -> Text -> m ()
sendMessageDM UserId
u Text
t = do
Channel
chan <- UserId -> m Channel
forall (m :: * -> *). MonadDiscord m => UserId -> m Channel
createDM UserId
u
UserId -> Text -> m ()
forall (m :: * -> *). MonadDiscord m => UserId -> Text -> m ()
sendMessageChan (Channel -> UserId
channelId Channel
chan) Text
t
sendFileChan :: (MonadDiscord m, MonadIO m) => ChannelId -> T.Text -> FilePath -> m ()
sendFileChan :: UserId -> Text -> FilePath -> m ()
sendFileChan UserId
c Text
name FilePath
fp = do
ByteString
fileContent <- IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
B.readFile FilePath
fp
m Message -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Message -> m ()) -> m Message -> m ()
forall a b. (a -> b) -> a -> b
$ UserId -> Text -> ByteString -> m Message
forall (m :: * -> *).
MonadDiscord m =>
UserId -> Text -> ByteString -> m Message
createMessageUploadFile UserId
c Text
name ByteString
fileContent
sendAssetChan :: (MonadDiscord m, MonadIO m) => ChannelId -> T.Text -> FilePath -> m ()
sendAssetChan :: UserId -> Text -> FilePath -> m ()
sendAssetChan UserId
c Text
name FilePath
path = do
FilePath
base <- IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
assetDir
UserId -> Text -> FilePath -> m ()
forall (m :: * -> *).
(MonadDiscord m, MonadIO m) =>
UserId -> Text -> FilePath -> m ()
sendFileChan UserId
c Text
name (FilePath
base FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
path)
messageFromReaction :: (MonadDiscord m) => ReactionInfo -> m Message
messageFromReaction :: ReactionInfo -> m Message
messageFromReaction ReactionInfo
r = (UserId, UserId) -> m Message
forall (m :: * -> *).
MonadDiscord m =>
(UserId, UserId) -> m Message
getChannelMessage (ReactionInfo -> UserId
reactionChannelId ReactionInfo
r, ReactionInfo -> UserId
reactionMessageId ReactionInfo
r)
addReaction :: ChannelId -> MessageId -> T.Text -> DiscordHandler ()
addReaction :: UserId -> UserId -> Text -> DiscordHandler ()
addReaction UserId
c UserId
m Text
t = ChannelRequest () -> DiscordHandler (Either RestCallErrorCode ())
forall a (r :: * -> *).
(FromJSON a, Request (r a)) =>
r a -> DiscordHandler (Either RestCallErrorCode a)
restCall ((UserId, UserId) -> Text -> ChannelRequest ()
R.CreateReaction (UserId
c, UserId
m) Text
t) DiscordHandler (Either RestCallErrorCode ())
-> DiscordHandler () -> DiscordHandler ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> DiscordHandler ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
isMod :: Message -> DiscordHandler Bool
isMod :: Message -> DiscordHandler Bool
isMod Message
m = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool)
-> ReaderT DiscordHandle IO [Bool] -> DiscordHandler Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> DiscordHandler Bool)
-> [Text] -> ReaderT DiscordHandle IO [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Message -> Text -> DiscordHandler Bool
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m Bool
hasRoleByName Message
m) [Text
"Mod", Text
"Moderator"]
isNotMutExWith :: Eq a => [a] -> [a] -> Bool
isNotMutExWith :: [a] -> [a] -> Bool
isNotMutExWith [a]
x [a]
y = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) (a -> a -> Bool) -> [a] -> [a -> Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
x [a -> Bool] -> [a] -> [Bool]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a]
y
hasRoleByName :: (MonadDiscord m) => Message -> T.Text -> m Bool
hasRoleByName :: Message -> Text -> m Bool
hasRoleByName Message
m Text
r = case Message -> Maybe UserId
messageGuild Message
m of
Maybe UserId
Nothing -> Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
Just UserId
g -> do
[Role]
filtered <- UserId -> UserId -> m [Role]
forall (m :: * -> *).
MonadDiscord m =>
UserId -> UserId -> m [Role]
getRolesOfUserInGuild (User -> UserId
userId (User -> UserId) -> User -> UserId
forall a b. (a -> b) -> a -> b
$ Message -> User
messageAuthor Message
m) UserId
g
Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Text
r Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Role -> Text) -> [Role] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Role -> Text
roleName [Role]
filtered
hasRoleByID :: (MonadDiscord m) => Message -> RoleId -> m Bool
hasRoleByID :: Message -> UserId -> m Bool
hasRoleByID Message
m UserId
r = case Message -> Maybe UserId
messageGuild Message
m of
Maybe UserId
Nothing -> Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
Just UserId
g -> do
[Role]
filtered <- UserId -> UserId -> m [Role]
forall (m :: * -> *).
MonadDiscord m =>
UserId -> UserId -> m [Role]
getRolesOfUserInGuild (User -> UserId
userId (User -> UserId) -> User -> UserId
forall a b. (a -> b) -> a -> b
$ Message -> User
messageAuthor Message
m) UserId
g
Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ UserId
r UserId -> [UserId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Role -> UserId) -> [Role] -> [UserId]
forall a b. (a -> b) -> [a] -> [b]
map Role -> UserId
roleId [Role]
filtered
checkAllIDs :: (MonadDiscord m) => Message -> IO [m Bool]
checkAllIDs :: Message -> IO [m Bool]
checkAllIDs Message
m = do
[Text]
devFile <- FilePath -> IO [Text]
readSingleColCSV FilePath
devIDs
let devRoleIDs :: [UserId]
devRoleIDs = ((FilePath -> UserId
forall a. Read a => FilePath -> a
read (FilePath -> UserId) -> (Text -> FilePath) -> Text -> UserId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack) :: (T.Text -> RoleId)) (Text -> UserId) -> [Text] -> [UserId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
devFile
[m Bool] -> IO [m Bool]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([m Bool] -> IO [m Bool]) -> [m Bool] -> IO [m Bool]
forall a b. (a -> b) -> a -> b
$ (UserId -> m Bool) -> [UserId] -> [m Bool]
forall a b. (a -> b) -> [a] -> [b]
map (Message -> UserId -> m Bool
forall (m :: * -> *). MonadDiscord m => Message -> UserId -> m Bool
hasRoleByID Message
m) [UserId]
devRoleIDs
isSenderDeveloper :: (MonadDiscord m, MonadIO m) => Message -> m Bool
isSenderDeveloper :: Message -> m Bool
isSenderDeveloper Message
m = ([Bool] -> Bool) -> m [Bool] -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or (m [Bool] -> m Bool)
-> (IO (m [Bool]) -> m [Bool]) -> IO (m [Bool]) -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (m [Bool]) -> m [Bool]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m [Bool]) -> m [Bool])
-> (IO (m [Bool]) -> m (m [Bool])) -> IO (m [Bool]) -> m [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (m [Bool]) -> m (m [Bool])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (m [Bool]) -> m Bool) -> IO (m [Bool]) -> m Bool
forall a b. (a -> b) -> a -> b
$ [m Bool] -> m [Bool]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([m Bool] -> m [Bool]) -> IO [m Bool] -> IO (m [Bool])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message -> IO [m Bool]
forall (m :: * -> *). MonadDiscord m => Message -> IO [m Bool]
checkAllIDs Message
m
channelRequirement :: (MonadDiscord m) => String -> Message -> m (Maybe T.Text)
channelRequirement :: FilePath -> Message -> m (Maybe Text)
channelRequirement FilePath
cid Message
msg = if Message -> UserId
messageChannel Message
msg UserId -> UserId -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> UserId
forall a. Read a => FilePath -> a
read FilePath
cid
then Maybe Text -> m (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
else Maybe Text -> m (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> m (Maybe Text)) -> Maybe Text -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"need to be in channel"
roleNameRequirement :: (MonadDiscord m) => [T.Text] -> Message -> m (Maybe T.Text)
roleNameRequirement :: [Text] -> Message -> m (Maybe Text)
roleNameRequirement [Text]
names Message
msg = do
Bool
check <- [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> m [Bool] -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> m Bool) -> [Text] -> m [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Message -> Text -> m Bool
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m Bool
hasRoleByName Message
msg) [Text]
names
Maybe Text -> m (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> m (Maybe Text)) -> Maybe Text -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ if Bool
check
then Maybe Text
forall a. Maybe a
Nothing
else Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"need to have one of: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (FilePath -> Text
T.pack (FilePath -> Text) -> ([Text] -> FilePath) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> FilePath
forall a. Show a => a -> FilePath
show) [Text]
names
developerRequirement :: (MonadDiscord m, MonadIO m) => Message -> m (Maybe T.Text)
developerRequirement :: Message -> m (Maybe Text)
developerRequirement Message
msg = do
UserId -> m ()
forall (m :: * -> *). MonadDiscord m => UserId -> m ()
triggerTypingIndicator (Message -> UserId
messageChannel Message
msg)
Bool
check <- Message -> m Bool
forall (m :: * -> *).
(MonadDiscord m, MonadIO m) =>
Message -> m Bool
isSenderDeveloper Message
msg
Maybe Text -> m (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> m (Maybe Text)) -> Maybe Text -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ if Bool
check
then Maybe Text
forall a. Maybe a
Nothing
else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"need to be a developer"
getRolesOfUserInGuild :: (MonadDiscord m) => UserId -> GuildId -> m [Role]
getRolesOfUserInGuild :: UserId -> UserId -> m [Role]
getRolesOfUserInGuild UserId
uid UserId
g = do
[Role]
allGuildRoles <- UserId -> m [Role]
forall (m :: * -> *). MonadDiscord m => UserId -> m [Role]
getGuildRoles UserId
g
GuildMember
user <- UserId -> UserId -> m GuildMember
forall (m :: * -> *).
MonadDiscord m =>
UserId -> UserId -> m GuildMember
getGuildMember UserId
g UserId
uid
let userRolesInGuild :: [Role]
userRolesInGuild = (Role -> Bool) -> [Role] -> [Role]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Role
x -> Role -> UserId
roleId Role
x UserId -> [UserId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` GuildMember -> [UserId]
memberRoles GuildMember
user) [Role]
allGuildRoles
[Role] -> m [Role]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Role]
userRolesInGuild
getTimestampFromMessage :: Message -> T.Text
getTimestampFromMessage :: Message -> Text
getTimestampFromMessage Message
m = FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ TimeLocale -> FilePath -> UTCTime -> FilePath
forall t. FormatTime t => TimeLocale -> FilePath -> t -> FilePath
TF.formatTime TimeLocale
TF.defaultTimeLocale FilePath
"%Y-%m-%d %H:%M:%S %Z" (Message -> UTCTime
messageTimestamp Message
m)
captureCommandOutput :: String -> IO T.Text
captureCommandOutput :: FilePath -> IO Text
captureCommandOutput FilePath
command = do
let (FilePath
executable:[FilePath]
args) = FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn FilePath
" " FilePath
command
FilePath
output <- CreateProcess -> FilePath -> IO FilePath
Process.readCreateProcess ((FilePath -> [FilePath] -> CreateProcess
Process.proc FilePath
executable [FilePath]
args) {
cwd :: Maybe FilePath
cwd = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"."
}) FilePath
""
Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
output
update :: IO Bool
update :: IO Bool
update = do
ProcessHandle
process <- FilePath -> IO ProcessHandle
Process.spawnCommand (FilePath
"cd " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
repoDir FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" && git reset --hard @{u} && git pull && stack install")
ExitCode
exitcode <- ProcessHandle -> IO ExitCode
Process.waitForProcess ProcessHandle
process
Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ case ExitCode
exitcode of
ExitCode
ExitSuccess -> Bool
True
ExitFailure Int
_ -> Bool
False
newCommand :: Message
-> T.Text
-> ([T.Text] -> DiscordHandler ())
-> DiscordHandler ()
newCommand :: Message
-> Text -> ([Text] -> DiscordHandler ()) -> DiscordHandler ()
newCommand Message
msg Text
cmd [Text] -> DiscordHandler ()
funct = Bool -> DiscordHandler () -> DiscordHandler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text
shouldNotBeEmpty Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"") (DiscordHandler () -> DiscordHandler ())
-> DiscordHandler () -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ [Text] -> DiscordHandler ()
funct [Text]
captures
where
match :: ( T.Text
, T.Text
, T.Text
, [T.Text]
)
match :: (Text, Text, Text, [Text])
match@(Text
_, Text
shouldNotBeEmpty, Text
_, [Text]
captures) = Message -> Text
messageText Message
msg Text -> Text -> (Text, Text, Text, [Text])
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
RegexContext Regex source1 target) =>
source1 -> source -> target
=~ (Text
"^:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cmd Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
trailingWS)
newDevCommand :: Message
-> T.Text
-> ([T.Text] -> DiscordHandler ())
-> DiscordHandler ()
newDevCommand :: Message
-> Text -> ([Text] -> DiscordHandler ()) -> DiscordHandler ()
newDevCommand Message
msg Text
cmd [Text] -> DiscordHandler ()
fun = Message
-> Text -> ([Text] -> DiscordHandler ()) -> DiscordHandler ()
newCommand Message
msg Text
cmd (([Text] -> DiscordHandler ()) -> DiscordHandler ())
-> ([Text] -> DiscordHandler ()) -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ \[Text]
captures -> do
Bool
isDev <- Message -> DiscordHandler Bool
forall (m :: * -> *).
(MonadDiscord m, MonadIO m) =>
Message -> m Bool
isSenderDeveloper Message
msg
if Bool
isDev
then [Text] -> DiscordHandler ()
fun [Text]
captures
else Message -> DiscordHandler ()
sendPrivError Message
msg
newModCommand :: Message
-> T.Text
-> ([T.Text ] -> DiscordHandler ())
-> DiscordHandler ()
newModCommand :: Message
-> Text -> ([Text] -> DiscordHandler ()) -> DiscordHandler ()
newModCommand Message
msg Text
cmd [Text] -> DiscordHandler ()
fun = Message
-> Text -> ([Text] -> DiscordHandler ()) -> DiscordHandler ()
newCommand Message
msg Text
cmd (([Text] -> DiscordHandler ()) -> DiscordHandler ())
-> ([Text] -> DiscordHandler ()) -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ \[Text]
captures -> do
Bool
isMod <- Message -> DiscordHandler Bool
isMod Message
msg
if Bool
isMod
then [Text] -> DiscordHandler ()
fun [Text]
captures
else Message -> DiscordHandler ()
sendPrivError Message
msg
sendPrivError :: Message -> DiscordHandler ()
sendPrivError :: Message -> DiscordHandler ()
sendPrivError Message
msg = UserId -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => UserId -> Text -> m ()
sendMessageDM (User -> UserId
userId (User -> UserId) -> User -> UserId
forall a b. (a -> b) -> a -> b
$ Message -> User
messageAuthor Message
msg) (Text -> DiscordHandler ()) -> Text -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
owoify Text
"Insufficient privileges!"
snowflakeToInt :: Snowflake -> Integer
snowflakeToInt :: UserId -> Integer
snowflakeToInt (Snowflake Word64
w) = Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger Word64
w
moveChannel :: GuildId -> ChannelId -> Int -> DiscordHandler ()
moveChannel :: UserId -> UserId -> Int -> DiscordHandler ()
moveChannel UserId
guild UserId
chan Int
location = ReaderT DiscordHandle IO (Either RestCallErrorCode [Channel])
-> DiscordHandler ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT DiscordHandle IO (Either RestCallErrorCode [Channel])
-> DiscordHandler ())
-> ReaderT DiscordHandle IO (Either RestCallErrorCode [Channel])
-> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ GuildRequest [Channel]
-> ReaderT DiscordHandle IO (Either RestCallErrorCode [Channel])
forall a (r :: * -> *).
(FromJSON a, Request (r a)) =>
r a -> DiscordHandler (Either RestCallErrorCode a)
restCall (GuildRequest [Channel]
-> ReaderT DiscordHandle IO (Either RestCallErrorCode [Channel]))
-> GuildRequest [Channel]
-> ReaderT DiscordHandle IO (Either RestCallErrorCode [Channel])
forall a b. (a -> b) -> a -> b
$ UserId -> [(UserId, Int)] -> GuildRequest [Channel]
R.ModifyGuildChannelPositions UserId
guild [(UserId
chan, Int
location)]