{-# 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 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.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://gitlab.com/laleanor/miaowe" #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 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 () trySendFile channel path = (doesFileExist (path) >>= (\b -> if b then sendFile channel (path) else sendToChannel channel "No such file or command." >> hFlush stdout)) #ifdef FORTUNE getFortune :: IO String getFortune = readCreateProcess ((shell "fortune -e | cowsay -b")) "" #endif doCommand :: IrcChannel -> MircString -> IO () doCommand channel command = case map toLower ((words command)!!4) of "list" -> listDirectory "." >>= sendToChannel channel . intercalate "\n" "code" -> sendToChannel channel codeUrl "help" -> sendToChannel channel helpString #ifdef FORTUNE "fortune" -> getFortune >>= sendToChannel channel #endif _ -> (if isInfixOf "/" ((words command)!!4) then sendToChannel channel "Only PWD please." else trySendFile channel ((words command)!!4)) processCommand :: IrcChannel -> MircString -> IO () processCommand channel command | length (words command) < 5 = sendToChannel channel "You need to specify \ a command." | otherwise = doCommand channel command commandChannel :: String -> String commandChannel command = (words command)!!2 mainLoop :: IrcChannel -> IO () mainLoop channel = waitForCommand >>= \line -> (if commandChannel line == channel then processCommand channel line else return ()) >> 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 >> mainLoop (args!!0)