Misc refresh and cleanup, added some QuickCheck props
This commit is contained in:
Levi Pearson
751
tests/Main.hs
751
tests/Main.hs
@@ -3,27 +3,27 @@
|
||||
module Main where
|
||||
|
||||
import Test.Tasty
|
||||
import Test.Tasty.Hspec as HS
|
||||
--import Test.Tasty.HUnit as HU
|
||||
--import Test.Tasty.QuickCheck as QC
|
||||
--import Test.Tasty.SmallCheck as SC
|
||||
import Test.Tasty.Hspec as HS
|
||||
import Test.Tasty.QuickCheck as QC
|
||||
|
||||
import Data.Attoparsec.ByteString.Char8 as P
|
||||
import Data.ByteString.Char8 as C8
|
||||
import Control.Applicative
|
||||
|
||||
import qualified Data.ByteString.Char8 as C8
|
||||
import Data.List
|
||||
import Data.Ord
|
||||
import Data.Monoid
|
||||
|
||||
import Pipes.IRC.Message.Parse
|
||||
import Pipes.IRC.Message.Render
|
||||
import Pipes.IRC.Message.Types
|
||||
import ParseTests
|
||||
|
||||
import Pipes.IRC.Server.Channel
|
||||
import Pipes.IRC.Server.Server
|
||||
import Pipes.IRC.Server.Types
|
||||
import Pipes.IRC.Server.User
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain tests
|
||||
|
||||
tests :: TestTree
|
||||
tests = testGroup "Tests" [specs]
|
||||
--tests = testGroup "Tests" [specs, properties, unitTests]
|
||||
|
||||
tests = testGroup "Tests" [specs, userProperties, chanProperties]
|
||||
|
||||
-- Hspec Tests
|
||||
|
||||
@@ -33,617 +33,8 @@ specs = testGroup "Specifications"
|
||||
-- , HS.testCase "Message Rendering" msgRenderSpec
|
||||
]
|
||||
|
||||
msgParseSpec :: Spec
|
||||
msgParseSpec = do
|
||||
|
||||
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
|
||||
|
||||
-- QuickCheck and SmallCheck properties
|
||||
{-
|
||||
properties :: TestTree
|
||||
properties = testGroup "Properties" [qcProps, scProps]
|
||||
|
||||
scProps :: TestTree
|
||||
scProps = testGroup "(Checked by SmallCheck)"
|
||||
[ SC.testProperty "sort == sort . reverse" $
|
||||
\list -> sort (list :: [Int]) == sort (reverse list)
|
||||
, SC.testProperty "Fermat's little theorem" $
|
||||
\x -> ((x :: Integer)^7 - x) `mod` 7 == 0
|
||||
-- the following property does not hold
|
||||
, SC.testProperty "Fermat's last theorem" $
|
||||
\x y z n ->
|
||||
(n :: Integer) >= 3 SC.==> x^n + y^n /= (z^n :: Integer)
|
||||
]
|
||||
|
||||
qcProps = testGroup "(checked by QuickCheck)"
|
||||
[ QC.testProperty "sort == sort . reverse" $
|
||||
\list -> sort (list :: [Int]) == sort (reverse list)
|
||||
, QC.testProperty "Fermat's little theorem" $
|
||||
\x -> ((x :: Integer)^7 - x) `mod` 7 == 0
|
||||
-- the following property does not hold
|
||||
, QC.testProperty "Fermat's last theorem" $
|
||||
\x y z n ->
|
||||
(n :: Integer) >= 3 QC.==> x^n + y^n /= (z^n :: Integer)
|
||||
]
|
||||
|
||||
|
||||
-- HUnit tests
|
||||
|
||||
unitTests = testGroup "Unit tests"
|
||||
@@ -655,3 +46,119 @@ unitTests = testGroup "Unit tests"
|
||||
[1, 2, 3] `compare` [1,2,2] @?= LT
|
||||
]
|
||||
-}
|
||||
|
||||
instance Arbitrary C8.ByteString where
|
||||
arbitrary = C8.pack <$> listOf1 (elements ['a'..'z'])
|
||||
|
||||
instance Arbitrary IrcUser where
|
||||
arbitrary = newUser <$> arbitrary
|
||||
<*> suchThat arbitrary (>0)
|
||||
|
||||
instance Arbitrary IrcUserMode where
|
||||
arbitrary = elements [minBound .. maxBound]
|
||||
|
||||
-- * User properties
|
||||
|
||||
userProperties :: TestTree
|
||||
userProperties = testGroup "User Properties" [userqcProps]
|
||||
|
||||
userqcProps :: TestTree
|
||||
userqcProps = testGroup "(checked by QuickCheck)"
|
||||
[ QC.testProperty "userDelChan . userAddChan == id" $
|
||||
\user chanKey -> (userDelChan chanKey . userAddChan chanKey) user == user
|
||||
|
||||
, QC.testProperty "userDelMode . userAddMode == id" $
|
||||
\user mode -> (userDelMode mode . userAddMode mode) user == user
|
||||
|
||||
, QC.testProperty "userDelInvite . userAddInvite == id" $
|
||||
\user inv -> (userDelInvite inv . userAddInvite inv) user == user
|
||||
|
||||
, QC.testProperty "userHasMode . userAddMode == True" $
|
||||
\u m -> (userHasMode m . userAddMode m) u
|
||||
|
||||
, QC.testProperty "userInChan . userAddChan == True" $
|
||||
\u ck -> (userInChan ck . userAddChan ck) u
|
||||
|
||||
, QC.testProperty "adding and removing multiple channels" manyChans
|
||||
, QC.testProperty "adding and removing many modes" manyModes
|
||||
, QC.testProperty "adding and removing many invites" manyInvites
|
||||
]
|
||||
|
||||
|
||||
manyChans :: IrcUser -> [ChanKey] -> Bool
|
||||
manyChans u ks =
|
||||
let cs = nub ks
|
||||
scs = sort cs
|
||||
newu = foldr userAddChan u cs
|
||||
newu' = foldr userDelChan newu scs
|
||||
in newu' == u && all (`userInChan` newu) cs
|
||||
|
||||
manyModes :: IrcUser -> [IrcUserMode] -> Bool
|
||||
manyModes u ms =
|
||||
let ms' = nub ms
|
||||
sms = sort ms'
|
||||
newu = foldr userAddMode u ms'
|
||||
newu' = foldr userDelMode newu sms
|
||||
in newu' == u && all (`userHasMode` newu) ms'
|
||||
|
||||
manyInvites :: IrcUser -> [ChanKey] -> Bool
|
||||
manyInvites u ks = let cs = nub ks
|
||||
scs = sort cs
|
||||
newu = foldr userAddInvite u cs
|
||||
newu' = foldr userDelInvite newu scs
|
||||
in newu' == u
|
||||
|
||||
-- * Channel properties
|
||||
|
||||
instance Arbitrary IrcChannel where
|
||||
arbitrary = newChannel <$> arbitrary
|
||||
|
||||
instance Arbitrary IrcChanModeFlags where
|
||||
arbitrary = elements [minBound .. maxBound]
|
||||
|
||||
chanProperties :: TestTree
|
||||
chanProperties = testGroup "Channel Properties" [chanqcProps]
|
||||
|
||||
chanqcProps :: TestTree
|
||||
chanqcProps = testGroup "(checked by QuickCheck)" [
|
||||
QC.testProperty "add/del modeFlags" $
|
||||
\c m -> (chanDelModeFlag m . chanAddModeFlag m) c == c
|
||||
|
||||
, QC.testProperty "add/del users" $
|
||||
\c u -> not (chanHasUser u c) ==>
|
||||
(chanDelUser u . chanAddUser u) c == c
|
||||
|
||||
, QC.testProperty "set/check pass" $
|
||||
\c p -> (chanClearPass . chanSetPass p) c == c
|
||||
|
||||
, QC.testProperty "add/del oper" $
|
||||
\c u -> not (chanHasUser u c) ==>
|
||||
(chanDelOper u . chanAddOper u) c == c
|
||||
|
||||
, QC.testProperty "add/del voice" $
|
||||
\c u -> (chanDelVoice u . chanAddVoice u) c == c
|
||||
|
||||
, QC.testProperty "add/del invite" $
|
||||
\c u -> (chanDelInvite u . chanAddInvite u) c == c
|
||||
|
||||
, QC.testProperty "nick change" nameChange
|
||||
]
|
||||
|
||||
instance Monoid Bool where
|
||||
mappend = (&&)
|
||||
mempty = True
|
||||
|
||||
nameChange :: IrcChannel -> [NickKey] -> NickKey -> NickKey -> Property
|
||||
nameChange c ns n n' =
|
||||
let ns' = nub ns
|
||||
newc = foldr (\x -> chanAddInvite x
|
||||
.chanAddVoice x
|
||||
.chanAddOper x
|
||||
.chanAddUser x) c (n:ns')
|
||||
newc' = chanChangeNick n n' newc
|
||||
newc'' = foldr chanDelUser newc' ns'
|
||||
in n' `notElem` ns && n /= n' ==>
|
||||
mconcat [ chanHasUser n'
|
||||
, chanUserIsInvited n'
|
||||
, chanUserHasVoice n'
|
||||
, chanUserIsOper n'] newc''
|
||||
|
||||
597
tests/ParseTests.hs
Normal file
597
tests/ParseTests.hs
Normal file
@@ -0,0 +1,597 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module ParseTests where
|
||||
|
||||
import Test.Tasty
|
||||
import Test.Tasty.Hspec as HS
|
||||
|
||||
import Data.Attoparsec.ByteString.Char8 as P
|
||||
import Data.ByteString.Char8 as C8
|
||||
import Data.List
|
||||
import Data.Ord
|
||||
|
||||
import Pipes.IRC.Message.Parse
|
||||
import Pipes.IRC.Message.Render
|
||||
import Pipes.IRC.Message.Types
|
||||
|
||||
msgParseSpec :: Spec
|
||||
msgParseSpec = do
|
||||
|
||||
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
|
||||
Reference in New Issue
Block a user