pipes-irc-server/tests/ParseTests.hs

{-# 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