Network programming in Haskell
December 14, 2012, in haskell

At work we use Clojure as our primary implementation language. I wrote a blog post about the decision which got a lot of attention from the Hacker News community. While we are extremely happy with our decision we have started to deploy some Haskell code on some low memory VPS we deploy.

Some of the machines we deploy are 256M and 512M instances and with multiple instances of the JVM the machines start swapping to disk sooner or later. The other day we needed a simple way to forward all HTTP traffic received by our DNS servers to our website. It seemed like the perfect project to introduce Haskell since the code is independent of everything else and extremely simple; just output a HTTP 301 redirect response no matter what was received on the socket.

The resulting code is as close to a networking skeleton written in Haskell which I hope others will benefit from when starting a Haskell project involving network communication.

The following is the complete code and below I will step through some of the more interesting parts:

module Main where

{- A simple HTTP rebounder which sends a HTTP 301 response regardless of the request:

HTTP/1.1 301 Moved Permanently
Location: <url>
Content-Length: 0

import Network              (PortID(PortNumber), withSocketsDo, listenOn, accept)
import Network.Socket       (Socket, close)
import Control.Concurrent   (forkIO)
import Control.Applicative  ((<$>))
import Control.Exception    (bracket)
import System.Posix         (Handler(Ignore), installHandler, sigPIPE)
import System.Environment   (getArgs)
import Data.Maybe           (maybe, listToMaybe)
import System.IO            (Handle, hPutStrLn, hFlush, hClose)

-- configuration
defaultPort = 8080
defaultUrl  = ""

-- main
main :: IO ()
main = withSocketsDo $ do
installHandler sigPIPE Ignore Nothing
url <- maybe defaultUrl id <$> listToMaybe <$> getArgs
    (listenOn $ PortNumber defaultPort)
    (flip acceptConnection $ redirectConnection url)

redirectConnection :: String -> Handle -> IO ()
redirectConnection url h = hPutStrLn h (constructResponse url) >> hFlush h >> hClose h

-- helpers
constructResponse :: String -> String
constructResponse url = unlines ["HTTP/1.1 301 Moved Permanently"
                                ,"Location: " ++ url
                                ,"Content-Length: 0"]

acceptConnection :: Socket -> (Handle -> IO ()) -> IO ()
acceptConnection socket handler = do
(h,_,_) <- accept socket
    forkIO (handler h)
    acceptConnection socket handler