Game server in Haskell - haskell

I'm using Network and Gloss for a game server in Haskell. It works fine, except that the client has to close for the server to receive the data it sent. I bet it's a case of laziness...
Minimalist server:
import Network
import System.IO
main = do
sock <- listenOn (PortNumber (fromIntegral 12345))
loop sock
loop sock = do
(hIn, _, _) <- accept sock
str <- hGetContents hIn
print str
loop sock
Minimalist client:
import Network
import System.IO
import Graphics.Gloss.Interface.IO.Game
main = playIO
(InWindow "Test Multi" (500, 500) (500, 500))
white
60
Nothing
draw
(\_ x -> return x)
advance
draw Nothing = return blank
draw (Just x) = return (Text (show x))
advance _ Nothing = do
hOut <- connectTo "000.000.0.0" (PortNumber (fromIntegral 12345))
hSetBuffering hOut NoBuffering
hPutStr hOut "Hello!"
return (Just hOut)
advance _ x = return x
I start the server, wait 10 seconds, then start the client, wait 15 seconds, see that nothing happens on the server, closes the client, see "Hello!" suddenly appear on the server.
I would like "Hello!" to appear while the client is running, in an advance call, otherwise I can't make a multiplayer game (sob)!
However, if I change the client's code to
main = loop Nothing
loop x = do
x' <- advance 0 x
getLine
the sever immediatly shows "Hello!" while the client is waiting for my input.
I tried, as suggested in another question, to use bang patterns and hClose:
-- ...
!str <- hGetContents hIn
hClose hIn
-- ...
which makes the output appear immediatly, without the client closing. That's great. But, I plan to use bytestrings because the data I send to the server is serialized, so I import qualified Data.ByteString as B and change hGetContents to B.hGetContents, which makes the problem re-appear.
The problem was indeed a case of laziness. hGetContents reads lazily all the contents of the Handle, so it finishes only when it's closed, when the client aborts the connection. Instead, I used hGetLine that returns the content each time it encounters a \n, which I use as a end-of-message tag.

I might be completely wrong, but isn't the problem hGetContents? Surely that should wait till the entire contents sent through your socket have arrived before the next line (print...) starts. hGetContents is designed to give you all the contents sent until the socket is closed. Something like hGetLine could terminate straight away and you can leave the socket open to send more data through later. Your client could then use a hPutStrLn instead of hPutStr.

It defaults to line-buffered output, which is why hPutStr (which doesn't provide a line ending) doesn't output anything until you flush the buffer. There are two ways you can solve this:
a) Call hFlush stdout manually any time you want to flush the output.
b) Use hSetBuffering to set the buffering to NoBuffering
All of those functions are found in the System.IO module.
Edit: Never mind, I just saw where you did that in the client. I retract my answer with apologies.

Probably, you need to disable algorithm Nagle.
Try this code:
import Network.Socket
setSocketOption sock NoDelay 1

Related

How can I fork standard output?

I have a program that I want to run and wait for it to initialize before proceeding, but I also want the program to write to the terminal as usual, which it would do if I simply called it with callProcess. To this end, I have devised the following hack:
(In this case I listen to the standard error, but I suppose this is inessential.)
…
withCreateProcess applicationProcessDescription \ _ _ maybeApplicationStdErr _ -> do
case maybeApplicationStdErr of
Nothing -> throwIO $ DeploymentException $ "Unable to grab application's standard error stream!"
Just applicationStdErr -> do
maybeTimeout <- timeout waitingTime (waitForApplication applicationStdErr)
when (isNothing maybeTimeout) $ throwIO $ DeploymentException $ "Application took too long initializing!"
redirectHandle applicationStdErr stderr
…
waitForApplication :: Handle -> IO ( )
waitForApplication stdErr = do
line <- hGetLine stdErr
hPutStrLn stderr line
if line == "Application initialized."
then return ( )
else waitForApplication stdErr
redirectHandle :: Handle -> Handle -> IO ( )
redirectHandle from to = void $ forkFinally
do forever do
line <- hGetLine from
hPutStrLn to line
\ _ -> return ( )
I intercept whatever the subprocess is saying, line by line, analyze the lines in some way and put them to the main process's standard error. When I am done, I still have to keep listening and relaying. This seems like an absurd way of going about it.
What I would like to do is fork the subprocess's standard error stream in some way, so that I may eavesdrop on it passively while I need to, and then simply disconnect. It is important for me that whatever the subprocess is saying was delivered to the human as faithfully as possible — without delay and omission.
Is there a nice way to do it?

How does hWaitForInput work?

This bit of code gets characters from stdin and converts them to a String. There is a timeout on the input implemented with hWaitForInput. I have included the tryIOError function to capture isEOFError. It times out correctly when the program is run and no input has taken place ie.it is waiting for input. However once a character has been entered it no longer times out. No matter what the input wait time is.
-- get string from stdin
getFrmStdIn :: Int -> IO String
getFrmStdIn timeout = do
inAvail <- tryIOError $ hWaitForInput stdin timeout
let tOut = either (const False) id inAvail
if isLeft inAvail
then return []
else
if not tOut
then die "00 timed out"
else
(:) <$> hGetChar stdin <*> getFrmStdIn timeout
What OS and GHC version are you using?
AFAIK with the resent GHC versions hWaitForInput doesn't work on linux at all when timeout is not 0. On windows the whole IO subsystem is "a bit lacking" too.
However once a character has been entered it no longer times out. No matter what the input wait time is.
That's how it's supposed to work according to the docs:
Computation hWaitForInput hdl t waits until input is available on handle hdl. It returns True as soon as input is available on hdl, or False if no input is available within t milliseconds.
Here's a usage example of hWaitForInput where it will wait for five seconds and then check if there are characters in stdin. If not, it will say "Timeout reached". Otherwise it'll wait for the user to hit enter (hGetLine checks for the end of line) and print the user-entered string:
main :: IO ()
main =
hWaitForInput stdin 5000 >>= \inputIsAvailable ->
if inputIsAvailable
then hGetLine stdin >>= \input -> putStrLn $ "There is input: " ++ input
else putStrLn "Timeout reached"

Mixing ByteString parsing and network IO in Haskell

Background
I'm trying to write a client for a binary network protocol.
All network operations are carried out over a single TCP connection, so in that sense
the input from the server is a continuous stream of bytes.
At the application layer, however, the server conceptually sends a packet on the
stream, and the client keeps reading until it knows the packet has been received
in its entirety, before sending a response of its own.
A lot of the effort needed to make this work involves parsing and generating
binary data, for which I'm using the Data.Serialize module.
The problem
The server sends me a "packet" on the TCP stream.
The packet is not necessarily terminated by a newline, nor is it of a predetermined
size.
It does consist of a predetermined number of fields, and fields generally begin
with a 4 byte number describing the length of that field.
With some help from Data.Serialize, I already have the code to parse a ByteString
version of this packet into a more manageable type.
I'd love to be able to write some code with these properties:
The parsing is only defined once, preferably in my Serialize instance(s).
I'd rather not do extra parsing in the IO monad to read the correct number of bytes.
When I try to parse a given packet and not all the bytes have arrived yet, lazy
IO will just wait for the extra bytes to arrive.
Conversely, when I try to parse a given packet and all its bytes have arrived
IO does not block anymore. That is, I want to read just enough of the stream
from the server to parse my type and form a response to send back. If the IO
blocks even after enough bytes have arrived to parse my type, then the client
and server will become deadlocked, each waiting for more data from the other.
After I send my own response, I can repeat the process by parsing the next type
of packet I expect from the server.
So in brief,
is it possible to leverage my current ByteString parsing code in combination
with lazy IO to read exactly the right number of bytes off the network?
What I've Tried
I tried to use lazy ByteStreams in combination with my Data.Serialize instance, like
so:
import Network
import System.IO
import qualified Data.ByteString.Lazy as L
import Data.Serialize
data MyType
instance Serialize MyType
main = withSocketsDo $ do
h <- connectTo server port
hSetBuffering h NoBuffering
inputStream <- L.hGetContents h
let Right parsed = decodeLazy inputStream :: Either String MyType
-- Then use parsed to form my own response, then wait for the server reply...
This seems to fail mostly on point 3 above: it stays blocked even after a sufficient
number of bytes have arrived to parse MyType. I strongly suspect this is because
ByteStrings are read with a given block size at a time, and L.hGetContents is
waiting for the rest of this block to arrive. While this property of reading an
efficient blocksize is helpful for making efficient reads from disk, it seems to be
getting in my way for reading just enough bytes to parse my data.
Something is wrong with your parser, it is too eager. Most likely it need the next byte after the message for some reason. hGetContents from bytestring doesn't block waiting for the whole chunk. It uses hGetSome internally.
I created simple test case. The server sends "hello" every second:
import Control.Concurrent
import System.IO
import Network
port :: Int
port = 1234
main :: IO ()
main = withSocketsDo $ do
s <- listenOn $ PortNumber $ fromIntegral port
(h, _, _) <- accept s
let loop :: Int -> IO ()
loop 0 = return ()
loop i = do
hPutStr h "hello"
threadDelay 1000000
loop $ i - 1
loop 5
sClose s
The client reads the whole contents lazily:
import qualified Data.ByteString.Lazy as BSL
import System.IO
import Network
port :: Int
port = 1234
main :: IO ()
main = withSocketsDo $ do
h <- connectTo "localhost" $ PortNumber $ fromIntegral port
bs <- BSL.hGetContents h
BSL.putStrLn bs
hClose h
If you try to run both of then, you'll see the client printing "hello" every seconds. So, the network subsystem is ok, the issue is somewhere else -- most likely in your parser.

How can I make file I/O more transactional?

I'm writing CGI scripts in Haskell. When the user hits ‘submit’, a Haskell program runs on the server, updating (i.e. reading in, processing, overwriting) a status file. Reading then overwriting sometimes causes issues with lazy IO, as we may be able to generate a large output prefix before we've finished reading the input. Worse, users sometimes bounce on the submit button and two instances of the process run concurrently, fighting over the same file!
What's a good way to implement
transactionalUpdate :: FilePath -> (String -> String) -> IO ()
where the function (‘update’) computes the new file contents from the old file contents? It is not safe to presume that ‘update’ is strict, but it may be presumed that it is total (robustness to partial update functions is a bonus). Transactions may be attempted concurrently, but no transaction should be able to update if the file has been written by anyone else since it was read. It's ok for a transaction to abort in case of competition for file access. We may assume a source of systemwide-unique temporary filenames.
My current attempt writes to a temporary file, then uses a system copy command to overwrite. That seems to deal with the lazy IO problems, but it doesn't strike me as safe from races. Is there a tried and tested formula that we could just bottle?
The most idiomatic unixy way to do this is with flock:
http://hackage.haskell.org/package/flock
http://swoolley.org/man.cgi/2/flock
Here is a rough first cut that relies on the atomicity of the underlying mkdir. It seems to fulfill the specification, but I'm not sure how robust or fast it is:
import Control.DeepSeq
import Control.Exception
import System.Directory
import System.IO
transactionalUpdate :: FilePath -> (String -> String) -> IO ()
transactionalUpdate file upd = bracket acquire release update
where
acquire = do
let lockName = file ++ ".lock"
createDirectory lockName
return lockName
release = removeDirectory
update _ = nonTransactionalUpdate file upd
nonTransactionalUpdate :: FilePath -> (String -> String) -> IO ()
nonTransactionalUpdate file upd = do
h <- openFile file ReadMode
s <- upd `fmap` hGetContents h
s `deepseq` hClose h
h <- openFile file WriteMode
hPutStr h s
hClose h
I tested this by adding the following main and throwing a threadDelay in the middle of nonTransactionalUpdate:
main = do
[n] <- getArgs
transactionalUpdate "foo.txt" ((show n ++ "\n") ++)
putStrLn $ "successfully updated " ++ show n
Then I compiled and ran a bunch of instances with this script:
#!/bin/bash
rm foo.txt
touch foo.txt
for i in {1..50}
do
./SO $i &
done
A process that printed a successful update message if and only if the corresponding number was in foo.txt; all the others printed the expected SO: foo.txt.notveryunique: createDirectory: already exists (File exists).
Update: You actually do not want to use unique names here; it must be a consistent name across the competing processes. I've updated the code accordingly.

Control thread to exit haskell application

I'm brand new to Haskell and in messing around with a few samples I've got a problem where I can't stop the program. I'm using Windows 7 and using runhaskell from ght. Ctrl-c doesn't work so I have to resort to the task manager which is a bit of a pain.
Instead of doing that how can I create a separate control thread that would wait until I typed q and then quit my Haskell application.
The application I've got the problem with is of the format:
main = do
h <- connectTo server (PortNumber (fromInteger port))
hSetBuffering h NoBuffering
... do some stuff with the socket handle ...
listen h
listen :: Handle -> IO ()
listen h = forever $ do
t <- hGetLine h
let s = init t
putStrLn s
where
forever a = do a; forever a
In pseudo-code what I'd like to have is:
main = do
waitForQuit
... original program ...
waitForQuit :: IO()
option <- getChar
if option == 'q' then
... kill the app ...
else
waitForQuit
You should be able to do this with a Haskell thread, getChar and exit{With,Success,Failure}.
import Control.Concurrent
import System.Exit
import Data.Char (toLower)
import System.IO
main = do
forkIO realMain
exitOnQ
exitOnQ = do
hSetBuffering stdin NoBuffering
c <- getChar
when (toLower c /= 'q') exitOnQ
exitSuccess -- or "exitWith" and some ExitCode value, use hoogle.
Breaking this down: You get concurrently via forkIO. Notice this isn't a separate OS thread, but a Haskell thread which is extremely lightweight. The exitOnQ thread needs to get keystrokes without delay - without the NoBuffering you'd have to hit q-[ENTER]. If the pressed key wasn't q (or Q) then we loop, otherwise we terminate the program via one of the many exit* calls.
WARNING: It is a very uncommon corner case, but GHC uses GC points as thread scheduling points (has this changed in the past two years?) so if your code is spending significant blocks of time performing lots of pure computations that have zero allocation then you can't use this method to quit (unless you have multiple OS threads via the threaded RTS and an +RTS -N# option).
how can I create a separate control thread that would wait until I typed q and then quit my Haskell application.
You can create new threads with forkIO, which takes a chunk of code as an argument. E.g.
main = do
forkIO waitForQuit
....
The quit handler will spend most of its time blocked on getChar, but when it wakes up, it can terminate the program, by throwing an exit exception, such as:
exitWith ExitSuccess
You may need to compile the program with ghc -O -threaded to ensure the program main thread can make progress, while the handler is waiting on q

Resources