{-# LANGUAGE CPP #-} -- IRC art (spam)bot {- Copyright 2023 "Laura Aléanor" Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. -} import Data.Bits import Data.Bool import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S.Char8 import qualified Data.ByteString.Internal as S.Internal import Data.Char import Data.List import Data.Time import Data.Word import System.Directory import System.Environment import System.Exit import System.IO import Text.Printf #ifdef FORTUNE import System.Process #endif type BitMap = [Word8] type MircString = String type PpmBmp = [Word8] type IrcChannel = String data Image = Image { imgBmp :: BitMap, imgPitch :: Int, imgHeight :: Int } data UserInfo = UserInfo { userNick :: String, userName :: String, userRealname :: String, userCredentials :: String } codeUrl = "https://git.vampires.gay/miaowe.git" #ifdef FORTUNE helpString = "Commands available: Code; Fortune; Help; List. \ Anything else is interpreted as a file name." #else helpString = "Commands available: Code; Help; List. \ Anything else is interpreted as a file name." #endif -- Minimum time between spammy commands. minimumDelay = 30 ctrlC = [toEnum 03] :: String ctrlO = [toEnum 15] :: String ctrlV = [toEnum 22] :: String -- https://www.mirc.com/colors.html w24ToMirc :: BitMap -> MircString w24ToMirc word -- White | (word!!0 > 210) && (word!!1 > 210) && (word!!2 > 210) = "0" -- Black | (word!!0 == 0) && (word!!1 == 0) && (word!!2 == 0) = "1" -- Light red | (word!!0 > 127) && (word!!1 == 0) && (word!!2 == 0) = "4" -- Light green | (word!!0 == 0) && (word!!1 > 147) && (word!!2 == 0) = "9" -- Light blue | (word!!0 == 0) && (word!!1 == 0) && (word!!2 > 127) = "12" -- Red (aka brown) | (word!!0 <= 127) && (word!!1 == 0) && (word!!2 == 0) = "5" -- Green | (word!!0 == 0) && (word!!1 <= 147) && (word!!2 == 0) = "3" -- Blue | (word!!0 == 0) && (word!!1 == 0) && (word!!2 <= 127) = "2" -- Yellow | (word!!0 > 252) && (word!!1 > 127) && (word!!2 == 0) = "8" -- Orange | (word!!0 <= 252) && (word!!1 <= 127) && (word!!2 == 0) = "7" -- Pink | (word!!0 > 156) && (word!!1 == 0) && (word!!2 > 156) = "13" -- Purple | (word!!0 <= 156) && (word!!1 == 0) && (word!!2 <= 156) = "6" -- Light cyan | (word!!0 == 0) && (word!!1 > 147) && (word!!2 > 147) = "11" -- Cyan | (word!!0 == 0) && (word!!1 <= 147) && (word!!2 <= 147) = "10" -- Light grey | (word!!0 > 127) && (word!!1 > 127) && (word!!2 > 127) = "15" -- Grey | otherwise = "14" lineToMirc :: BitMap -> MircString lineToMirc [] = [] lineToMirc line = ctrlC ++ w24ToMirc (take 3 line) ++ ctrlV ++ " " ++ ctrlO ++ lineToMirc (drop 3 line) bmpToMirc :: Int -> Int -> BitMap -> MircString bmpToMirc _ 0 _ = [] bmpToMirc pitch height bmp =lineToMirc (take pitch bmp) ++ "\n" ++ bmpToMirc pitch (height-1) (drop pitch bmp) w8Split :: Word8 -> [Word8] -> [[Word8]] w8Split c = map S.unpack . S.split c . S.pack w8ToString :: [Word8] -> String w8ToString = S.Char8.unpack . S.pack ppmToImage :: PpmBmp -> Image ppmToImage ppm = Image (intercalate [S.Internal.c2w '\n'] $ drop 3 (w8Split (S.Internal.c2w '\n') ppm)) ((read (w8ToString ((w8Split (S.Internal.c2w ' ') ((w8Split (S.Internal.c2w '\n') ppm) !! 1)) !! 0)))*3) (read ( w8ToString ((w8Split (S.Internal.c2w ' ') ((w8Split (S.Internal.c2w '\n') ppm) !! 1)) !! 1))) readFromConf :: String -> String -> String readFromConf conf key = (intercalate " " . drop 1 . words . (!!0) . filter (\l -> (words l)!!0 == key)) (lines conf) readConf :: String -> UserInfo readConf conf = UserInfo (readFromConf conf "nick") (readFromConf conf "username") (readFromConf conf "realname") (readFromConf conf "credentials") ircConnect :: UserInfo -> MircString ircConnect u = printf "NICK %s\r\n\ USER %s 0 * :%s\r\n\ PRIVMSG NickServ :IDENTIFY %s\r\n" (userNick u) (userName u) (userRealname u) (userCredentials u) waitForMessage :: (String -> Bool) -> IO String waitForMessage p = getLine >>= \l -> if p l then return l else (if (words l)!!0 == "PING" then putStr ("PONG " ++ ((words l)!!1) ++ "\r\n") >> hFlush stdout else return ()) >> waitForMessage p waitForCloak :: IO String waitForCloak = waitForMessage (\l -> (words l)!!1 == "396") waitForCommand :: IO String waitForCommand = waitForMessage (\l -> if ((length (words l)) >= 4) then init ((words l)!!3) == ":miaowe" && elem (last ((words l)!!3)) ":," else False) joinChannel :: String -> IO () joinChannel c = putStr (printf "JOIN %s\r\n" c) sendToChannel :: IrcChannel -> MircString -> IO () sendToChannel c s = (putStr $ concat $ map (\l -> printf "PRIVMSG %s :%s\r\n" c l) (lines s)) >> hFlush stdout sendFile :: IrcChannel -> FilePath -> IO () sendFile channel path = S.readFile path >>= sendToChannel channel . (\img ->bmpToMirc (imgPitch img) (imgHeight img) (imgBmp img)) . ppmToImage . S.unpack . S.Char8.pack . intercalate "\n" . filter (\l->not (head l == '#')) . lines . S.Char8.unpack trySendFile :: IrcChannel -> FilePath -> IO Bool trySendFile channel path = (doesFileExist (path) >>= (\b -> if b then sendFile channel (path) >> return True else sendToChannel channel "No such file or command." >> hFlush stdout >> return False)) #ifdef FORTUNE getFortune :: IO String getFortune = readCreateProcess ((shell "fortune -e | cowsay -b")) "" #endif -- Takes a channel and command, return True if -- command should count towards rate limiting, -- False if not. doCommand :: IrcChannel -> MircString -> IO Bool doCommand channel command = case map toLower ((words command)!!4) of "list" -> listDirectory "." >>= sendToChannel channel . intercalate "\n" >> return True "code" -> sendToChannel channel codeUrl >> return False "help" -> sendToChannel channel helpString >> return False #ifdef FORTUNE "fortune" -> getFortune >>= sendToChannel channel >> return True #endif _ -> (if isInfixOf "/" ((words command)!!4) then sendToChannel channel "Only PWD please." >> return False else trySendFile channel ((words command)!!4)) -- Subtracts t from the current time to get the time t ago. subtractPresent :: NominalDiffTime -> IO UTCTime subtractPresent t = getCurrentTime >>= \c -> return $ addUTCTime (-t) c -- Takes channel, command, and time elapsed since last command. -- Returns the time to use for counting, either the current time, -- or the one of the previous command it throttling is not wished. processCommand :: IrcChannel -> MircString -> NominalDiffTime -> IO UTCTime processCommand channel command timeElapsed | timeElapsed < minimumDelay = sendToChannel channel "Not so quick, partner" >> subtractPresent timeElapsed | length (words command) < 5 = sendToChannel channel "You need to specify \ a command." >> subtractPresent timeElapsed | otherwise = doCommand channel command >>= bool (subtractPresent timeElapsed) getCurrentTime commandChannel :: String -> String commandChannel command = (words command)!!2 mainLoop :: IrcChannel -> UTCTime -> IO () mainLoop channel time = waitForCommand >>= \line -> (if commandChannel line == channel then getCurrentTime >>= \t -> processCommand channel line (diffUTCTime t time) else return time) >>= mainLoop channel main :: IO () main = openFile "../conf" ReadMode >>= (\handle -> hGetContents handle >>= putStr . ircConnect . readConf >> hClose handle) >> hFlush stdout >> waitForCloak >> hFlush stdout >> getArgs >>= \args -> joinChannel (args!!0) >> hFlush stdout >> getCurrentTime >>= \t -> mainLoop (args!!0) (addUTCTime (-minimumDelay) t)