pipes-irc-server/tests/ParseTests.hs

592 lines
20 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
module ParseTests where
import Test.Tasty.Hspec as HS
import Data.Attoparsec.ByteString.Char8 as P
import Pipes.IRC.Message.Parse
import Pipes.IRC.Message.Types
msgParseSpec :: Spec
msgParseSpec =
describe "Parsing" $ do
describe "parseMsgOrLine" $ do
it "succeeds parsing an empty line, returning a Left value" $
pMsgOrLine "\r\n"
`shouldBe`
Right (Left "\r\n")
it "succeeds parsing an IRC message, returning a Right value" $
pMsgOrLine "PRIVMSG #haskell :Hi, guys!\r\n"
`shouldBe`
Right
(Right (IrcMessage Nothing (Left PRIVMSG) ["#haskell", "Hi, guys!"]))
describe "parseIrcMessage" $ do
context "Messages with no prefix" $ do
it "matches with no parameters" $
pMsg "NAMES\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left NAMES) [])
it "matches with one parameter (without spaces)" $
pMsg "NICK WiZ\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left NICK) ["WiZ"])
it "matches with one parameter (with spaces)" $
pMsg "QUIT :Goodbye, cruel world!\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left QUIT) ["Goodbye, cruel world!"])
context "Messages with server name prefix" $ do
it "matches with server name prefixes" $
pMsg ":foo.domain.com ERROR :Oh no!\r\n"
`shouldBe`
Right (IrcMessage (Just (Left "foo.domain.com"))
(Left ERROR)
["Oh no!"] )
it "matches with hyphenated server name prefixes" $
pMsg ":my-domain.org ERROR :Oh no!\r\n"
`shouldBe`
Right (IrcMessage (Just (Left "my-domain.org"))
(Left ERROR)
["Oh no!"] )
context "Messages with nickname prefix" $ do
it "matches with just nick" $
pMsg ":WiZ PRIVMSG #haskell :Hello\r\n"
`shouldBe`
Right (IrcMessage (Just (Right (NickName "WiZ" Nothing Nothing)))
(Left PRIVMSG)
["#haskell", "Hello"] )
it "matches with nick and user" $
pMsg ":WiZ!wiz PRIVMSG #haskell :Hello\r\n"
`shouldBe`
Right (IrcMessage (Just (Right (NickName "WiZ" (Just "wiz") Nothing)))
(Left PRIVMSG)
["#haskell", "Hello"] )
it "matches with nick, user, and host" $
pMsg ":WiZ!wiz@wiz-host.com PRIVMSG #haskell :Hello\r\n"
`shouldBe`
Right (IrcMessage (Just (Right
(NickName
"WiZ"
(Just "wiz")
(Just "wiz-host.com"))))
(Left PRIVMSG)
["#haskell", "Hello"] )
context "Examples from RFC1459" $ do
it "matches PASS example" $
pMsg "PASS secretpasswordhere\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left PASS) ["secretpasswordhere"])
it "matches NICK example 1" $
pMsg "NICK Wiz\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left NICK) ["Wiz"])
it "matches NICK example 2" $
pMsg ":WiZ NICK Kilroy\r\n"
`shouldBe`
Right (IrcMessage
(Just (Right (NickName "WiZ" Nothing Nothing)))
(Left NICK) ["Kilroy"])
it "matches USER example 1" $
pMsg "USER guest tolmoon tolsun :Ronnie Reagan\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left USER)
["guest", "tolmoon", "tolsun", "Ronnie Reagan"])
it "matches USER example 2" $
pMsg ":testnick USER guest tolmoon tolsun :Ronnie Reagan\r\n"
`shouldBe`
Right (IrcMessage
(Just (Right (NickName "testnick" Nothing Nothing)))
(Left USER) ["guest", "tolmoon", "tolsun", "Ronnie Reagan"])
it "matches SERVER example 1" $
pMsg "SERVER test.oulu.fi 1 :[tolsun.oulu.fi] Experimental server\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left SERVER)
["test.oulu.fi", "1", "[tolsun.oulu.fi] Experimental server"])
it "matches SERVER example 2" $
pMsg ":tolsun.oulu.fi SERVER csd.bu.edu 5 :BU Central Server\r\n"
`shouldBe`
Right (IrcMessage
(Just (Left "tolsun.oulu.fi"))
(Left SERVER) ["csd.bu.edu", "5", "BU Central Server"])
it "matches OPER example" $
pMsg "OPER foo bar\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left OPER) ["foo", "bar"])
it "matches QUIT example" $
pMsg "QUIT :Gone to have lunch\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left QUIT) ["Gone to have lunch"])
it "matches SQUIT example 1" $
pMsg "SQUIT tolsun.oulu.fi :Bad Link ?\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left SQUIT)
["tolsun.oulu.fi", "Bad Link ?"])
it "matches SQUIT example 2" $
pMsg ":Trillian SQUIT cm22.eng.umd.edu :Server out of control\r\n"
`shouldBe`
Right (IrcMessage
(Just (Right (NickName "Trillian" Nothing Nothing)))
(Left SQUIT) ["cm22.eng.umd.edu", "Server out of control"])
it "matches JOIN example 1" $
pMsg "JOIN #foobar\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left JOIN) ["#foobar"])
it "matches JOIN example 2" $
pMsg "JOIN &foo fubar\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left JOIN) ["&foo", "fubar"])
it "matches JOIN example 3" $
pMsg "JOIN #foo,&bar fubar\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left JOIN) ["#foo,&bar", "fubar"])
it "matches JOIN example 4" $
pMsg "JOIN #foo,&bar fubar,foobar\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left JOIN) ["#foo,&bar", "fubar,foobar"])
it "matches JOIN example 5" $
pMsg "JOIN #foo,#bar\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left JOIN) ["#foo,#bar"])
it "matches JOIN example 6" $
pMsg ":WiZ JOIN #Twilight_zone\r\n"
`shouldBe`
Right (IrcMessage
(Just (Right (NickName "WiZ" Nothing Nothing)))
(Left JOIN) ["#Twilight_zone"])
it "matches PART example 1" $
pMsg "PART #twilight_zone\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left PART) ["#twilight_zone"])
it "matches PART example 2" $
pMsg "PART #oz-ops,&group5\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left PART) ["#oz-ops,&group5"])
it "matches MODE example 1" $
pMsg "MODE #Finnish +im\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left MODE) ["#Finnish", "+im"])
it "matches MODE example 2" $
pMsg "MODE #Finnish +o Kilroy\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left MODE) ["#Finnish", "+o", "Kilroy"])
it "matches MODE example 3" $
pMsg "MODE #Finnish +v Wiz\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left MODE) ["#Finnish", "+v", "Wiz"])
it "matches MODE example 4" $
pMsg "MODE #Fins -s\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left MODE) ["#Fins", "-s"])
it "matches MODE example 5" $
pMsg "MODE #42 +k oulu\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left MODE) ["#42", "+k", "oulu"])
it "matches MODE example 6" $
pMsg "MODE #eu-opers +l 10\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left MODE) ["#eu-opers", "+l", "10"])
it "matches MODE example 7" $
pMsg "MODE &oulu +b\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left MODE) ["&oulu", "+b"])
it "matches MODE example 8" $
pMsg "MODE &oulu +b *!*@*\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left MODE) ["&oulu", "+b", "*!*@*"])
it "matches MODE example 9" $
pMsg "MODE &oulu +b *!*@*.edu\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left MODE) ["&oulu", "+b", "*!*@*.edu"])
it "matches MODE example 10" $
pMsg "MODE WiZ -w\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left MODE) ["WiZ", "-w"])
it "matches MODE example 11" $
pMsg ":Angel MODE Angel +i\r\n"
`shouldBe`
Right (IrcMessage
(Just (Right (NickName "Angel" Nothing Nothing)))
(Left MODE) ["Angel", "+i"])
it "matches MODE example 12" $
pMsg "MODE WiZ -o\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left MODE) ["WiZ", "-o"])
it "matches TOPIC example 1" $
pMsg ":WiZ TOPIC #test :New topic\r\n"
`shouldBe`
Right (IrcMessage
(Just (Right (NickName "WiZ" Nothing Nothing)))
(Left TOPIC) ["#test", "New topic"])
it "matches TOPIC example 2" $
pMsg "TOPIC #test :another topic\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left TOPIC) ["#test", "another topic"])
it "matches TOPIC example 3" $
pMsg "TOPIC #test\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left TOPIC) ["#test"])
it "matches NAMES example 1" $
pMsg "NAMES #twilight_zone,#42\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left NAMES) ["#twilight_zone,#42"])
it "matches NAMES example 2" $
pMsg "NAMES\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left NAMES) [])
it "matches LIST example 1" $
pMsg "LIST\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left LIST) [])
it "matches LIST example 2" $
pMsg "LIST #twilight_zone,#42\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left LIST) ["#twilight_zone,#42"])
it "matches INVITE example 1" $
pMsg ":Angel INVITE Wiz #Dust\r\n"
`shouldBe`
Right (IrcMessage
(Just (Right (NickName "Angel" Nothing Nothing)))
(Left INVITE) ["Wiz", "#Dust"])
it "matches INVITE example 2" $
pMsg "INVITE Wiz #Twilight_Zone\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left INVITE) ["Wiz", "#Twilight_Zone"])
it "matches KICK example 1" $
pMsg "KICK &Melbourne Matthew\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left KICK) ["&Melbourne", "Matthew"])
it "matches KICK example 2" $
pMsg "KICK #Finnish John :Speaking English\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left KICK)
["#Finnish", "John", "Speaking English"])
it "matches KICK example 3" $
pMsg ":WiZ KICK #Finnish John\r\n"
`shouldBe`
Right (IrcMessage
(Just (Right (NickName "WiZ" Nothing Nothing)))
(Left KICK) ["#Finnish", "John"])
it "matches VERSION example 1" $
pMsg ":WiZ VERSION *.se\r\n"
`shouldBe`
Right (IrcMessage
(Just (Right (NickName "WiZ" Nothing Nothing)))
(Left VERSION) ["*.se"])
it "matches VERSION example 2" $
pMsg "VERSION tolsun.oulu.fi\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left VERSION) ["tolsun.oulu.fi"])
it "matches STATS example 1" $
pMsg "STATS m\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left STATS) ["m"])
it "matches STATS example 2" $
pMsg ":Wiz STATS c eff.org\r\n"
`shouldBe`
Right (IrcMessage
(Just (Right (NickName "Wiz" Nothing Nothing)))
(Left STATS) ["c", "eff.org"])
it "matches LINKS example 1" $
pMsg "LINKS *.au\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left LINKS) ["*.au"])
it "matches LINKS example 2" $
pMsg ":WiZ LINKS *.bu.edu *.edu\r\n"
`shouldBe`
Right (IrcMessage
(Just (Right (NickName "WiZ" Nothing Nothing)))
(Left LINKS) ["*.bu.edu", "*.edu"])
it "matches TIME example 1" $
pMsg "TIME tolsun.oulu.fi\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left TIME) ["tolsun.oulu.fi"])
it "matches TIME example 2" $
pMsg ":Angel TIME *.au\r\n"
`shouldBe`
Right (IrcMessage
(Just (Right (NickName "Angel" Nothing Nothing)))
(Left TIME) ["*.au"])
it "matches CONNECT example 1" $
pMsg "CONNECT tolsun.oulu.fi\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left CONNECT) ["tolsun.oulu.fi"])
it "matches CONNECT example 2" $
pMsg ":WiZ CONNECT eff.org 6667 csd.bu.edu\r\n"
`shouldBe`
Right (IrcMessage
(Just (Right (NickName "WiZ" Nothing Nothing)))
(Left CONNECT) ["eff.org", "6667", "csd.bu.edu"])
it "matches TRACE example 1" $
pMsg "TRACE *.oulu.fi\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left TRACE) ["*.oulu.fi"])
it "matches TRACE example 2" $
pMsg ":WiZ TRACE AngelDust\r\n"
`shouldBe`
Right (IrcMessage
(Just (Right (NickName "WiZ" Nothing Nothing)))
(Left TRACE) ["AngelDust"])
it "matches ADMIN example 1" $
pMsg "ADMIN tolsun.oulu.fi\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left ADMIN) ["tolsun.oulu.fi"])
it "matches ADMIN example 2" $
pMsg ":WiZ ADMIN *.edu\r\n"
`shouldBe`
Right (IrcMessage
(Just (Right (NickName "WiZ" Nothing Nothing)))
(Left ADMIN) ["*.edu"])
it "matches INFO example 1" $
pMsg "INFO csd.bu.edu\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left INFO) ["csd.bu.edu"])
it "matches INFO example 2" $
pMsg ":Avalon INFO *.fi\r\n"
`shouldBe`
Right (IrcMessage
(Just (Right (NickName "Avalon" Nothing Nothing)))
(Left INFO) ["*.fi"])
it "matches INFO example 3" $
pMsg "INFO Angel\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left INFO) ["Angel"])
it "matches PRIVMSG example 1" $
pMsg ":Angel PRIVMSG Wiz :Hello are you receiving this message ?\r\n"
`shouldBe`
Right (IrcMessage
(Just (Right (NickName "Angel" Nothing Nothing)))
(Left PRIVMSG)
["Wiz", "Hello are you receiving this message ?"])
it "matches PRIVMSG example 2" $
pMsg "PRIVMSG Angel :yes I'm receiving it!\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left PRIVMSG)
["Angel", "yes I'm receiving it!"])
it "matches PRIVMSG example 3" $
pMsg "PRIVMSG jto@tolsun.oulu.fi :Hello !\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left PRIVMSG)
["jto@tolsun.oulu.fi", "Hello !"])
it "matches PRIVMSG example 4" $
pMsg "PRIVMSG $*.fi :Server tolsun.oulu.fi rebooting.\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left PRIVMSG)
["$*.fi", "Server tolsun.oulu.fi rebooting."])
it "matches PRIVMSG example 5" $
pMsg "PRIVMSG #*.edu :NSFNet is undergoing work, expect interruptions\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left PRIVMSG)
["#*.edu", "NSFNet is undergoing work, expect interruptions"])
it "matches WHO example 1" $
pMsg "WHO *.fi\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left WHO) ["*.fi"])
it "matches WHO example 2" $
pMsg "WHO jto* o\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left WHO) ["jto*", "o"])
it "matches WHOIS example 1" $
pMsg "WHOIS wiz\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left WHOIS) ["wiz"])
it "matches WHOIS example 2" $
pMsg "WHOIS eff.org trillian\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left WHOIS) ["eff.org", "trillian"])
it "matches WHOWAS example 1" $
pMsg "WHOWAS Wiz\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left WHOWAS) ["Wiz"])
it "matches WHOWAS example 2" $
pMsg "WHOWAS Mermaid 9\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left WHOWAS) ["Mermaid", "9"])
it "matches WHOWAS example 3" $
pMsg "WHOWAS Trillian 1 *.edu\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left WHOWAS) ["Trillian", "1", "*.edu"])
it "matches KILL example" $
pMsg "KILL David :(csd.bu.edu <- tolsun.oulu.fi)\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left KILL)
["David", "(csd.bu.edu <- tolsun.oulu.fi)"])
it "matches PING example 1" $
pMsg "PING tolsun.oulu.fi\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left PING) ["tolsun.oulu.fi"])
it "matches PING example 2" $
pMsg "PING WiZ\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left PING) ["WiZ"])
it "matches PONG example" $
pMsg "PONG csd.bu.edu tolsun.oulu.fi\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left PONG)
["csd.bu.edu", "tolsun.oulu.fi"])
it "matches ERROR example" $
pMsg "ERROR :Server *.fi already exists\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left ERROR)
["Server *.fi already exists"])
it "matches AWAY example 1" $
pMsg "AWAY :Gone to lunch. Back in 5\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left AWAY)
["Gone to lunch. Back in 5"])
it "matches AWAY example 2" $
pMsg ":WiZ AWAY\r\n"
`shouldBe`
Right (IrcMessage
(Just (Right (NickName "WiZ" Nothing Nothing)))
(Left AWAY) [])
it "matches REHASH example" $
pMsg "REHASH\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left REHASH) [])
it "matches RESTART example" $
pMsg "RESTART\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left RESTART) [])
it "matches SUMMON example 1" $
pMsg "SUMMON jto\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left SUMMON) ["jto"])
it "matches SUMMON example 2" $
pMsg "SUMMON jto tolsun.oulu.fi\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left SUMMON) ["jto", "tolsun.oulu.fi"])
it "matches USERS example 1" $
pMsg "USERS eff.org\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left USERS) ["eff.org"])
it "matches USERS example 2" $
pMsg ":John USERS tolsun.oulu.fi\r\n"
`shouldBe`
Right (IrcMessage
(Just (Right (NickName "John" Nothing Nothing)))
(Left USERS) ["tolsun.oulu.fi"])
it "matches WALLOPS example" $
pMsg ":csd.bu.edu WALLOPS :Connect '*.uiuc.edu 6667' from Joshua\r\n"
`shouldBe`
Right (IrcMessage
(Just (Left "csd.bu.edu"))
(Left WALLOPS) ["Connect '*.uiuc.edu 6667' from Joshua"])
it "matches USERHOST example" $
pMsg "USERHOST Wiz Michael Marty p\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left USERHOST)
["Wiz", "Michael", "Marty", "p"])
it "matches ISON example" $
pMsg "ISON phone trillian WiZ jarlek Avalon Angel Monstah\r\n"
`shouldBe`
Right (IrcMessage Nothing (Left ISON)
["phone", "trillian", "WiZ", "jarlek", "Avalon"
, "Angel", "Monstah"])
where
pMsgOrLine = parseOnly parseMsgOrLine
pMsg = parseOnly parseIrcMessage
msgRenderSpec :: Spec
msgRenderSpec = undefined