Misc refresh and cleanup, added some QuickCheck props

pipes-irc-server.cabal

@@ -23,26 +23,26 @@ executable pipes-irc-server
                    , Pipes.IRC.Server.Types
                    , Pipes.IRC.Server.MessageHandler
   -- other-extensions:    
-  build-depends:     base              >= 4.6    && < 4.7
+  build-depends:     base
-                   , mtl               >= 2.1    && < 3
+                   , mtl
-                   , errors            >= 1.4    && < 2
+                   , errors
-                   , mmorph            >= 1      && < 2
+                   , mmorph
-                   , containers        >= 0.5    && < 1
+                   , containers
-                   , bytestring        >= 0.10   && < 0.11
+                   , bytestring
-                   , text              >= 0.11.3 && < 0.12
+                   , text
-                   , attoparsec        >= 0.10   && < 0.11
+                   , attoparsec
-                   , network           >= 2.4    && < 2.5
+                   , network
-                   , pipes             >= 4      && < 5
+                   , pipes
-                   , pipes-concurrency >= 2      && < 3
+                   , pipes-concurrency
-                   , pipes-bytestring  >= 1.0    && < 2
+                   , pipes-bytestring
-                   , pipes-parse       >= 2.0    && < 3
+                   , pipes-parse
-                   , pipes-attoparsec  >= 0.3    && < 1
+                   , pipes-attoparsec
-                   , pipes-network     >= 0.6    && < 1
+                   , pipes-network
-                   , stm               >= 2      && < 3
+                   , stm
-                   , time              >= 1.4    && < 1.5
+                   , time
-                   , async             >= 2      && < 3
+                   , async
-                   , free              >= 3      && < 4
+                   , free
-                   , lens              >= 3      && < 4
+                   , lens
                        
   hs-source-dirs:    src
   default-language:  Haskell2010
@@ -50,21 +50,23 @@ executable pipes-irc-server
 test-suite tests
   type:              exitcode-stdio-1.0
   main-is:           Main.hs
-  build-depends:     base              >= 4.6    && < 4.7
+  build-depends:     base
-                   , mtl               >= 2.1    && < 3
+                   , mtl
-                   , containers        >= 0.5    && < 1
+                   , containers
-                   , bytestring        >= 0.10   && < 0.11
+                   , bytestring
-                   , text              >= 0.11.3 && < 0.12
+                   , text
-                   , attoparsec        >= 0.10   && < 0.11
+                   , attoparsec
-                   , pipes             >= 4      && < 5
+                   , pipes
-                   , pipes-concurrency >= 2      && < 3
+                   , pipes-concurrency
-                   , pipes-bytestring  >= 1.0    && < 2
+                   , pipes-bytestring
-                   , pipes-parse       >= 2.0    && < 3
+                   , pipes-parse
-                   , pipes-attoparsec  >= 0.3    && < 1
+                   , pipes-attoparsec
-                   , pipes-network     >= 0.6    && < 1
+                   , pipes-network
-                   , stm               >= 2      && < 3
+                   , stm
-                   , async             >= 2      && < 3
+                   , async
-                   , free              >= 3      && < 4
+                   , free
+                   , lens
+                   , time
   build-depends:     tasty
                    , tasty-hspec
                    , tasty-hunit

src/Pipes/IRC/Server.hs

@@ -35,10 +35,10 @@ version = "0.1a"
 parseMessage :: Producer ByteString IO ()
              -> Producer (Either ByteString IrcMessage) IO ()
 parseMessage prod = do
-  void $ for (parseMany parseMsgOrLine prod) $ \res ->
+  void $ for (parsed parseMsgOrLine prod) $ \res ->
     case res of
-      (_, Left _)    -> yield $ Left "ERROR Bad Parse"
+      (Left _)    -> yield $ Left "ERROR Bad Parse"
-      (_, Right val) -> yield $ Right val
+      (Right val) -> yield $ Right val
   return ()
 
 renderMessage :: Pipe IrcMessage ByteString IO ()
@@ -153,7 +153,8 @@ idlePinger srv cid =
 
           atomically $ do
             conns <- readTVar (srv ^. ircConnections)
-            PC.send (conns ! cid ^. out) pingMsg
+            void $ PC.send (conns ! cid ^. out) pingMsg
+            return ()
 
           threadDelay oneMinute
 

src/Pipes/IRC/Server/Channel.hs

@@ -15,6 +15,7 @@ module Pipes.IRC.Server.Channel
  , chanSigil
  , chanUserSigil
  , chanSetPass
+ , chanClearPass
  , chanHasPass
  , chanCheckPass
  , chanAddOper
@@ -74,21 +75,21 @@ chanAddUser, chanDelUser :: NickKey    -- ^ user to add to channel
 -- | Add a user to the channel's list of users. This does not change
 -- the set of set of channels on the user or perform any checking;
 -- this just performs the low-level change to the channel.
-chanAddUser un = chanUsers %~ insert un
+chanAddUser uname = chanUsers %~ insert uname
 
 -- | Delete a user from the channel's list of users. This does not
 -- change the set of channels on the user or perform any checking;
 -- this just performs the low-level change to the channel.
-chanDelUser un = (chanUsers %~ delete un)
+chanDelUser uname = (chanUsers %~ delete uname)
-                 . (chanOpers %~ delete un)
+                  . (chanOpers %~ delete uname)
-                 . (chanVoices %~ delete un)
+                  . (chanVoices %~ delete uname)
 
 -- | Is the user owning the given nick on the channel? Returns 'True'
 -- if the user is in fact on the channel.
 chanHasUser :: NickKey    -- ^ user to check presence of on the channel
             -> IrcChannel -- ^ channel in which to look for the user
             -> Bool       -- ^ 'True' if the user is in the channel
-chanHasUser un ch = member un (ch ^. chanUsers)
+chanHasUser uname ch = member uname (ch ^. chanUsers)
 
 -- | Set the topic of discussion in the channel. This does not do any
 -- permission or size checking; it just performs the low-level action.
@@ -123,9 +124,9 @@ chanSigil ch | chanHasModeFlag Secret ch  = "@"
 chanUserSigil :: NickKey    -- ^ nickname of user of which to find sigil
               -> IrcChannel -- ^ channel the user may have status in
               -> ByteString -- ^ the sigil associated with the user's status
-chanUserSigil un ch | member un $ ch ^. chanOpers  = "@"
+chanUserSigil uname ch | member uname $ ch ^. chanOpers  = "@"
-                    | member un $ ch ^. chanVoices = "+"
+                       | member uname $ ch ^. chanVoices = "+"
-                    | otherwise                      = ""
+                       | otherwise                       = ""
 
 -- | Set a password key that must be given with a JOIN command in
 -- order to join the channel. This does no permission or error
@@ -135,6 +136,12 @@ chanSetPass :: PassKey    -- ^ password key to set for a channel
             -> IrcChannel -- ^ channel with the password set
 chanSetPass pwd = chanPass .~ Just pwd
 
+-- | Clear password key for the channel. This does not do permission or
+-- error checking, it just performs the low-level operation.
+chanClearPass :: IrcChannel -- ^ channel to clear the password key
+              -> IrcChannel -- ^ channel with the password cleared
+chanClearPass = chanPass .~ Nothing
+
 -- | Does the channel have a password key set? Returns 'True' if the
 -- channel does have a password key set.
 chanHasPass :: IrcChannel -- ^ channel on which to look for password key
@@ -158,12 +165,12 @@ chanAddOper, chanDelOper :: NickKey    -- ^ nickname of user
 -- | Add the given nickname as an operator on the channel. This does
 -- not perform any permission or error checks, it just performs the
 -- low-level operation.
-chanAddOper un = chanOpers %~ insert un
+chanAddOper uname = chanOpers %~ insert uname
 
 -- | Remove the given nickname as an operator on the channel. This
 -- does not perform any permission or error checks, it just performs
 -- the low-level operation.
-chanDelOper un = chanOpers %~ delete un
+chanDelOper uname = chanOpers %~ delete uname
 
 chanAddVoice, chanDelVoice :: NickKey    -- ^ nickname of user
                            -> IrcChannel -- ^ channel to change voice on
@@ -172,12 +179,12 @@ chanAddVoice, chanDelVoice :: NickKey    -- ^ nickname of user
 -- | Give voice status to the given nickname on the channel. This
 -- does not perform any permission or error checks, it just performs
 -- the low-level operation.
-chanAddVoice un = chanVoices %~ insert un
+chanAddVoice uname = chanVoices %~ insert uname
 
 -- | Remove voice status from the given nickname on the channel. This
 -- does not perform any permission or error checks, it just performs
 -- the low-level operation.
-chanDelVoice un = chanVoices %~ delete un
+chanDelVoice uname = chanVoices %~ delete uname
 
 chanAddInvite, chanDelInvite :: NickKey    -- ^ nickname of user
                              -> IrcChannel -- ^ channel to change invitation
@@ -187,12 +194,12 @@ chanAddInvite, chanDelInvite :: NickKey    -- ^ nickname of user
 -- This will allow the user to join when the channel is invite-only.
 -- This does not perform any permission or error checks, it just does
 -- the operation.
-chanAddInvite un = chanInvites %~ insert un
+chanAddInvite uname = chanInvites %~ insert uname
 
 -- | Remove record of the invitation for the nickname to join the
 -- channel. This does not perform permission or error checks, it just
 -- does the low-level operation.
-chanDelInvite un = chanInvites %~ delete un
+chanDelInvite uname = chanInvites %~ delete uname
 
 -- | Change the nick of a user on the channel. This will replace the
 -- old name with the news name in the member list, invitation list,
@@ -223,7 +230,7 @@ chanChangeNick old new ch = (chOps . chVoice . chInvite . chUsers) ch
 chanUserIsOper :: NickKey    -- ^ nickname to check
                -> IrcChannel -- ^ channel to check
                -> Bool       -- ^ 'True' if nickname has ops on channel
-chanUserIsOper un ch = member un $ ch ^. chanOpers
+chanUserIsOper uname ch = member uname $ ch ^. chanOpers
 
 -- | Does the nickname have voice on the channel? Returns 'True' if
 -- the user has the voice mode flag. This does not consider any other
@@ -231,7 +238,7 @@ chanUserIsOper un ch = member un $ ch ^. chanOpers
 chanUserHasVoice :: NickKey    -- ^ nickname to check
                  -> IrcChannel -- ^ channel to check
                  -> Bool       -- ^ 'True' if nickname has voice on channel
-chanUserHasVoice un ch = member un $ ch ^. chanVoices
+chanUserHasVoice uname ch = member uname $ ch ^. chanVoices
 
 -- | Has the nickname been invited to the channel? Returns 'True' if
 -- the user has been invited. This does not consider any other
@@ -239,7 +246,7 @@ chanUserHasVoice un ch = member un $ ch ^. chanVoices
 chanUserIsInvited :: NickKey    -- ^ nickname to check
                   -> IrcChannel -- ^ channel to check
                   -> Bool       -- ^ 'True' if nickname has been invited
-chanUserIsInvited un ch = member un $ ch ^. chanInvites
+chanUserIsInvited uname ch = member uname $ ch ^. chanInvites
 
 -- | Is the nickname allowed to speak on the channel? Returns 'True'
 -- if the relevant permission checks all pass. The checks consider
@@ -248,11 +255,11 @@ chanUserIsInvited un ch = member un $ ch ^. chanInvites
 chanUserMaySpeak :: NickKey    -- ^ nickname to check
                  -> IrcChannel -- ^ channel to check
                  -> Bool       -- ^ 'True' if nickname may speak on channel
-chanUserMaySpeak un ch
+chanUserMaySpeak uname ch
-  | (chanHasUser un ch || not (chanHasModeFlag NoOutsideMsgs ch))
+  | (chanHasUser uname ch || not (chanHasModeFlag NoOutsideMsgs ch))
      && not (chanHasModeFlag Moderated ch) = True
-  | chanUserIsOper un ch                   = True
+  | chanUserIsOper uname ch                = True
-  | chanUserHasVoice un ch                 = True
+  | chanUserHasVoice uname ch              = True
   | otherwise                              = False
 
 -- | Is the nickname allowed to join the channel? Returns 'True' if
@@ -261,9 +268,9 @@ chanUserMaySpeak un ch
 chanUserMayJoin :: NickKey    -- ^ nickname to check
                 -> IrcChannel -- ^ channel to check
                 -> Bool       -- ^ 'True' if nickname may join the channel
-chanUserMayJoin un ch
+chanUserMayJoin uname ch
   | not $ chanHasModeFlag InviteOnly ch = True
-  | chanUserIsInvited un ch             = True
+  | chanUserIsInvited uname ch          = True
   | otherwise                           = False
 
 -- | Is the nickname allowed to set the topic for the channel?
@@ -271,8 +278,8 @@ chanUserMayJoin un ch
 chanUserMaySetTopic :: NickKey    -- ^ nickname to check
                     -> IrcChannel -- ^ channel to check
                     -> Bool       -- ^ 'True' if nickname may set the topic
-chanUserMaySetTopic un ch
+chanUserMaySetTopic uname ch
   | not (chanHasModeFlag TopicOperOnly ch) &&
-    chanHasUser un ch    = True
+    chanHasUser uname ch    = True
-  | chanUserIsOper un ch = True
+  | chanUserIsOper uname ch = True
-  | otherwise            = False
+  | otherwise               = False

src/Pipes/IRC/Server/EventHandler.hs

@@ -4,6 +4,7 @@ module Pipes.IRC.Server.EventHandler
   ( ircEventHandler )
 where
 
+import           Control.Applicative      ((<$>))
 import           Control.Concurrent.Async
 import           Control.Concurrent.STM
 import           Control.Lens
@@ -25,12 +26,10 @@ ircEventHandler srv evt =
   case evt of
     Close connId -> do
       outConns <- readTVarIO $ srv ^. ircConnections
-      case M.lookup connId outConns of
+      return $ isJust (M.lookup connId outConns)
-        Just IrcConnection{..} -> return False
-        _                      -> return True
     Msg {..} -> do
       outConns <- readTVarIO $ srv ^. ircConnections
-      let os = fmap _out $ DM.mapMaybe (`M.lookup` outConns) _outDest
+      let os = _out <$> DM.mapMaybe (`M.lookup` outConns) _outDest
       sendToMany _outMsg os
       logOutMsg _outMsg _outDest
       return True

src/Pipes/IRC/Server/IrcMonad.hs

@@ -97,7 +97,7 @@ channelTargets chname = do
   let cUsers chan = S.elems (S.delete mynick $ chan ^. chanUsers)
   let chmap = srv ^. ircChannels
   case M.lookup chname chmap of
-    Just chan -> fmap catMaybes $ forM (cUsers chan) userTarget
+    Just chan -> catMaybes <$> forM (cUsers chan) userTarget
     _         -> do tellNumeric err_nosuchnick [chname, ":No such nick/channel"]
                     return []
 

src/Pipes/IRC/Server/MessageHandler.hs

@@ -5,7 +5,7 @@ module Pipes.IRC.Server.MessageHandler
   ( ircMessageHandler )
 where
 
-import           Control.Applicative       (pure, (<$>), (<|>))
+import           Control.Applicative       ((<|>))
 import           Control.Error
 import           Control.Lens
 import           Control.Monad.RWS
@@ -144,7 +144,7 @@ doJoin msg chans = forM_ chans $ \(c, k) -> runValidation $ do
   nick <- checkRegistration
   -- If the channel is absent, joining it will create it
   checkChannelAbsence c
-        -- If it already exists, do some sanity checks first
+  -- If it already exists, do some sanity checks first
     <|> do chan <- checkChannelPresence c
            checkUserNotOnChan nick c chan
            checkInvitation nick c chan

src/Pipes/IRC/Server/Server.hs

@@ -53,9 +53,9 @@ ircDelUser nn srv =
            uchans = S.elems (usr ^. userChannels)
            ichans = S.elems (usr ^. userInvites)
         in
-           (ircUsers    %~ M.delete nn) .
+           (ircUsers    %~ M.delete nn)
-           (ircChannels %~ alterAtKeys (ircPartChan nn) uchans) .
+         . (ircChannels %~ alterAtKeys (ircPartChan nn) uchans)
-           (ircChannels %~ adjustAtKeys (chanDelInvite nn) ichans)
+         . (ircChannels %~ adjustAtKeys (chanDelInvite nn) ichans)
 
 -- | Check whether a user with the given nickname is known by the
 -- server. This only checks for fully-registered users; the nick
@@ -79,18 +79,20 @@ ircJoin :: NickKey   -- ^ nickname of the joining user
         -> ChanKey   -- ^ name of the channel to join
         -> IrcServer -- ^ server to perform the join on
         -> IrcServer -- ^ new server with join completed
-ircJoin un cn = (ircChannels %~ M.alter alterChan cn)
+ircJoin uname cn = (ircChannels %~ M.alter alterChan cn)
-              . (ircUsers    %~ M.adjust (userAddChan cn) un)
+                 . (ircUsers    %~ M.adjust (userAddChan cn) uname)
   where
-    alterChan mChan = Just $ chanAddUser un (fromMaybe (newChannel un) mChan)
+    alterChan mChan = Just $
+       chanAddUser uname (fromMaybe (newChannel uname) mChan)
 
 -- Helper 'alter' function for ircPart, not exported
 ircPartChan :: NickKey -> Maybe IrcChannel -> Maybe IrcChannel
-ircPartChan un (Just chan) = case chanDelUser un chan of
+ircPartChan uname (Just chan) =
-                                IrcChannel{ _chanUsers = us }
+  case chanDelUser uname chan of
-                                  | us == S.empty             -> Nothing
+    IrcChannel{ _chanUsers = us }
-                                chan'                         -> Just chan'
+      | us == S.empty             -> Nothing
-ircPartChan _  Nothing     = Nothing
+    chan'                         -> Just chan'
+ircPartChan _     Nothing     = Nothing
 
 -- | Remove the user with the given nickname from the named
 -- channel. If this causes the channel to become empty, it will be
@@ -99,8 +101,8 @@ ircPart :: NickKey   -- ^ nickname of parting user
         -> ChanKey   -- ^ name of the channel to part from
         -> IrcServer -- ^ server to perform the part on
         -> IrcServer -- ^ new server with part completed
-ircPart un cn srv =
+ircPart uname cn srv =
-  srv & (ircChannels %~ (M.alter $ ircPartChan un) cn)
+  srv & (ircChannels %~ (M.alter $ ircPartChan uname) cn)
       & (ircUsers    %~ adjustAtKeys (userDelInvite cn) iusers)
   where
     chan = (srv ^. ircChannels) ! cn
@@ -112,8 +114,8 @@ ircInvite :: NickKey   -- ^ nickname of user to invite
           -> ChanKey   -- ^ name of channel user is invited to
           -> IrcServer -- ^ server to perform the invitation on
           -> IrcServer -- ^ new server with invite completed
-ircInvite un cn = (ircChannels %~ M.adjust (chanAddInvite un) cn)
+ircInvite uname cn = (ircChannels %~ M.adjust (chanAddInvite uname) cn)
-                . (ircUsers    %~ M.adjust (userAddInvite cn) un)
+                   . (ircUsers    %~ M.adjust (userAddInvite cn) uname)
 
 -- | Determine whether the user with the given nickname is disallowed
 -- from joining the channel due to the 'InviteOnly' flag and lack of

src/Pipes/IRC/Server/Types.hs

@@ -62,7 +62,7 @@ data IrcUserMode = Away          -- ^ the user is marked as away from keyboard
                  | Oper          -- ^ the user is an IRC operator
                  | LocalOper     -- ^ the user is a local server operator
                  | ServerNotices -- ^ the user receives server notices
-            deriving (Show, Eq, Enum, Ord)
+            deriving (Show, Eq, Enum, Ord, Bounded)
 
 -- | An 'IrcUser' record tracks the state of a registered user that is not
 -- channel-specific.
@@ -90,7 +90,7 @@ data IrcChanModeFlags = Anonymous      -- ^ all communication is anonymized
                       | Private        -- ^ channel shows up as private in list
                       | Secret         -- ^ channel does not appear in list
                       | TopicOperOnly  -- ^ topic may only be set by ops
-            deriving (Show, Eq, Enum, Ord)
+            deriving (Show, Eq, Enum, Ord, Bounded)
 
 -- | An 'IrcChannel' record tracks the state of a channel.
 data IrcChannel =

tests/Main.hs

@@ -3,27 +3,27 @@
 module Main where
 
 import           Test.Tasty
-import           Test.Tasty.Hspec                 as HS
+import           Test.Tasty.Hspec         as HS
---import           Test.Tasty.HUnit                 as HU
+import           Test.Tasty.QuickCheck    as QC
---import           Test.Tasty.QuickCheck            as QC
---import           Test.Tasty.SmallCheck            as SC
 
-import           Data.Attoparsec.ByteString.Char8 as P
+import           Control.Applicative
-import           Data.ByteString.Char8            as C8
+
+import qualified Data.ByteString.Char8    as C8
 import           Data.List
-import           Data.Ord
+import           Data.Monoid
 
-import           Pipes.IRC.Message.Parse
+import           ParseTests
-import           Pipes.IRC.Message.Render
+
-import           Pipes.IRC.Message.Types
+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, userProperties, chanProperties]
---tests = testGroup "Tests" [specs, properties, unitTests]
-
 
 -- 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''

tests/ParseTests.hs

@@ -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