Profiling HTTP requests.

Profile.hs

module Main where

import Control.Applicative
import Control.Monad
import Data.Time.Clock
import Data.List
import Network.HTTP.Client
import System.IO

import qualified Data.ByteString.Lazy as Lazy

main :: IO ()
main =
  do hSetBuffering stdout NoBuffering
     forM_ silks bench

bench :: String -> IO ()
bench uri =
  do warm uri
     res <- profile uri
     print res

warm :: String -> IO ()
warm uri = 
  do putStr "warming cache "
     req <- parseUrl uri
     forM_ [0 :: Integer .. 3] $ \_ ->
       request req <* putStr "."
     putStrLn ""

profile :: String -> IO (String, Integer, Double, Double, [Double])
profile uri =
  do putStr "timing requests "
     req <- parseUrl uri
     res <- forM [0 :: Integer .. 10] $ \_ ->
       request req <* putStr "."
     putStrLn ""

     let samples = map (realToFrac . snd) res :: [Double]
         size    = fst (head res)
         count   = fromIntegral (length samples) :: Double
         median  = sort samples !! floor (count / 2)
         average = sum samples / count

     return ( uri
            , size
            , median
            , average
            , samples
            )

request :: Request -> IO (Integer, NominalDiffTime)
request req =
  do start <- getCurrentTime
     manager  <- newManager defaultManagerSettings
     response <- httpLbs req manager
     let len = Lazy.length (responseBody response)
     stop <- len `seq` getCurrentTime
     let duration = stop `diffUTCTime` start
     return (fromIntegral len, duration)

silks :: [String]
silks = [ {- collection of sites in here -}  ]