Adds a login command.

src/Link/Protocol.hs

@@ -9,6 +9,7 @@ import Link.Types
 parseCommand :: String -> Maybe Message
 parseCommand command = case words command of
   ["PONG"]                   -> Just Pong
+  "LOGIN" : userName         -> Just $ Login (unwords userName)
   "MSG" : userName : msg     -> Just $ Msg (User userName) (unwords msg)
   "TELL" : channelName : msg -> Just $ Tell channelName (unwords msg)
   ["QUIT"]                   -> Just Quit
@@ -20,7 +21,7 @@ parseCommand command = case words command of
 formatMessage :: Message -> String
 formatMessage (MsgReply user msg)       = printf "MSG %s %s" (userName user) msg
 formatMessage (NameInUse name)          = printf "NAMEINUSE %s" name
-formatMessage (Connected name)          = printf "CONNECTED %s" name
+formatMessage (LoggedIn name)           = printf "LOGGEDIN %s" name
 formatMessage Ping                      = "PING"
 formatMessage (NoSuchUser name)         = printf "NOSUCHUSER %s" name
 formatMessage (Joined channelName user) = printf "JOINED %s %s" channelName (userName user)

src/Link/Server.hs

@@ -32,10 +32,9 @@ connectClient server handle = do
   readName
   where
     readName = do
-      name <- hGetLine handle
-      if null name
-      then readName
-      else do
+      command <- fmap parseCommand $ hGetLine handle
+      case command of
+        Just (Login name) -> do
           let user = User name
           ok <- checkAddClient server user handle
           case ok of
@@ -43,8 +42,9 @@ connectClient server handle = do
               printToHandle handle . formatMessage $ NameInUse name
               readName
             Just client -> do
-            printToHandle handle . formatMessage $ Connected name
+              printToHandle handle . formatMessage $ LoggedIn name
               runClient server client `finally` removeClient server user
+        _ -> readName
 
 checkAddClient :: Server -> User -> Handle -> IO (Maybe Client)
 checkAddClient Server {..} user@User {..} handle =

src/Link/Types.hs

@@ -54,7 +54,7 @@ newServer = do
   return $ Server serverUsers serverChannels
 
 data Message = NameInUse UserName
-             | Connected UserName
+             | LoggedIn UserName
              | Ping
              | MsgReply User String
              | TellReply ChannelName User String
@@ -63,6 +63,7 @@ data Message = NameInUse UserName
              | Leaved ChannelName User
              | NamesReply ChannelName (Set.Set User)
              | Pong
+             | Login UserName
              | Msg User String
              | Tell ChannelName String
              | Join ChannelName