{-# LANGUAGE OverloadedStrings #-}

module Admin ( receivers, sendGitInfoChan, sendInstanceInfoChan ) where

import qualified Data.Text as T
import           Discord.Types
import           Discord                ( DiscordHandler
                                        , stopDiscord, restCall
                                        )
import           Discord.Requests as R
import           UnliftIO               ( liftIO )
import           Data.Char              ( isSpace )
import Data.Maybe                       ( fromJust )
import           Control.Monad          ( unless
                                        , void
                                        )
import           Network.BSD            ( getHostName )
import           Text.Regex.TDFA        ( (=~) )

import           System.Directory       ( doesPathExist )
import           System.Posix.Process   ( getProcessID )
import qualified System.Process as Process

import           Command
import           Owoifier               ( owoify )

import           Utils                  ( newDevCommand
                                        , newModCommand
                                        , sendMessageChan
                                        , captureCommandOutput
                                        , devIDs
                                        , update
                                        , developerRequirement
                                        , roleNameRequirement
                                        )
import           Status                 ( editStatusFile
                                        , updateStatus
                                        )
import           CSV                    ( readSingleColCSV
                                        , writeSingleColCSV
                                        )

receivers :: [Message -> DiscordHandler ()]
receivers :: [Message -> DiscordHandler ()]
receivers = (Command DiscordHandler -> Message -> DiscordHandler ())
-> [Command DiscordHandler] -> [Message -> DiscordHandler ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Command DiscordHandler -> Message -> DiscordHandler ()
forall (m :: * -> *).
MonadDiscord m =>
Command m -> Message -> m ()
runCommand
    [ Command DiscordHandler
sendGitInfo
    , Command DiscordHandler
sendInstanceInfo
    , Command DiscordHandler
restartOwen
    , Command DiscordHandler
stopOwen
    , Command DiscordHandler
updateOwen
    , Command DiscordHandler
setStatus
    , Command DiscordHandler
forall (m :: * -> *). MonadDiscord m => Command m
someComplexThing
    , Command DiscordHandler
devs
    , Command DiscordHandler
lockdown
    , Command DiscordHandler
unlock
    , Command DiscordHandler
lockAll
    , Command DiscordHandler
unlockAll
    ]

rstrip :: T.Text -> T.Text
rstrip :: Text -> Text
rstrip = 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.dropWhile Char -> Bool
isSpace (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.reverse

-- captureCommandOutput appends newlines automatically
gitLocal, gitRemote, commitsAhead :: IO T.Text
gitLocal :: IO Text
gitLocal = String -> IO Text
captureCommandOutput String
"git rev-parse HEAD"
gitRemote :: IO Text
gitRemote = String -> IO Text
captureCommandOutput String
"git fetch"
  IO Text -> IO Text -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO Text
captureCommandOutput String
"git rev-parse origin/main"
commitsAhead :: IO Text
commitsAhead = String -> IO Text
captureCommandOutput String
"git fetch"
  IO Text -> IO Text -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO Text
captureCommandOutput String
"git rev-list --count HEAD..origin/main"

isGitRepo :: IO Bool
isGitRepo :: IO Bool
isGitRepo = String -> IO Bool
doesPathExist String
".git"

sendGitInfo :: Command DiscordHandler
sendGitInfo :: Command DiscordHandler
sendGitInfo
    = (Message -> DiscordHandler (Maybe Text))
-> Command DiscordHandler -> Command DiscordHandler
forall (m :: * -> *).
(Message -> m (Maybe Text)) -> Command m -> Command m
requires Message -> DiscordHandler (Maybe Text)
forall (m :: * -> *).
(MonadDiscord m, MonadIO m) =>
Message -> m (Maybe Text)
developerRequirement
    (Command DiscordHandler -> Command DiscordHandler)
-> ((Message -> DiscordHandler ()) -> Command DiscordHandler)
-> (Message -> DiscordHandler ())
-> Command DiscordHandler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Message -> DiscordHandler ()) -> Command DiscordHandler
forall (m :: * -> *) h.
(CommandHandlerType m h, MonadDiscord m) =>
Text -> h -> Command m
command Text
"repo" ((Message -> DiscordHandler ()) -> Command DiscordHandler)
-> (Message -> DiscordHandler ()) -> Command DiscordHandler
forall a b. (a -> b) -> a -> b
$ \Message
m ->
        ChannelId -> DiscordHandler ()
forall (m :: * -> *).
(MonadDiscord m, MonadIO m) =>
ChannelId -> m ()
sendGitInfoChan (ChannelId -> DiscordHandler ()) -> ChannelId -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Message -> ChannelId
messageChannel Message
m

sendGitInfoChan :: (MonadDiscord m, MonadIO m) => ChannelId -> m ()
sendGitInfoChan :: ChannelId -> m ()
sendGitInfoChan ChannelId
chan = do
    Bool
inRepo <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Bool
isGitRepo
    if Bool -> Bool
not Bool
inRepo then
        ChannelId -> Text -> m ()
forall (m :: * -> *). MonadDiscord m => ChannelId -> Text -> m ()
sendMessageChan ChannelId
chan Text
"Not in git repo (sorry)!"
    else do
        Text
loc <- IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Text
gitLocal
        Text
remote <- IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Text
gitRemote
        Text
commits <- IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Text
commitsAhead
        ChannelId -> Text -> m ()
forall (m :: * -> *). MonadDiscord m => ChannelId -> Text -> m ()
sendMessageChan ChannelId
chan (Text
"Git Status Info: \n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                              Text
"Local at: "  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
loc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                              Text
"Remote at: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
remote Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                              Text
"Remote is "  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
rstrip Text
commits Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" commits ahead")

sendInstanceInfo :: Command DiscordHandler
sendInstanceInfo :: Command DiscordHandler
sendInstanceInfo
  = (Message -> DiscordHandler (Maybe Text))
-> Command DiscordHandler -> Command DiscordHandler
forall (m :: * -> *).
(Message -> m (Maybe Text)) -> Command m -> Command m
requires Message -> DiscordHandler (Maybe Text)
forall (m :: * -> *).
(MonadDiscord m, MonadIO m) =>
Message -> m (Maybe Text)
developerRequirement
  (Command DiscordHandler -> Command DiscordHandler)
-> ((Message -> DiscordHandler ()) -> Command DiscordHandler)
-> (Message -> DiscordHandler ())
-> Command DiscordHandler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Message -> DiscordHandler ()) -> Command DiscordHandler
forall (m :: * -> *) h.
(CommandHandlerType m h, MonadDiscord m) =>
Text -> h -> Command m
command Text
"instance" ((Message -> DiscordHandler ()) -> Command DiscordHandler)
-> (Message -> DiscordHandler ()) -> Command DiscordHandler
forall a b. (a -> b) -> a -> b
$ \Message
m -> 
        ChannelId -> DiscordHandler ()
forall (m :: * -> *).
(MonadDiscord m, MonadIO m) =>
ChannelId -> m ()
sendInstanceInfoChan (ChannelId -> DiscordHandler ()) -> ChannelId -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Message -> ChannelId
messageChannel Message
m

sendInstanceInfoChan :: (MonadDiscord m, MonadIO m) => ChannelId -> m ()
sendInstanceInfoChan :: ChannelId -> m ()
sendInstanceInfoChan ChannelId
chan = do
    String
host <- IO String -> m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getHostName
    ProcessID
pid  <- IO ProcessID -> m ProcessID
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ProcessID
getProcessID
    ChannelId -> Text -> m ()
forall (m :: * -> *). MonadDiscord m => ChannelId -> Text -> m ()
sendMessageChan ChannelId
chan (Text
"Instance Info: \n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                          Text
"Host: "            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
host Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                          Text
"Process ID: "      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (ProcessID -> String
forall a. Show a => a -> String
show ProcessID
pid))

restartOwen :: Command DiscordHandler
restartOwen :: Command DiscordHandler
restartOwen
  = (Message -> DiscordHandler (Maybe Text))
-> Command DiscordHandler -> Command DiscordHandler
forall (m :: * -> *).
(Message -> m (Maybe Text)) -> Command m -> Command m
requires Message -> DiscordHandler (Maybe Text)
forall (m :: * -> *).
(MonadDiscord m, MonadIO m) =>
Message -> m (Maybe Text)
developerRequirement
  (Command DiscordHandler -> Command DiscordHandler)
-> ((Message -> DiscordHandler ()) -> Command DiscordHandler)
-> (Message -> DiscordHandler ())
-> Command DiscordHandler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Message -> DiscordHandler ()) -> Command DiscordHandler
forall (m :: * -> *) h.
(CommandHandlerType m h, MonadDiscord m) =>
Text -> h -> Command m
command Text
"restart" ((Message -> DiscordHandler ()) -> Command DiscordHandler)
-> (Message -> DiscordHandler ()) -> Command DiscordHandler
forall a b. (a -> b) -> a -> b
$ \Message
m -> do
        ChannelId -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => ChannelId -> Text -> m ()
sendMessageChan (Message -> ChannelId
messageChannel Message
m) Text
"Restarting"
        ReaderT DiscordHandle IO ProcessHandle -> DiscordHandler ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT DiscordHandle IO ProcessHandle -> DiscordHandler ())
-> ReaderT DiscordHandle IO ProcessHandle -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ IO ProcessHandle -> ReaderT DiscordHandle IO ProcessHandle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProcessHandle -> ReaderT DiscordHandle IO ProcessHandle)
-> IO ProcessHandle -> ReaderT DiscordHandle IO ProcessHandle
forall a b. (a -> b) -> a -> b
$ String -> IO ProcessHandle
Process.spawnCommand String
"owenbot-exe"
        DiscordHandler ()
stopDiscord

-- | Stops the entire Discord chain.
stopOwen :: Command DiscordHandler
stopOwen :: Command DiscordHandler
stopOwen
  = (Message -> DiscordHandler (Maybe Text))
-> Command DiscordHandler -> Command DiscordHandler
forall (m :: * -> *).
(Message -> m (Maybe Text)) -> Command m -> Command m
requires Message -> DiscordHandler (Maybe Text)
forall (m :: * -> *).
(MonadDiscord m, MonadIO m) =>
Message -> m (Maybe Text)
developerRequirement
  (Command DiscordHandler -> Command DiscordHandler)
-> ((Message -> DiscordHandler ()) -> Command DiscordHandler)
-> (Message -> DiscordHandler ())
-> Command DiscordHandler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Message -> DiscordHandler ()) -> Command DiscordHandler
forall (m :: * -> *) h.
(CommandHandlerType m h, MonadDiscord m) =>
Text -> h -> Command m
command Text
"stop" ((Message -> DiscordHandler ()) -> Command DiscordHandler)
-> (Message -> DiscordHandler ()) -> Command DiscordHandler
forall a b. (a -> b) -> a -> b
$ \Message
m -> do
        ChannelId -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => ChannelId -> Text -> m ()
sendMessageChan (Message -> ChannelId
messageChannel Message
m) Text
"Stopping."
        DiscordHandler ()
stopDiscord

updateOwen :: Command DiscordHandler
updateOwen :: Command DiscordHandler
updateOwen
  = (Message -> DiscordHandler (Maybe Text))
-> Command DiscordHandler -> Command DiscordHandler
forall (m :: * -> *).
(Message -> m (Maybe Text)) -> Command m -> Command m
requires Message -> DiscordHandler (Maybe Text)
forall (m :: * -> *).
(MonadDiscord m, MonadIO m) =>
Message -> m (Maybe Text)
developerRequirement
  (Command DiscordHandler -> Command DiscordHandler)
-> ((Message -> DiscordHandler ()) -> Command DiscordHandler)
-> (Message -> DiscordHandler ())
-> Command DiscordHandler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Message -> DiscordHandler ()) -> Command DiscordHandler
forall (m :: * -> *) h.
(CommandHandlerType m h, MonadDiscord m) =>
Text -> h -> Command m
command Text
"update" ((Message -> DiscordHandler ()) -> Command DiscordHandler)
-> (Message -> DiscordHandler ()) -> Command DiscordHandler
forall a b. (a -> b) -> a -> b
$ \Message
m -> do
        Message -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m ()
respond Message
m Text
"Updating Owen"
        Bool
result <- IO Bool -> DiscordHandler Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Bool
update
        if Bool
result then
            Message -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m ()
respond Message
m (Text -> DiscordHandler ()) -> Text -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
owoify Text
"Finished update"
        else
            Message -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m ()
respond Message
m (Text -> DiscordHandler ()) -> Text -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
owoify Text
"Failed to update! Please check the logs"

-- DEV COMMANDS
getDevs :: IO [T.Text]
getDevs :: IO [Text]
getDevs = String -> IO [Text]
readSingleColCSV String
devIDs

setDevs :: [T.Text] -> IO ()
setDevs :: [Text] -> IO ()
setDevs = String -> [Text] -> IO ()
writeSingleColCSV String
devIDs

devs :: Command DiscordHandler
devs :: Command DiscordHandler
devs
    = (Message -> DiscordHandler (Maybe Text))
-> Command DiscordHandler -> Command DiscordHandler
forall (m :: * -> *).
(Message -> m (Maybe Text)) -> Command m -> Command m
requires Message -> DiscordHandler (Maybe Text)
forall (m :: * -> *).
(MonadDiscord m, MonadIO m) =>
Message -> m (Maybe Text)
developerRequirement
    (Command DiscordHandler -> Command DiscordHandler)
-> ((Message -> Maybe (Text, ChannelId) -> DiscordHandler ())
    -> Command DiscordHandler)
-> (Message -> Maybe (Text, ChannelId) -> DiscordHandler ())
-> Command DiscordHandler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Command DiscordHandler -> Command DiscordHandler
forall (m :: * -> *). Text -> Command m -> Command m
help Text
"List/add/remove registered developer role IDs"
    (Command DiscordHandler -> Command DiscordHandler)
-> ((Message -> Maybe (Text, ChannelId) -> DiscordHandler ())
    -> Command DiscordHandler)
-> (Message -> Maybe (Text, ChannelId) -> DiscordHandler ())
-> Command DiscordHandler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> (Message -> Maybe (Text, ChannelId) -> DiscordHandler ())
-> Command DiscordHandler
forall (m :: * -> *) h.
(CommandHandlerType m h, MonadDiscord m) =>
Text -> h -> Command m
command Text
"devs" ((Message -> Maybe (Text, ChannelId) -> DiscordHandler ())
 -> Command DiscordHandler)
-> (Message -> Maybe (Text, ChannelId) -> DiscordHandler ())
-> Command DiscordHandler
forall a b. (a -> b) -> a -> b
$ \Message
m Maybe (Text, ChannelId)
maybeActionValue -> do
        [Text]
contents <- IO [Text] -> ReaderT DiscordHandle IO [Text]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [Text]
getDevs
        case Maybe (Text, ChannelId)
maybeActionValue :: Maybe (T.Text, RoleId) of
            Maybe (Text, ChannelId)
Nothing -> do
                Bool -> DiscordHandler () -> DiscordHandler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
contents) (DiscordHandler () -> DiscordHandler ())
-> DiscordHandler () -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$
                    Message -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m ()
respond Message
m (Text -> DiscordHandler ()) -> Text -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" [Text]
contents
            Just (Text
"add", ChannelId
roleId) -> do
                IO () -> DiscordHandler ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DiscordHandler ()) -> IO () -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ [Text] -> IO ()
setDevs (String -> Text
T.pack (ChannelId -> String
forall a. Show a => a -> String
show ChannelId
roleId)Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
contents)
                Message -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m ()
respond Message
m Text
"Added!"
            Just (Text
"remove", ChannelId
roleId) -> do
                IO () -> DiscordHandler ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DiscordHandler ()) -> IO () -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ [Text] -> IO ()
setDevs ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= String -> Text
T.pack (ChannelId -> String
forall a. Show a => a -> String
show ChannelId
roleId)) [Text]
contents)
                Message -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m ()
respond Message
m Text
"Removed!"
            Just (Text, ChannelId)
_ -> Message -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m ()
respond Message
m Text
"Usage: `:devs {add|remove} <roleId>"

statusRE :: T.Text
statusRE :: Text
statusRE = Text
"(online|idle|dnd|invisible) "
           Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(playing|streaming|competing|listening to) "
           Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(.*)"

-- | This can't be polymoprhic because updateStatus requires gateway specific
-- things.
setStatus :: Command DiscordHandler
setStatus :: Command DiscordHandler
setStatus
    = Text
-> (Message
    -> UpdateStatusType
    -> ActivityType
    -> RemainingText
    -> DiscordHandler ())
-> Command DiscordHandler
forall (m :: * -> *) h.
(CommandHandlerType m h, MonadDiscord m) =>
Text -> h -> Command m
command Text
"status"
    ((Message
  -> UpdateStatusType
  -> ActivityType
  -> RemainingText
  -> DiscordHandler ())
 -> Command DiscordHandler)
-> (Message
    -> UpdateStatusType
    -> ActivityType
    -> RemainingText
    -> DiscordHandler ())
-> Command DiscordHandler
forall a b. (a -> b) -> a -> b
$ \Message
msg UpdateStatusType
newStatus ActivityType
newType (Remaining Text
newName) -> do
        UpdateStatusType -> ActivityType -> Text -> DiscordHandler ()
updateStatus UpdateStatusType
newStatus ActivityType
newType Text
newName
        IO () -> DiscordHandler ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DiscordHandler ()) -> IO () -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ UpdateStatusType -> ActivityType -> Text -> IO ()
editStatusFile UpdateStatusType
newStatus ActivityType
newType Text
newName
        Message -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m ()
respond Message
msg
            Text
"Status updated :) Keep in mind it may take up to a minute for your client to refresh."

someComplexThing :: (MonadDiscord m) => Command m
someComplexThing :: Command m
someComplexThing
    = Text -> (Message -> [Text] -> m ()) -> Command m
forall (m :: * -> *) h.
(CommandHandlerType m h, MonadDiscord m) =>
Text -> h -> Command m
command Text
"complex"
    ((Message -> [Text] -> m ()) -> Command m)
-> (Message -> [Text] -> m ()) -> Command m
forall a b. (a -> b) -> a -> b
$ \Message
msg [Text]
words -> do
        Message -> Text -> m ()
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m ()
respond Message
msg (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
            Text
"Length: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (String -> Text) -> ([Text] -> String) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> ([Text] -> Int) -> [Text] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) [Text]
words Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                Text
"Caught items: \n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"\n" [Text]
words


data Lock = Lockdown | Unlock deriving (Int -> Lock -> ShowS
[Lock] -> ShowS
Lock -> String
(Int -> Lock -> ShowS)
-> (Lock -> String) -> ([Lock] -> ShowS) -> Show Lock
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Lock] -> ShowS
$cshowList :: [Lock] -> ShowS
show :: Lock -> String
$cshow :: Lock -> String
showsPrec :: Int -> Lock -> ShowS
$cshowsPrec :: Int -> Lock -> ShowS
Show, Lock -> Lock -> Bool
(Lock -> Lock -> Bool) -> (Lock -> Lock -> Bool) -> Eq Lock
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Lock -> Lock -> Bool
$c/= :: Lock -> Lock -> Bool
== :: Lock -> Lock -> Bool
$c== :: Lock -> Lock -> Bool
Eq)

lockdown :: Command DiscordHandler
lockdown :: Command DiscordHandler
lockdown
    = (Message -> DiscordHandler (Maybe Text))
-> Command DiscordHandler -> Command DiscordHandler
forall (m :: * -> *).
(Message -> m (Maybe Text)) -> Command m -> Command m
requires ([Text] -> Message -> DiscordHandler (Maybe Text)
forall (m :: * -> *).
MonadDiscord m =>
[Text] -> Message -> m (Maybe Text)
roleNameRequirement [Text
"Mod", Text
"Moderator"])
    (Command DiscordHandler -> Command DiscordHandler)
-> ((Message -> DiscordHandler ()) -> Command DiscordHandler)
-> (Message -> DiscordHandler ())
-> Command DiscordHandler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Message -> DiscordHandler ()) -> Command DiscordHandler
forall (m :: * -> *) h.
(CommandHandlerType m h, MonadDiscord m) =>
Text -> h -> Command m
command Text
"lockdown" ((Message -> DiscordHandler ()) -> Command DiscordHandler)
-> (Message -> DiscordHandler ()) -> Command DiscordHandler
forall a b. (a -> b) -> a -> b
$ \Message
m -> do
        let chan :: ChannelId
chan = Message -> ChannelId
messageChannel Message
m
        Channel
channel <- ChannelId -> DiscordHandler Channel
forall (m :: * -> *). MonadDiscord m => ChannelId -> m Channel
getChannel ChannelId
chan
        case Channel
channel of
            ChannelText ChannelId
_ ChannelId
guild Text
_ Integer
_ [Overwrite]
_ Integer
_ Bool
_ Text
_ Maybe ChannelId
_ Maybe ChannelId
_ -> do
                -- Guild is used in place of role ID as guildID == @everyone role ID
                ChannelId -> ChannelId -> Lock -> DiscordHandler ()
forall (m :: * -> *).
MonadDiscord m =>
ChannelId -> ChannelId -> Lock -> m ()
lockdownChan ChannelId
chan ChannelId
guild Lock
Lockdown
                Message -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m ()
respond Message
m (Text -> DiscordHandler ()) -> Text -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
owoify Text
"Locking Channel. To unlock use :unlock"

            Channel
_ -> do Message -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m ()
respond Message
m (Text -> DiscordHandler ()) -> Text -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
owoify Text
"channel is not a valid Channel"

unlock :: Command DiscordHandler
unlock :: Command DiscordHandler
unlock
  = (Message -> DiscordHandler (Maybe Text))
-> Command DiscordHandler -> Command DiscordHandler
forall (m :: * -> *).
(Message -> m (Maybe Text)) -> Command m -> Command m
requires ([Text] -> Message -> DiscordHandler (Maybe Text)
forall (m :: * -> *).
MonadDiscord m =>
[Text] -> Message -> m (Maybe Text)
roleNameRequirement [Text
"Mod", Text
"Moderator"])
  (Command DiscordHandler -> Command DiscordHandler)
-> ((Message -> DiscordHandler ()) -> Command DiscordHandler)
-> (Message -> DiscordHandler ())
-> Command DiscordHandler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Message -> DiscordHandler ()) -> Command DiscordHandler
forall (m :: * -> *) h.
(CommandHandlerType m h, MonadDiscord m) =>
Text -> h -> Command m
command Text
"unlock" ((Message -> DiscordHandler ()) -> Command DiscordHandler)
-> (Message -> DiscordHandler ()) -> Command DiscordHandler
forall a b. (a -> b) -> a -> b
$ \Message
m -> do
      let chan :: ChannelId
chan = Message -> ChannelId
messageChannel Message
m
      Channel
channel <- ChannelId -> DiscordHandler Channel
forall (m :: * -> *). MonadDiscord m => ChannelId -> m Channel
getChannel ChannelId
chan
      case Channel
channel of
          ChannelText ChannelId
_ ChannelId
guild Text
_ Integer
_ [Overwrite]
_ Integer
_ Bool
_ Text
_ Maybe ChannelId
_ Maybe ChannelId
_ -> do
              -- Guild is used in place of role ID as guildID == @everyone role ID
              ChannelId -> ChannelId -> Lock -> DiscordHandler ()
forall (m :: * -> *).
MonadDiscord m =>
ChannelId -> ChannelId -> Lock -> m ()
lockdownChan ChannelId
chan ChannelId
guild Lock
Unlock
              Message -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m ()
respond Message
m (Text -> DiscordHandler ()) -> Text -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
owoify Text
"Unlocking channel, GLHF!"
          Channel
_ -> do Message -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m ()
respond Message
m (Text -> DiscordHandler ()) -> Text -> DiscordHandler ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
owoify Text
"channel is not a valid Channel (How the fuck did you pull that off?)"


lockdownChan :: (MonadDiscord m) => ChannelId -> OverwriteId -> Lock -> m ()
lockdownChan :: ChannelId -> ChannelId -> Lock -> m ()
lockdownChan ChannelId
chan ChannelId
guild Lock
b = do
    let switch :: (a, a) -> a
switch  = case Lock
b of Lock
Lockdown -> (a, a) -> a
forall a b. (a, b) -> a
fst; Lock
Unlock -> (a, a) -> a
forall a b. (a, b) -> b
snd
    let swapPermOpts :: ChannelPermissionsOpts
swapPermOpts = ChannelPermissionsOpts :: Integer
-> Integer -> ChannelPermissionsOptsType -> ChannelPermissionsOpts
ChannelPermissionsOpts
                            { channelPermissionsOptsAllow :: Integer
channelPermissionsOptsAllow = (Integer, Integer) -> Integer
forall a. (a, a) -> a
switch (Integer
0, Integer
0x0000000800)
                            , channelPermissionsOptsDeny :: Integer
channelPermissionsOptsDeny  = (Integer, Integer) -> Integer
forall a. (a, a) -> a
switch (Integer
0x0000000800, Integer
0)
                            , channelPermissionsOptsType :: ChannelPermissionsOptsType
channelPermissionsOptsType  = ChannelPermissionsOptsType
ChannelPermissionsOptsRole
                            }
    ChannelId -> ChannelId -> ChannelPermissionsOpts -> m ()
forall (m :: * -> *).
MonadDiscord m =>
ChannelId -> ChannelId -> ChannelPermissionsOpts -> m ()
editChannelPermissions ChannelId
chan ChannelId
guild ChannelPermissionsOpts
swapPermOpts


--https://discordapi.com/permissions.html#2251673153
unlockAll :: Command DiscordHandler
unlockAll :: Command DiscordHandler
unlockAll
    = (Message -> DiscordHandler (Maybe Text))
-> Command DiscordHandler -> Command DiscordHandler
forall (m :: * -> *).
(Message -> m (Maybe Text)) -> Command m -> Command m
requires ([Text] -> Message -> DiscordHandler (Maybe Text)
forall (m :: * -> *).
MonadDiscord m =>
[Text] -> Message -> m (Maybe Text)
roleNameRequirement [Text
"Mod", Text
"Moderator"])
    (Command DiscordHandler -> Command DiscordHandler)
-> ((Message -> DiscordHandler ()) -> Command DiscordHandler)
-> (Message -> DiscordHandler ())
-> Command DiscordHandler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Message -> DiscordHandler ()) -> Command DiscordHandler
forall (m :: * -> *) h.
(CommandHandlerType m h, MonadDiscord m) =>
Text -> h -> Command m
command Text
"unlockAll" ((Message -> DiscordHandler ()) -> Command DiscordHandler)
-> (Message -> DiscordHandler ()) -> Command DiscordHandler
forall a b. (a -> b) -> a -> b
$ \Message
m -> do
        let opts :: ModifyGuildRoleOpts
opts = Maybe Text
-> Maybe Integer
-> Maybe Integer
-> Maybe Bool
-> Maybe Bool
-> ModifyGuildRoleOpts
ModifyGuildRoleOpts Maybe Text
forall a. Maybe a
Nothing (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
2251673153) Maybe Integer
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing

        let g :: ChannelId
g = Maybe ChannelId -> ChannelId
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ChannelId -> ChannelId) -> Maybe ChannelId -> ChannelId
forall a b. (a -> b) -> a -> b
$ Message -> Maybe ChannelId
messageGuild Message
m
        ChannelId
-> ChannelId -> ModifyGuildRoleOpts -> DiscordHandler Role
forall (m :: * -> *).
MonadDiscord m =>
ChannelId -> ChannelId -> ModifyGuildRoleOpts -> m Role
modifyGuildRole ChannelId
g ChannelId
g ModifyGuildRoleOpts
opts
        Message -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m ()
respond Message
m Text
"unlocked"

-- https://discordapi.com/permissions.html#2251671105
lockAll :: Command DiscordHandler
lockAll :: Command DiscordHandler
lockAll
    = (Message -> DiscordHandler (Maybe Text))
-> Command DiscordHandler -> Command DiscordHandler
forall (m :: * -> *).
(Message -> m (Maybe Text)) -> Command m -> Command m
requires ([Text] -> Message -> DiscordHandler (Maybe Text)
forall (m :: * -> *).
MonadDiscord m =>
[Text] -> Message -> m (Maybe Text)
roleNameRequirement [Text
"Mod", Text
"Moderator"])
    (Command DiscordHandler -> Command DiscordHandler)
-> ((Message -> DiscordHandler ()) -> Command DiscordHandler)
-> (Message -> DiscordHandler ())
-> Command DiscordHandler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Message -> DiscordHandler ()) -> Command DiscordHandler
forall (m :: * -> *) h.
(CommandHandlerType m h, MonadDiscord m) =>
Text -> h -> Command m
command Text
"lockAll" ((Message -> DiscordHandler ()) -> Command DiscordHandler)
-> (Message -> DiscordHandler ()) -> Command DiscordHandler
forall a b. (a -> b) -> a -> b
$ \Message
m -> do
        let opts :: ModifyGuildRoleOpts
opts = Maybe Text
-> Maybe Integer
-> Maybe Integer
-> Maybe Bool
-> Maybe Bool
-> ModifyGuildRoleOpts
ModifyGuildRoleOpts Maybe Text
forall a. Maybe a
Nothing (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
2251671105) Maybe Integer
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing

        let g :: ChannelId
g = Maybe ChannelId -> ChannelId
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ChannelId -> ChannelId) -> Maybe ChannelId -> ChannelId
forall a b. (a -> b) -> a -> b
$ Message -> Maybe ChannelId
messageGuild Message
m
        ChannelId
-> ChannelId -> ModifyGuildRoleOpts -> DiscordHandler Role
forall (m :: * -> *).
MonadDiscord m =>
ChannelId -> ChannelId -> ModifyGuildRoleOpts -> m Role
modifyGuildRole ChannelId
g ChannelId
g ModifyGuildRoleOpts
opts
        Message -> Text -> DiscordHandler ()
forall (m :: * -> *). MonadDiscord m => Message -> Text -> m ()
respond Message
m Text
"locked"