From 469b600aa2c0dbb9f732b1eabc5744c0d72546b6 Mon Sep 17 00:00:00 2001 From: Abhinav Sarkar Date: Thu, 10 Sep 2015 18:41:56 +0530 Subject: [PATCH] Adds a login command. --- src/Link/Protocol.hs | 3 ++- src/Link/Server.hs | 38 +++++++++++++++++++------------------- src/Link/Types.hs | 3 ++- 3 files changed, 23 insertions(+), 21 deletions(-) diff --git a/src/Link/Protocol.hs b/src/Link/Protocol.hs index 60fb928..d2810b1 100644 --- a/src/Link/Protocol.hs +++ b/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) diff --git a/src/Link/Server.hs b/src/Link/Server.hs index d9bde59..f5dc198 100644 --- a/src/Link/Server.hs +++ b/src/Link/Server.hs @@ -1,12 +1,12 @@ module Link.Server where import Control.Concurrent -import Control.Exception hiding (handle) -import Control.Monad (forever) -import Network (withSocketsDo, listenOn, accept, PortID(..)) -import System.IO (hClose, hSetNewlineMode, hSetBuffering, BufferMode(..), - universalNewlineMode, hGetLine, Handle, stdout) -import Text.Printf (printf) +import Control.Exception hiding (handle) +import Control.Monad (forever) +import Network (withSocketsDo, listenOn, accept, PortID(..)) +import System.IO (hClose, hSetNewlineMode, hSetBuffering, BufferMode(..), + universalNewlineMode, hGetLine, Handle, stdout) +import Text.Printf (printf) import qualified Data.Map.Strict as Map @@ -32,19 +32,19 @@ connectClient server handle = do readName where readName = do - name <- hGetLine handle - if null name - then readName - else do - let user = User name - ok <- checkAddClient server user handle - case ok of - Nothing -> do - printToHandle handle . formatMessage $ NameInUse name - readName - Just client -> do - printToHandle handle . formatMessage $ Connected name - runClient server client `finally` removeClient server user + command <- fmap parseCommand $ hGetLine handle + case command of + Just (Login name) -> do + let user = User name + ok <- checkAddClient server user handle + case ok of + Nothing -> do + printToHandle handle . formatMessage $ NameInUse name + readName + Just client -> do + 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 = diff --git a/src/Link/Types.hs b/src/Link/Types.hs index 202e686..39e37d4 100644 --- a/src/Link/Types.hs +++ b/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