A couple of silly examples

So having being mostly stumped on a few other ideas, I was rereading a textbook on OS design and saw that one of the exercises was to create an echo server. I thought I'd clean up one I had written in the past to learn the Network library and post it up here.

>port :: PortID
>port = PortNumber 6000

>main = withSocketsDo $ do
> sock <- listenOn port 
> handler sock

>handler :: Socket -> IO ()
>handler s = do
>  (h,_,_) <- accept s 
>  hSetBuffering h NoBuffering
>  forkIO $ echo h
>  handler s

>echo :: Handle -> IO ()
>echo h= do
>  text <- liftM (filter (/='\r')) $ hGetLine h 
>  if text=="exit"
>     then hClose h
>     else do
>          hPutStrLn h text
>          echo h
>

If you run this and telnet to localhost 6000 you should be able to see it work. Actually writing this code was very simple and felt very intuitive.

Now, that's pretty simple and a nice start: now let's say we wanted a simple server that can handle connections, creating logins, and validating logins. The problem is that now the threads need to share some kind of information, and that makes things a lot more messy; however, Software Transactional Memory makes it a bit easier.

We'll take a very silly way to store usernames and passwords, as tuples in some list.

>type Login = (String,String)

Now our actual "database" of logins will be a STM TVar of a list of logins. For those unfamiliar with STM, I really do recommend reading some of the original papers. They're rather well written and clear in motivating how one would use STM. For now, all that matters is that a TVar is a mutable object that can be accessed and modified atomically.

>type DB = TVar [Login]

>main = do
> db <- newTVarIO [] 
> sock <- listenOn port 
> handler sock db

>handler :: Socket -> DB -> IO ()
>handler s db = do
>  (h,_,_) <- accept s 
>  hSetBuffering h NoBuffering
>  forkIO $ loginServer h db
>  handler s db

>loginServer :: Handle -> DB -> IO ()
>loginServer h db = do
>  hPutStrLn h "Welcome to my server, log in or create an account:  "
>  hPutStrLn h "[0]:log in\n[1]:create account\n[2]:exit"
>  choice <- liftM (filter (/='\r')) $  hGetLine h 
>  case choice of
>    "0" -> validate h db
>    "1" -> create h db
>    "2" -> hClose h
>    _ -> loginServer h db
>
>validate :: Handle -> DB -> IO ()
>validate h db = do
>  hPutStr h "username:  "
>  name <- liftM (filter (/='\r')) $ hGetLine h 
>  hPutStr h "password:  "
>  pass <- liftM (filter (/='\r')) $ hGetLine h
>  (found,pass') <- atomically $ loginLookup name db
>  if found && (pass'==pass)
>    then hPutStrLn h "You can log in!"
>    else hPutStrLn h "Not valid."
>  loginServer h db
>             
>create :: Handle -> DB -> IO ()
>create h db = do
>  hPutStr h "username:  "
>  name <- liftM (filter (/='\r')) $ hGetLine h 
>  (found,_) <- atomically $ loginLookup name db 
>  if found
>    then hPutStrLn h "Name already in use!"
>    else do
>         hPutStr h "Choose a password:  "
>         pass <- liftM (filter (/='\r')) $ hGetLine h 
>         atomically $ pushDB name pass db
>         hPutStrLn h "Account created"
>  loginServer h db
>
>loginLookup :: String -> DB -> STM (Bool,String)
>loginLookup name db = do
>    db' <- readTVar db 
>    case lookup name db' of
>      Nothing -> return (False,"")
>      Just p -> return (True,p)
>
>pushDB :: String -> String -> DB -> STM ()
>pushDB name pass db = do
>  db' <- readTVar db 
>  writeTVar db ((name,pass):db')

Now this isn't the cleanest code, and I'm worried I may have missed some edge cases that can make it fail, but for the most part I think this is a pretty decent example of shared transactional memory combined with the Network library. The main point is that STM allows us to mostly ignore issues of how to keep everything synched together.