Adds Quit command.

src/Link/Client.hs

@@ -56,7 +56,7 @@ runClient Server {..} client@Client {..} = do
     run clientAlive = do
       alive <- readMVar clientAlive
       if not alive
-        then printf "Client timed out: %s\n" (userName clientUser)
+        then printf "Closing connection: %s\n" (userName clientUser)
         else do
           r <-  try . timeout pingDelayMicros $ race readCommand readMessage
           case r of
@@ -67,7 +67,7 @@ runClient Server {..} client@Client {..} = do
                 case cm of
                   Left mcommand -> case mcommand of
                     Nothing      -> printf "Could not parse command\n"
-                    Just command -> handleCommand command
+                    Just command -> handleCommand command clientAlive
                   Right message -> sendResponse client message
                 run clientAlive
 
@@ -78,11 +78,12 @@ runClient Server {..} client@Client {..} = do
 
     readMessage = readChan clientChan
 
-    handleCommand (PrivMsg user msg) =
+    handleCommand (Msg user msg) _ =
       withMVar serverUsers $ \clientMap ->
         case Map.lookup user clientMap of
           Nothing      -> sendResponse client $ NoSuchUser (userName user)
-          Just client' -> sendMessage client' $ PrivMsg clientUser msg
-    handleCommand Pong = do
+          Just client' -> sendMessage client' $ Msg clientUser msg
+    handleCommand Pong _ = do
       now <- getCurrentTime
       void $ swapMVar clientPongTime now
+    handleCommand Quit clientAlive = void $ swapMVar clientAlive False

src/Link/Protocol.hs

@@ -6,13 +6,14 @@ import Link.Types
 
 parseCommand :: String -> Maybe Message
 parseCommand command = case words command of
-  ["PONG"]                   -> Just Pong
-  "PRIVMSG" : userName : msg -> Just $ PrivMsg (User userName) (unwords msg)
-  _                          -> Nothing
+  ["PONG"]               -> Just Pong
+  "MSG" : userName : msg -> Just $ Msg (User userName) (unwords msg)
+  ["QUIT"]               -> Just $ Quit
+  _                      -> Nothing
 
 formatMessage :: Message -> String
-formatMessage (PrivMsg user msg) = printf "PRIVMSG %s %s" (userName user) msg
-formatMessage (NameInUse name)   = printf "NAMEINUSE %s" name
-formatMessage (Connected name)   = printf "CONNECTED %s" name
-formatMessage Ping               = "PING"
-formatMessage (NoSuchUser name)  = printf "NOSUCHUSER %s" name
+formatMessage (Msg user msg)    = printf "MSG %s %s" (userName user) msg
+formatMessage (NameInUse name)  = printf "NAMEINUSE %s" name
+formatMessage (Connected name)  = printf "CONNECTED %s" name
+formatMessage Ping              = "PING"
+formatMessage (NoSuchUser name) = printf "NOSUCHUSER %s" name

src/Link/Types.hs

@@ -26,6 +26,7 @@ data Message = NameInUse UserName
              | Connected UserName
              | Ping
              | Pong
-             | PrivMsg User String
+             | Msg User String
              | NoSuchUser UserName
+             | Quit
                deriving (Show, Eq)