Test the effective speed of a network link

receiver.hs

module Main where

import Control.Concurrent
import Control.Exception
import Control.Monad
import qualified Data.ByteString as BS
import Network.Socket hiding ( recv )
import Network.Socket.ByteString ( recv )
import Text.Printf ( printf )

main :: IO ()
main = do
    bracketOnError
        (socket AF_INET Stream defaultProtocol)
        sClose
        (\lsock -> do
            setSocketOption lsock ReuseAddr 1
            bindSocket lsock (SockAddrInet 12345 iNADDR_ANY)
            listen lsock maxListenQueue
            forever $ do
                (sock, addr) <- accept lsock
                _ <- printf "Incoming connection from %s\n" (show addr)
                _ <- forkIO $ finally
                      (forever $ do
                         text <- recv sock (2 * 1024)
                         when (BS.null text) (sClose sock))
                      (sClose sock)
                return ())

sender.hs

module Main where

import Control.Exception
import Control.Monad
import qualified Data.ByteString as BS
import Data.Time.Clock
import Network.Socket
import Network.Socket.ByteString
import Text.Printf ( printf )

main :: IO ()
main = do
    addrInfos <- getAddrInfo (Just (defaultHints { addrFamily = AF_INET }))
                             (Just "localhost")
                             (Just "12345")
    bracketOnError
        (socket AF_INET Stream defaultProtocol)
        sClose
        (\sock -> do
             connect sock (addrAddress $ head addrInfos)
             sendLoop sock)

sendLoop :: Socket -> IO ()
sendLoop sock = do
    let bs = BS.replicate (1024 * 1024 * 1024) (fromIntegral (23 :: Int))
    let text = bs `seq` bs
    startTime <- getCurrentTime
    forM_ [1..50 :: Int] $ \i -> do
        sendAll sock text
        now <- getCurrentTime
        printf "Sent %d GiB in %d x %s\n" i i (show (diffUTCTime now startTime / fromIntegral i))