658 lines
22 KiB
Haskell
658 lines
22 KiB
Haskell
|
{-# 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
|
||
|
|
]
|
||
|
|
-}
|