Send answers strictly
authorKlaus Aehlig <aehlig@google.com>
Mon, 16 Nov 2015 14:05:45 +0000 (15:05 +0100)
committerKlaus Aehlig <aehlig@google.com>
Mon, 16 Nov 2015 15:45:21 +0000 (16:45 +0100)
When sending an answer over a domain socket, the recipient
won't process that answer anyway before it is complete. So
we can as well assemble one ByteString first and send it over
the wire all at once, thus saving a few system calls.

Signed-off-by: Klaus Aehlig <aehlig@google.com>
Reviewed-by: Hrvoje Ribicic <riba@google.com>

src/Ganeti/UDSServer.hs

index 8e27c5a..868c4e9 100644 (file)
@@ -77,9 +77,7 @@ import Control.Monad.Trans.Control
 import Control.Exception (catch)
 import Control.Monad
 import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy as BL
 import qualified Data.ByteString.UTF8 as UTF8
-import qualified Data.ByteString.Lazy.UTF8 as UTF8L
 import Data.IORef
 import Data.List
 import Data.Word (Word8)
@@ -288,9 +286,9 @@ clientToFd client | rh == wh  = join (,) <$> handleToFd rh
 -- | Sends a message over a transport.
 sendMsg :: Client -> String -> IO ()
 sendMsg s buf = withTimeout (sendTmo $ clientConfig s) "sending a message" $ do
-  let encoded = UTF8L.fromString buf
+  let encoded = UTF8.fromString buf
       handle = wsocket s
-  BL.hPut handle encoded
+  B.hPut handle encoded
   B.hPut handle bEOM
   hFlush handle