Run a Warp server on a random available TCP port

gistfile1.hs

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Concurrent (forkIO, ThreadId)
import Data.ByteString.Lazy (ByteString)
import Data.Text.Lazy (pack)
import Data.Text.Lazy.Encoding (encodeUtf8)
import Network.HTTP.Types (status200)
import Network.HTTP.Types.Header (hContentType)
import Network.Wai (responseLBS, Application)
import Network.Wai.Handler.Warp
import Network.Socket
import System.Environment (getArgs)

mkServer :: Application -> IO (ThreadId, PortNumber)
mkServer app = do
  sock <- mkTCPSocket
  port <- socketPort sock
  threadId <- forkIO $ runSettingsSocket defaultSettings sock app
  return (threadId, port)

mkTCPSocket :: IO Socket
mkTCPSocket = do
  sock <- socket AF_INET Stream defaultProtocol
  bind sock (SockAddrInet aNY_PORT iNADDR_ANY)
  listen sock 5
  return sock

mkApp :: ByteString -> Application
mkApp body _ f = f $ responseLBS status200 [(hContentType, "text/plain")] body

main :: IO ()
main = do
  (body:_)  <- getArgs
  (_, port) <- mkServer $ mkApp $ encodeUtf8 $ pack body
  putStrLn $ "Server running on port " ++ show port
  _ <- getLine
  return ()