diff --git a/app/Main.hs b/app/Main.hs index d3ba5bd..ace4ec2 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE OverloadedStrings #-} + module Main where import Lib @@ -9,6 +11,22 @@ import Network.Socket hiding (recv) import Network.Socket.ByteString as S import qualified Data.ByteString.Lazy as L import Control.Concurrent (threadDelay, forkIO) +import Data.Text (isInfixOf) + +getNick (Message source _ _) = maybe "" id (sourceNick <$> source) + +react sock msg = do + case (ircCommand msg) of + "PING" -> sendMany sock (buildCommand <$> [pong (head $ ircCommandArgs msg)]) + "PRIVMSG" -> if ("crapbot" `isInfixOf` (head $ tail $ ircCommandArgs msg)) then + sendMany sock + (buildCommand <$> + [privmsg (head $ ircCommandArgs msg) (mconcat ["Hello there ", getNick msg, "!"])]) + else + return () + + command -> print command + return () channel = "#thisisatestwhatever" @@ -24,7 +42,11 @@ getIRCSock addr = socket (addrFamily addr) Stream defaultProtocol recvLoop sock = do msg <- recv sock 4096 - print $ runParseMessage msg + case runParseMessage msg of + Left _ -> return () + Right msg -> do + _ <- react sock msg + print msg threadDelay 1000000 recvLoop sock @@ -36,4 +58,7 @@ sendIRCConnect host = do threadDelay 1000000 sendMany sock (buildCommand <$> [userCmd, nickCmd, joinCmd, initMsgCmd]) -main = undefined +main = do + _ <- sendIRCConnect "irc.freenode.org" + _ <- getLine + return () diff --git a/package.yaml b/package.yaml index 1d23205..2c5ec65 100644 --- a/package.yaml +++ b/package.yaml @@ -25,6 +25,7 @@ dependencies: - bytestring - network - attoparsec +- either library: source-dirs: src diff --git a/src/IRCParser.hs b/src/IRCParser.hs index 594cd56..35956f0 100644 --- a/src/IRCParser.hs +++ b/src/IRCParser.hs @@ -1,24 +1,47 @@ {-# LANGUAGE OverloadedStrings #-} module IRCParser where +import Data.Text (strip) +import Data.Text.Encoding (decodeUtf8) import Data.ByteString (pack) import Data.Attoparsec.ByteString import Control.Applicative +import Data.Either.Combinators (rightToMaybe) +import Types --- :nisstyre!wes@oftn/oswg-member/Nisstyre PRIVMSG #thisisatestwhatever :yay\r\n --- :nisstyre!wes@oftn/oswg-member/Nisstyre PART #thisisatestwhatever :\"WeeChat 2.2\"\r\n --- :nisstyre!wes@oftn/oswg-member/Nisstyre JOIN #thisisatestwhatever\r\n --- :nisstyre!wes@oftn/oswg-member/Nisstyre QUIT :Quit: WeeChat 2.2\r\n --- PING :asimov.freenode.net\r\n +stripWhitespace = filter $ (all id) . (sequence $ map (/=) [" ", "\r", "\n", ""]) space = word8 32 notSpace = notWord8 32 +colon = word8 58 -- : -- 13 = \r, 10 = \n crlf c = c == 13 || c == 10 --- : -colon = word8 58 +bang = (== 33) -- ! +atsign = (== 64) -- @ +isSpace = (== 32) + +parseNick = takeWhile1 (not . bang) + +parseUsername = do + _ <- word8 33 + username <- takeWhile1 (not . atsign) + return username + +parseHostmask = do + _ <- word8 64 + hostmask <- takeWhile1 (not . isSpace) + return hostmask + +parseSource = do + nickname <- parseNick + username <- parseUsername + hostmask <- parseHostmask + return $ Source + (decodeUtf8 nickname) + (decodeUtf8 username) + (decodeUtf8 hostmask) command = choice $ map string ["PRIVMSG", "PART", "JOIN", "QUIT", "PING"] @@ -33,7 +56,7 @@ parseArgs = do args <- (argument `sepBy` space) <|> alwaysMatch [] _ <- space <|> (alwaysMatch 0) finalArg <- parseFinalArg <|> (alwaysMatch "") - return (args, finalArg) + return $ args ++ [finalArg] source = do _ <- colon @@ -49,6 +72,12 @@ parseMessage = do commandName <- command _ <- space arguments <- parseArgs - return (pack sourceName, commandName, arguments) + + let source = parseOnly parseSource $ pack sourceName + + return $ Message + (rightToMaybe source) + (decodeUtf8 commandName) + (map strip $ stripWhitespace $ map decodeUtf8 arguments) runParseMessage = parseOnly parseMessage diff --git a/src/Lib.hs b/src/Lib.hs index ad262d6..19185e8 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -7,15 +7,18 @@ import qualified Data.Text.Encoding as TE import Data.ByteString import Types -user name desc = Message "USER" [" ", name, " * * :", desc] +user name desc = Message Nothing "USER" [" ", name, " * * :", desc] -nick name = Message "NICK" [" ", name] +nick name = Message Nothing "NICK" [" ", name] -join channel = Message "JOIN" [" ", channel] +join channel = Message Nothing "JOIN" [" ", channel] -privmsg channel message = Message "PRIVMSG" [" ", channel, " :", message] +privmsg channel message = Message Nothing "PRIVMSG" [" ", channel, " :", message] -quit = Message "QUIT" [] +pong message = Message Nothing "PONG" [":", message] + +quit = Message Nothing "QUIT" [] buildCommand :: Message -> ByteString -buildCommand (Message cmd args) = TE.encodeUtf8 $ (cmd `T.append` (mconcat args)) `T.append` "\r\n" +buildCommand (Message Nothing cmd args) = TE.encodeUtf8 $ (cmd `T.append` (mconcat args)) `T.append` "\r\n" +buildCommand (Message (Just source) cmd args) = TE.encodeUtf8 $ (cmd `T.append` (mconcat args)) `T.append` "\r\n" diff --git a/src/Types.hs b/src/Types.hs index fc36263..cbabef2 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -2,7 +2,14 @@ module Types where import qualified Data.Text as T +data Source = Source { + sourceNick :: T.Text, + sourceUsername :: T.Text, + sourceHostmask :: T.Text + } deriving (Show) + data Message = Message { + ircSource :: Maybe Source, ircCommand :: T.Text, ircCommandArgs :: [T.Text] } deriving (Show)