fix(server,debug-client): parse extra messages in a datagram

3 files changed, 26 insertions, 20 deletions

diff --git a/debug-client/Main.hs b/debug-client/Main.hs
index b548eba..47dfaac 100644
--- a/debug-client/Main.hs
+++ b/debug-client/Main.hs
@@ -1,6 +1,6 @@
 module Main where
 
-import Control.Monad (forever)
+import Control.Monad (forever, forM_)
 import Data.Attoparsec.ByteString (parseOnly)
 import Network.Socket
 import Network.Socket.ByteString
@@ -26,9 +26,9 @@ grav2tyConnect host port = do
   forever $ do
     bytes <- recv sock (1024^2 * 100)
 
-    case parseOnly messageParser bytes of
+    case parseOnly messagesParser bytes of
       Left e -> putStrLn $ "Parse error: " ++ e
-      Right m -> print (m :: Message Double)
+      Right ms -> forM_ ms $ \m -> print (m :: Message Double)
 
 main :: IO ()
 main = do
diff --git a/lib/Grav2ty/Protocol.hs b/lib/Grav2ty/Protocol.hs
index 09272ce..9626462 100644
--- a/lib/Grav2ty/Protocol.hs
+++ b/lib/Grav2ty/Protocol.hs
@@ -12,6 +12,7 @@ module Grav2ty.Protocol
   , ErrorType (..)
   , renderMessage
   , messageParser
+  , messagesParser
     -- * Mappings between 'Message's and 'Grav2tyUpdate's
   , messageUpdateClient
   , messageUpdateServer
@@ -140,6 +141,9 @@ messageParser :: Flat a => Parser (Message a)
 messageParser = packetParser >>=
   maybe (fail "Packet is no valid message") pure . fromPacket
 
+messagesParser :: Flat a => Parser [Message a]
+messagesParser = many1 messageParser
+
 clientTickUpdate :: Tick -> Tick -> [GC.Grav2tyUpdate a]
 clientTickUpdate current tick =
   if tick > current
diff --git a/server/Main.hs b/server/Main.hs
index d1f3782..6bd4ae0 100644
--- a/server/Main.hs
+++ b/server/Main.hs
@@ -140,27 +140,29 @@ netIn :: Socket
 netIn s clients netChan tickChan = forever $ do
   (bytes, addr) <- recvFrom s maxPacketLen
 
-  case parseOnly GP.messageParser bytes of
+  case parseOnly GP.messagesParser bytes of
     Left err -> do
       putStrLn $ "Could not parse message from " ++ show addr ++ ": " ++ err
       atomically . writeTChan netChan
         $ NetThreadSendTo addr [GP.Error GP.ErrorNoParse]
-    Right (GP.ProtocolVersion v) ->
-      if v == GP.protocolVersion
-        then let modifier = modifierForAddr addr
-              in atomically $ do
-                modifyTVar clients $ M.insert addr modifier
-                writeTChan tickChan $ TickThreadSendWorld addr
-                writeTChan netChan
-                  $ NetThreadSendTo addr [GP.AssignMods [modifier]]
-        else do
-          putStrLn $ "Incompatible protocol version from " ++ show addr
-          atomically . writeTChan netChan
-            $ NetThreadSendTo addr [GP.Error GP.ErrorVersionMismatch]
-    Right x -> do
-      clientMod <- maybeToList . M.lookup addr <$> readTVarIO clients
-      atomically . writeTChan tickChan . TickThreadUpdates
-        $ GP.messageUpdateServer clientMod x
+    Right msgs -> forM_ msgs $ \msg ->
+      case msg of
+        GP.ProtocolVersion v ->
+          if v == GP.protocolVersion
+            then let modifier = modifierForAddr addr
+                  in atomically $ do
+                    modifyTVar clients $ M.insert addr modifier
+                    writeTChan tickChan $ TickThreadSendWorld addr
+                    writeTChan netChan
+                      $ NetThreadSendTo addr [GP.AssignMods [modifier]]
+            else do
+              putStrLn $ "Incompatible protocol version from " ++ show addr
+              atomically . writeTChan netChan
+                $ NetThreadSendTo addr [GP.Error GP.ErrorVersionMismatch]
+        x -> do
+          clientMod <- maybeToList . M.lookup addr <$> readTVarIO clients
+          atomically . writeTChan tickChan . TickThreadUpdates
+            $ GP.messageUpdateServer clientMod x
 
 getGrav2tyAddr :: IO AddrInfo
 getGrav2tyAddr = head <$> getAddrInfo hints (Just "::") (Just "2001")