{-# LANGUAGE OverloadedStrings #-} 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 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 main :: IO () main = defaultMain tests tests :: TestTree tests = testGroup "Tests" [specs] --tests = testGroup "Tests" [specs, properties, unitTests] -- Hspec Tests specs :: TestTree specs = testGroup "Specifications" [ HS.testCase "Message Parsing" msgParseSpec -- , 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" [ HS.testCase "List comparison (different length)" $ [1, 2, 3] `compare` [1,2] @?= GT -- the following test does not hold , HS.testCase "List comparison (same length)" $ [1, 2, 3] `compare` [1,2,2] @?= LT ] -}