Poor haskell network performance

Question

I am programming some 'openvpn-like' thing and thought it would be a good candidate to improve my Haskell knowledge. However, I ran into quite severe performance problems.

What it does: It opens a TUN device; it binds itself on an UDP port, starts 2 threads (forkIO, however compiled with -threaded because of the fdRead). I have not used the tuntap package and did it myself completely in Haskell.

thread 1: read a packet (fdRead) from a tun device. Send it using UDP socket.
thread 2: read a packet (recv) from an UDP socket; send it to tun device (fdWrite)

Problem 1: In this configuration fdRead returns String and I have used the Network.Socket functions that accept String. I made a configuration on local system (some iptables magic) and I can run 15MB/s through it on localhost, the program run basically on 100% CPU. That's slow. Is there anything I could do to improve the performance?

Problem 2: I will have to prepend something to the packets I am sending; however the sendMany network function takes only ByteString; reading from Fd returns String. Conversion is pretty slow. Converting to Handle doesn't seem to work well enough with the TUN device....

Problem 3: I wanted to store some information in Data.Heap (functional heap) (I need to use the 'takeMin' and although for 3 items it is overkill, it is easy to do :) ). So I created an MVar and on each received packet I've pulled the Heap from the MVar, updated the Heap with new info and put it back inito the MVar Now the thing simply starts to eat A LOT of memory. Probably because the old heaps don't get garbage collected soon/frequently enough..?

Is there a way to solve these problems or do I have to get back to C...? What I am doing should be mostly zerocopy operation - am I using wrong libraries to achieve it?

==================

What I did: - when putting to MVar, did:

a `seq` putMVar mvar a

That perfectly helped with the memory leak.

• changed to ByteString; now I get 42MB/s when using just 'read/write' with no further processing. The C version does about 56MB/s so this is acceptable.

Answer 1

String is slow. Really, really, really slow. It's a singly-linked list of cons cells containing one unicode character each. Writing one to a socket requires converting each character to bytes, copying those bytes into an array, and handing that array to the system call. What part of this sounds like what you want to be doing? :)

You want to be using ByteString exclusively. The ByteString IO functions actually use zero-copy IO where possible. Especially look at the network-bytestring package on hackage. It contains versions of all the network libraries that are optimized to work efficiently with ByteString.

Answer 2

Below are two example programs: client and server. Using GHC 7.0.1 and network-2.3 I got more then 7500 Mbps over loopback, on my pretty new dual core laptop (~90% total CPU usage). I don't know how much overhead UDP introduces, but nevertheless this is quite a number.

--------------------
-- Client program --
--------------------
module Main where

import qualified Data.ByteString as C
import Network.Socket hiding (recv)
import Network.Socket.ByteString (recv)

import System.IO
import Control.Monad

main :: IO ()
main = withSocketsDo $
    do devNull <- openFile "/dev/null" WriteMode
       addrinfos <- getAddrInfo Nothing (Just "localhost") (Just "3000")
       let serveraddr = head addrinfos
       sock <- socket (addrFamily serveraddr) Stream defaultProtocol
       connect sock (addrAddress serveraddr)
       forever $ do
         msg <- recv sock (256 * 1024) -- tuning recv size is important!
         C.hPutStr devNull msg
       sClose sock


--------------------
-- Server program --
--------------------
module Main where

-- import Control.Monad (unless)
import Network.Socket hiding (recv)
import qualified Data.ByteString.Lazy as S
import Network.Socket.ByteString.Lazy (
                                       --recv, 
                                       sendAll)

main :: IO ()
main = withSocketsDo $
       do addrinfos <- getAddrInfo
                        (Just (defaultHints {addrFlags = [AI_PASSIVE]}))
                        Nothing (Just "3000")
          let serveraddr = head addrinfos
          sock <- socket (addrFamily serveraddr) Stream defaultProtocol
          bindSocket sock (addrAddress serveraddr)
          listen sock 1
          (conn, _) <- accept sock
          talk conn
          sClose conn
          sClose sock

     where
       talk :: Socket -> IO ()
       talk conn = sendAll conn $ S.repeat 7