diff --git a/src/devbot.hs b/src/devbot.hs index 5e93c5d..b912bd2 100644 --- a/src/devbot.hs +++ b/src/devbot.hs @@ -36,8 +36,8 @@ import qualified GitHub.Endpoints.Issues.Milestones as G ournick = "devbot" -server = "irc.freenode.org" -port = 7070 +server = "irc.freenode.net" +port = 6697 chans = [ "#devbot-dev" , "#utox" , "#epic_cms" @@ -50,29 +50,31 @@ regex_GH_num = "(#[0-9]{1,5})" :: String regex_GH_repo = "([a-zA-Z0-9.-]+)" ++ regex_GH_num regex_GH_owner = "([a-zA-Z0-9.-]+)/" ++ regex_GH_repo regex_gl = "((^|\\s)![0-9]{1,5})" :: String -regex_gli = "((^|\\s)i[0-9]{1,5})" :: String data Bot = Bot { socket :: Connection , channels :: [Channel] + , people :: [User] , start_time :: UTCTime } +data User = User + { nick :: String + , user :: String + , host :: String + , monolog :: Int + , karma :: Int + } deriving (Eq, Show) + data Channel = Channel { chname :: String - , users :: [User] + , users :: [String] , default_rown :: String , default_repo :: String } deriving (Eq, Show) type Net = StateT Bot IO -data User = User - { nick :: String - , user :: String - , host :: String - } deriving (Eq, Show) - ------------------------------------------------ -- IRC connection and logic ------------------------------------------------ @@ -93,7 +95,7 @@ conn = do , connectionUseSocks = Nothing } c <- getCurrentTime - return (Bot irc_conn [] c) + return (Bot irc_conn [] [] c) where notify a = bracket_ (printf "connecting to %s..." server >> hFlush stdout) (putStrLn "connected!") a @@ -108,19 +110,19 @@ listen :: Net () listen = forever $ do h <- gets socket string <- readLine h - -- string <- raw -- TODO sanitize utf-8 for the broken version of haskell on debian if "PING :" `isPrefixOf` string then io $ connectionPut h (CHAR8.pack $ "PONG :" ++ string ++ "\r\n") else do io $ putStrLn string + overhead (source string) (action string) (target string) (message string) eval (source string) (action string) (target string) (message string) where forever a = do a; forever a source = takeWhile (/= ' ') . drop 1 action = takeWhile (/= ' ') . drop 1 . dropWhile (/= ' ') - target = takeWhile (/= ' ') . drop 1 . dropWhile (/= ' ') . drop 1 . dropWhile (/= ' ') - message = drop 1 . dropWhile (/= ':') . drop 1 + target = init . takeWhile (/= ':') . drop 1 . dropWhile (/= ' ') . drop 1 . dropWhile (/= ' ') + message = drop 1 . dropWhile (/= ':') . drop 1 . init readLine :: Connection -> Net (String) readLine con = do @@ -133,16 +135,33 @@ write string text = do h <- gets socket io $ connectionPut h $ CHAR8.pack (string ++ " " ++ text ++ "\r\n") +------------------------------------------------ +-- Overhead / Bot Maintenance +------------------------------------------------ +overhead :: String -> String -> String -> String -> Net () +overhead src _ _ _ = do + users <- gets people + let uniq = nub (users ++ [mkUser src]) + modify (\b -> b { people = uniq }) + ------------------------------------------------ -- Main processor ------------------------------------------------ eval :: String -> String -> String -> String -> Net () eval _ "332" _ _ = io $ putStrLn "DEBUG__ GOT CHAN TOPIC" eval _ "333" _ _ = io $ putStrLn "DEBUG__ GOT CHAN TOPIC SETBY" -eval _ "353" _ _ = io $ putStrLn "DEBUG__ GOT USER LIST" eval _ "366" _ _ = io $ putStrLn "DEBUG__ EOF USER LIST" eval _ "473" _ _ = io $ putStrLn "DEBUG__ UNABLE TO JOIN CHANNEL (not invited)" -eval source action target "is now your hidden host (set by services.)" = do + +eval _ "353" trg msg = do + ch_list <- gets channels + let target_chan = dropWhile (/= '#') trg + let old_ch = head $ filter (\x -> target_chan == chname x) ch_list + let new_ch = foldl chanAddUser old_ch (words msg) + let chans = nubBy (\x y -> chname x == chname y) $ new_ch : ch_list + modify (\bot -> bot { channels = chans }) + -- dumpChans chans +eval _ "396" _ _ = do -- Host Mask Set, it's safe to join channels now mapM joinChan chans return() eval _ "INVITE" _ chan = do @@ -161,18 +180,45 @@ eval source action target msg | "allah is doing" `isInfixOf` msg = kickBan target source -- Actual work -- check commands before checking regex - | "!" `isPrefixOf` msg = botCommand source action target msg + | "!" `isPrefixOf` msg = do + if msg =~ regex_gl + then do + mapM_ (gitLabMagic target) ((getAllTextMatches $ msg =~ regex_gl) :: [String]) + return () + else botCommand source action target msg -- regex searches | msg =~ ("[Dd]evbot[;:,]?" :: String) = evalMention source action target msg + | msg =~ mtch_good = do + ps <- gets people + let n = (takeWhile (/= '+') $ msg =~ mtch_good) + let user = findUser n ps + if isJust user + then do + let u = (userModKarma (fromJust user) 1 ) + let pss = u : ps + modify (\bot -> bot { people = nub pss }) + else return () + | msg =~ mtch_bad = do + ps <- gets people + let n = (takeWhile (/= '-') $ msg =~ mtch_bad) + let user = findUser n ps + if isJust user + then do + let u = (userModKarma (fromJust user) (-1)) + let pss = u : ps + modify (\bot -> bot { people = nub pss }) + else return () | msg =~ regex_GH_num = issueFinder target msg - | msg =~ regex_gl = do + | msg =~ regex_gl = do mapM_ (gitLabMagic target) ((getAllTextMatches $ msg =~ regex_gl) :: [String]) return () - | msg =~ regex_gli = privMsg target $ "https://gitlab.com/uTox/uTox/issues/" ++ drop 1 (msg =~ regex_gli) -- be funny! | "that's wrong!" `isInfixOf` msg = privMsg target "OH NO! someone is wrong on the internet! https://xkcd.com/386/" | "shit's fucked" `isInfixOf` msg = privMsg target "https://www.youtube.com/watch?v=HAEZaUYoJRc" | otherwise = return () + where + mtch_good = ("([a-zA-Z0-9.-]+)\\+\\+" :: String) + mtch_bad = ("([a-zA-Z0-9.-]+)--" :: String) gitLabMagic :: String -> String -> Net () gitLabMagic x y = privMsg x $ "https://gitlab.com/uTox/uTox/merge_requests/" ++ drop 1 (dropWhile (/= '!') y) @@ -186,6 +232,7 @@ evalMention _ _ t msg | msg =~ ("(you're|your|is) awesome" :: String) = privMsg t "Awww... I love you too!" | msg =~ ("what(')?s (next|left)\\?" :: String) = eval "" "" t "!m" | msg =~ ("^[Dd]evbot[;:,]? " :: String) = privMsg t "You said my name!! :D" + | msg =~ ("oh, I mean" :: String) = privMsg t "A common typo, they keys are right next to each other, really..." | otherwise = return () botCommand :: String -> String -> String -> String -> Net () @@ -193,17 +240,23 @@ botCommand _ _ target "!moose" = privMsg target "https://www.youtube.com/ botCommand _ _ target "!commitsudoku" = privMsg target "http://www.sudokuweb.org/" botCommand _ _ target "!uptime" = uptime >>= privMsg target botCommand _ _ target "!rip" = sayRip target -botCommand _ _ target "!m" = io (nextMilestone True "TokTok" "c-toxcore") >>= privMsg target +botCommand _ _ target "!m" = io (nextMilestone True (drop 1 target) ("c-toxcore")) >>= privMsg target botCommand _ _ target "!echo" = privMsg target "Echo what exactly?" botCommand source action target msg -- all the cool commands we do stuff with + | "!k " `isPrefixOf` msg = do + peoples <- gets people + let users = filter (\x -> drop 3 msg == nick x) peoples + if null users + then privMsg target "666: Karma Not Found" + else privMsg target $ drop 3 msg ++ " has " ++ show (userKarma $ head users) | "!echo " `isPrefixOf` msg = do privMsg target $ drop 6 msg | "!die" == msg = do privMsg target "Sure, I'll just DIE then!" write "QUIT" ":My death was ordered" >> io (exitWith ExitSuccess) | "!milestone" `isPrefixOf` msg = do - text <- io $ nextMilestone False "TokTok" "c-toxcore" + text <- io $ nextMilestone False (drop 1 target) ("c-toxcore") privMsg target $ text | "!status " `isPrefixOf` msg = do let s = chkStatus $ takeWhile (/= ' ') . drop 8 $ msg @@ -213,6 +266,7 @@ botCommand source action target msg | "!set " `isPrefixOf` msg = setState source target (drop 5 msg) | "!ghost " `isPrefixOf` msg = privMsg ((takeWhile (/= ' ') . drop 7) msg) ((drop 1 . dropWhile (/= ' ') . drop 8) msg) | "!join " `isPrefixOf` msg = joinChan ((takeWhile (/= ' ') . drop 6) msg) + | "!invite " `isPrefixOf` msg = chanInviteUser (takeWhile (/= ' ') msg ) (takeWhile (/= ' ') . dropWhile (/= ' ') $ msg) | "!build " `isPrefixOf` msg = do res <- io $ ciTriggerGitlab $ (takeWhile (/= ' ') . drop 7) msg if res @@ -241,7 +295,7 @@ sayRip t = do privMsg t "Poor one out for the devs Tox has eaten" privMsg t "irungentoo 2013-2016" privMsg t "iphy 2015-2017" - privMsg t "mannol 2014-2016" + privMsg t "mannol 2013-2016" privMsg t "jfreegman 2014-2015" privMsg t "May Tox rest their soul..." @@ -254,6 +308,26 @@ chkStatus "qtox" = Just "qTox's current status :: https://utox.io/qtox.jpg :: chkStatus "utox" = Just "uTox's current status :: https://utox.io/utox.png" chkStatus _ = Nothing +findUser :: String -> [User] -> Maybe User +findUser name list = do + let matches = filter (\x -> nick x == name) list + if null matches + then Nothing + else Just $ head matches + +mkUser :: String -> User +mkUser str = (User (n str) (u str) (h str) 0 0) + where + n = takeWhile (/= '!') + u = drop 1 . takeWhile (/= '@') . dropWhile (/= '!') + h = drop 1 . dropWhile (/= '@') + +userModKarma :: User -> Int -> User +userModKarma user change = user { karma = (karma user) + change } + +userKarma :: User -> Int +userKarma u = karma u + kickBan :: String -> String -> Net () kickBan channel shitball = do setBan channel shitball @@ -269,32 +343,33 @@ chanMode :: String -> String -> String -> Net () chanMode mode target user = do write "MODE" $ target ++ " " ++ mode ++ " " ++ user +chanAddUser :: Channel -> String -> Channel +chanAddUser old user = old { users = user : users old } + dumpChans :: [Channel] -> Net () -dumpChans channs = mapM_ (\x -> io $ putStrLn ((chname x) ++ " " ++ (default_repo x))) channs +dumpChans channs = mapM_ (\x -> io $ putStrLn ("DMPCHN: " ++ (chname x) ++ " -- " ++ (default_repo x) ++ unwords (users x) )) channs chanSetRepo :: String -> String -> Net () chanSetRepo search repo = do real <- gets channels let (ch, other) = botPopChan search real - if null ch - then return () - else do - let ch' = head ch -- We're just guessing here :< - let ch2 = ch' { default_repo = repo } - let new = nubBy (\x y -> chname x == chname y) $ ch2 : other - modify (\bot -> bot { channels = new }) + let ch2 = ch { default_repo = repo } + let new = nubBy (\x y -> chname x == chname y) $ ch2 : other + modify (\bot -> bot { channels = new }) chanSetOwn :: String -> String -> Net () chanSetOwn search owner = do real <- gets channels let (ch, other) = botPopChan search real - if null ch - then return () - else do - let ch' = head ch -- We're just guessing here :< - let ch2 = ch' { default_rown = owner } - let new = nubBy (\x y -> chname x == chname y) $ ch2 : other - modify (\bot -> bot { channels = new }) + let ch2 = ch { default_rown = owner } + let new = nubBy (\x y -> chname x == chname y) $ ch2 : other + modify (\bot -> bot { channels = new }) + +chanInviteUser :: String -> String -> Net () +chanInviteUser chan user = invtMsg $ "" ++ user ++ " " ++ chan + +invtMsg :: String -> Net () +invtMsg msg = write "INVITE" $ msg privMsg :: String -> String -> Net () privMsg to text = write "PRIVMSG" $ to ++ " :" ++ text @@ -302,14 +377,21 @@ privMsg to text = write "PRIVMSG" $ to ++ " :" ++ text chNick :: String -> Net () chNick nick = write "NICK" nick -botPopChan :: String -> [Channel] -> ([Channel], [Channel]) -botPopChan search cs = partition (\x -> search == chname x) cs +mkChan :: String -> Channel +mkChan c = Channel c [] (drop 1 c) [] + +botPopChan :: String -> [Channel] -> (Channel, [Channel]) +botPopChan search cs = do + let (a, b) = partition (\x -> search == chname x) cs + if null a + then (mkChan search, b) + else (head a, b) joinChan :: String -> Net () joinChan c = do write "JOIN" c old <- gets channels - let chan = (Channel c [] [] []) + let chan = mkChan c let new = nubBy (\x y -> chname x == chname y) $ chan : old -- dumpChans new modify (\bot -> bot { channels = new }) @@ -327,9 +409,7 @@ issueFinder :: String -> String -> Net () issueFinder trg msg = do allchan <- gets channels let (ch, _) = botPopChan trg allchan - let (owner, repo, inum) = parseIssueRequest (head ch) trg msg - gl <- io $ glIssueFind inum - privMsg trg gl + let (owner, repo, inum) = parseIssueRequest ch trg msg url <- io $ checkIssue owner repo $ read inum if isJust url then privMsg trg $ fromJust url @@ -424,7 +504,6 @@ realIssue repo_name owner issu_numb issue = do then return (Just (str ++ "|| https://reviewable.io/reviews/" ++ owner ++ "/" ++ repo_name ++ "/" ++ show issu_numb)) else return (Just str) - ------------------------------------------------ -- GitLab helpers ------------------------------------------------