From 140ae91b7593a3c46b1863985299c9fe10b1e94d Mon Sep 17 00:00:00 2001 From: Abhinav Sarkar Date: Sun, 4 May 2014 02:57:43 +0530 Subject: [PATCH] First working commit --- .gitignore | 3 +++ Network/IRC/Handlers.hs | 51 +++++++++++++++++++++++++++++++++++++++++ Network/IRC/Main.hs | 45 ++++++++++++++++++++++++++++++++++++ Network/IRC/Protocol.hs | 45 ++++++++++++++++++++++++++++++++++++ Network/IRC/Types.hs | 42 +++++++++++++++++++++++++++++++++ 5 files changed, 186 insertions(+) create mode 100644 .gitignore create mode 100644 Network/IRC/Handlers.hs create mode 100644 Network/IRC/Main.hs create mode 100644 Network/IRC/Protocol.hs create mode 100644 Network/IRC/Types.hs diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..223fb41 --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +*.hi +*.o +Network/IRC/Main diff --git a/Network/IRC/Handlers.hs b/Network/IRC/Handlers.hs new file mode 100644 index 0000000..5d5ed5d --- /dev/null +++ b/Network/IRC/Handlers.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE RecordWildCards #-} + +module Network.IRC.Handlers(listen, sendCommand) where + +import Control.Concurrent +import Control.Monad.Reader +import Data.List +import System.IO +import System.Time +import Text.Printf + +import Network.IRC.Protocol +import Network.IRC.Types + +io = liftIO + +sendCommand :: Bot -> Command -> IO () +sendCommand bot@Bot{ .. } reply = do + let line = lineFromCommand bot reply + hPrintf socket "%s\r\n" line >> printf "> %s\n" line + + +listen :: IRC () +listen = forever $ do + bot@Bot{ .. } <- ask + + line <- fmap init $ io $ hGetLine socket + time <- io getClockTime + + io $ printf "[%s] %s\n" (show time) line + + io $ forkIO $ case msgFromLine bot time line of + Ping { .. } -> sendCommand bot $ Pong msg + ModeMsg { user = Self, .. } -> sendCommand bot JoinCmd + msg -> forM_ messageHandlers $ \handler -> handler bot msg + +messageHandlers = [greeter, welcomer] + +greeter bot ChannelMsg { .. } = case find (`isPrefixOf` msg) greetings of + Nothing -> return () + Just greeting -> sendCommand bot $ ChannelMsgReply $ greeting ++ " " ++ userNick user + where + greetings = ["hi", "hello", "hey", "sup", "bye" + , "good morning", "good evening", "good night" + , "ohayo", "oyasumi"] +greeter _ _ = return () + +welcomer bot@Bot { .. } JoinMsg { .. } + | userNick user /= botNick = + sendCommand bot $ ChannelMsgReply $ "welcome back " ++ userNick user +welcomer _ _ = return () diff --git a/Network/IRC/Main.hs b/Network/IRC/Main.hs new file mode 100644 index 0000000..9cabea7 --- /dev/null +++ b/Network/IRC/Main.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +module Network.IRC.Main(main) where + +import qualified Control.Exception as E +import Control.Monad.Reader +import Network +import System.Environment +import System.Exit +import System.IO + +import Network.IRC.Handlers +import Network.IRC.Protocol +import Network.IRC.Types + +io = liftIO + +connect server port channel botNick = do + putStrLn "** Connecting ..." + handle <- connectTo server (PortNumber (fromIntegral port)) + hSetBuffering handle LineBuffering + hSetBuffering stdout LineBuffering + putStrLn "** Connected" + return $ Bot server port channel botNick handle + +disconnect bot = do + putStrLn "** Disconnecting ..." + hClose . socket $ bot + putStrLn "** Disconnected" + +run = do + bot <- ask + io $ sendCommand bot NickCmd >> sendCommand bot UserCmd + listen + +main = do + args <- getArgs + prog <- getProgName + if length args < 4 + then putStrLn ("Usage: " ++ prog ++ " ") >> exitFailure + else E.bracket (connect (args !! 0) (read (args !! 1)) (args !! 2) (args !! 3)) + disconnect loop + where + loop st = E.catch (runReaderT run st) + (\(e :: E.SomeException) -> putStrLn $ "Exception! " ++ show e) diff --git a/Network/IRC/Protocol.hs b/Network/IRC/Protocol.hs new file mode 100644 index 0000000..ac0e347 --- /dev/null +++ b/Network/IRC/Protocol.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE RecordWildCards #-} + +module Network.IRC.Protocol where + +import Data.List +import Data.List.Split +import System.Time + +import Network.IRC.Types + +msgFromLine :: Bot -> ClockTime -> String -> Message +msgFromLine (Bot { .. }) time line + | "PING :" `isPrefixOf` line = Ping time . drop 6 $ line + | otherwise = case command of + "JOIN" -> JoinMsg time user + "QUIT" -> QuitMsg time user message + "PART" -> PartMsg time user message + "MODE" -> if source == botNick + then ModeMsg time Self target message [] + else ModeMsg time user target mode modeArgs + "NICK" -> NickMsg time user (drop 1 target) + "PRIVMSG" -> if target == channel + then ChannelMsg time user message + else PrivMsg time user message + _ -> OtherMsg time source command target message + where + isSpc = (== ' ') + isNotSpc = not . isSpc + splits = splitWhen isSpc line + source = drop 1 . takeWhile isNotSpc $ line + target = splits !! 2 + command = splits !! 1 + message = drop 1 . unwords . drop 3 $ splits + user = let u = splitWhen (== '!') source in User (u !! 0) (u !! 1) + mode = splits !! 3 + modeArgs = drop 4 splits + +lineFromCommand :: Bot -> Command -> String +lineFromCommand (Bot { .. }) reply = case reply of + Pong { .. } -> "PONG :" ++ rmsg + NickCmd -> "NICK " ++ botNick + UserCmd -> "USER " ++ botNick ++ " 0 * :" ++ botNick + JoinCmd -> "JOIN " ++ channel + ChannelMsgReply { .. } -> "PRIVMSG " ++ channel ++ " :" ++ rmsg + PrivMsgReply (User { .. }) rmsg -> "PRIVMSG " ++ botNick ++ " :" ++ rmsg diff --git a/Network/IRC/Types.hs b/Network/IRC/Types.hs new file mode 100644 index 0000000..eb147a3 --- /dev/null +++ b/Network/IRC/Types.hs @@ -0,0 +1,42 @@ +module Network.IRC.Types where + +import Control.Monad.Reader +import System.IO +import System.Time + +type Channel = String +type Nick = String + +data User = Self | User { userNick :: Nick, userServer :: String } + deriving (Show, Eq) + +data Message = + ChannelMsg { time :: ClockTime, user :: User, msg :: String } + | PrivMsg { time :: ClockTime, user :: User, msg :: String } + | Ping { time :: ClockTime, msg :: String } + | JoinMsg { time :: ClockTime, user :: User } + | ModeMsg { time :: ClockTime, user :: User, target :: String + , mode :: String, modeArgs :: [String] } + | NickMsg { time :: ClockTime, user :: User, nick :: String } + | QuitMsg { time :: ClockTime, user :: User, msg :: String } + | PartMsg { time :: ClockTime, user :: User, msg :: String } + | OtherMsg { time :: ClockTime, source :: String, command :: String + , target :: String, msg :: String } + deriving (Show, Eq) + +data Command = + Pong { rmsg :: String } + | ChannelMsgReply { rmsg :: String } + | PrivMsgReply { ruser :: User, rmsg :: String } + | NickCmd + | UserCmd + | JoinCmd + deriving (Show, Eq) + +data Bot = Bot { server :: String + , port :: Int + , channel :: String + , botNick :: String + , socket :: Handle } + +type IRC = ReaderT Bot IO