Bryan O'Sullivan avatar Bryan O'Sullivan committed f7c67ac

Move reporting out to the top-level app.

Comments (0)

Files changed (3)

 module Main (main) where
 
 import Control.Monad (forM_, unless)
+import Criterion.Analysis (SampleAnalysis(..), OutlierEffect(..),
+                           OutlierVariance(..))
 import Data.Maybe (catMaybes)
+import Data.Monoid (mappend)
+import Data.Text (Text)
+import Data.Text.Buildable (build)
+import Data.Text.Lazy.Builder (Builder)
+import Network.HTTP.LoadTest (Analysis(..), NetworkError(..))
 import Network.Socket (withSocketsDo)
-import Prelude hiding (catch)
+import Statistics.Resampling.Bootstrap (Estimate(..))
 import System.Console.CmdArgs
 import System.Exit (ExitCode(ExitFailure), exitWith)
 import System.IO (hPutStrLn, stderr)
               , requests_per_second = def
               , timeout = 60
               , url = def &= argPos 0
-              }
+              } &= verbosity
 
 fromArgs :: Args -> LoadTest.Config
 fromArgs Args{..} = LoadTest.Config {
 main = withSocketsDo $ do
   as@Args{..} <- cmdArgs defaultArgs
   validateArgs as
-  !results <- LoadTest.run (fromArgs as)
-  T.print "analysing results\n" ()
-  analysis <- LoadTest.analyse results
-  LoadTest.report analysis
+  run <- LoadTest.run (fromArgs as)
+  case run of
+    Left [NetworkError err] ->
+      T.hprint stderr "Error: {}" [show err] >> exitWith (ExitFailure 1)
+    Left errs -> do
+      T.hprint stderr "Errors:\n" ()
+      forM_ errs $ \(NetworkError err) -> T.hprint stderr "  {}\n" [show err]
+      exitWith (ExitFailure 1)
+    Right results -> do
+      whenNormal $ T.print "analysing results\n" ()
+      report =<< LoadTest.analyse results
 
 validateArgs :: Args -> IO ()
 validateArgs Args{..} = do
        ]
   forM_ problems $ hPutStrLn stderr . ("Error: " ++)
   unless (null problems) $ exitWith (ExitFailure 1)
+
+report :: Analysis -> IO ()
+report Analysis{..} = do
+  T.print "latency:\n" ()
+  T.print "    mean:    {}\n" [time (estPoint (anMean latency))]
+  whenLoud $ do
+    T.print "      lower: {}\n" [time (estLowerBound (anMean latency))]
+    T.print "      upper: {}\n" [time (estUpperBound (anMean latency))]
+  T.print "    std dev: {}\n" [time (estPoint (anStdDev latency))]
+  whenLoud $ do
+    T.print "      lower: {}\n" [time (estLowerBound (anStdDev latency))]
+    T.print "      upper: {}\n" [time (estUpperBound (anStdDev latency))]
+  effect (anOutliers latency)
+  T.print "    99%:     {}\n    99.9%:   {}\n" (time latency99, time latency999)
+  T.print "\nthroughput:\n" ()
+  T.print "    mean:    {} req/sec\n" [estPoint (anMean throughput)]
+  whenLoud $ do
+    T.print "      lower: {} req/sec\n" [estLowerBound (anMean throughput)]
+    T.print "      upper: {} req/sec\n" [estUpperBound (anMean throughput)]
+  T.print "    std dev: {} req/sec\n" [estPoint (anStdDev throughput)]
+  whenLoud $ do
+    T.print "      lower: {} req/sec\n" [estLowerBound (anStdDev throughput)]
+    T.print "      upper: {} req/sec\n" [estUpperBound (anStdDev throughput)]
+  effect (anOutliers throughput)
+  T.print "    10%:     {} req/sec\n" [throughput10]
+
+time :: Double -> Builder
+time t
+     | t < 1e-3  = build (t * 1e6) `mappend` " usec"
+     | t < 1     = build (t * 1e3) `mappend` " msec"
+     | otherwise = build t `mappend` " sec"
+
+effect :: OutlierVariance -> IO ()
+effect OutlierVariance{..} =
+    case ovEffect of
+      Unaffected -> return ()
+      _ -> T.print "    estimates {} affected by outliers ({}%)\n"
+           (howMuch, T.fixed 1 (ovFraction * 100))
+    where howMuch = case ovEffect of
+                      Unaffected -> "not" :: Text
+                      Slight     -> "slightly"
+                      Moderate   -> "moderately"
+                      Severe     -> "severely"

http-load-tester.cabal

     criterion >= 0.5.1.0,
     http-enumerator,
     statistics,
-    text,
-    text-format,
     time,
     vector,
     vector-algorithms
   build-depends:
     base < 5,
     cmdargs >= 0.7,
+    criterion,
     http-load-tester,
     network,
+    statistics,
+    text,
     text-format
 
 source-repository head

lib/Network/HTTP/LoadTest.hs

     (
     -- * Running a load test
       Config(..)
+    , NetworkError(..)
     , defaultConfig
     , run
     -- * Results
     -- * Result analysis
     , Analysis(..)
     , analyse
-    , report
     ) where
 
 import Control.Applicative ((<$>))
 import Control.Concurrent (forkIO, threadDelay)
 import Control.Concurrent.Chan (newChan, readChan, writeChan)
-import Control.Exception (IOException, catch)
+import Control.Exception (Exception, IOException, catch, throwIO, try)
 import Control.Monad (forM_, replicateM, when)
-import Criterion.Analysis (OutlierEffect(..), OutlierVariance(..),
-                           SampleAnalysis(..), analyseSample, scale)
+import Criterion.Analysis (SampleAnalysis(..), analyseSample, scale)
 import Data.Data (Data)
+import Data.Either (partitionEithers)
 import Data.Function (on)
-import Data.Monoid (mappend)
-import Data.Text (Text)
-import Data.Text.Buildable (build)
-import Data.Text.Lazy.Builder (Builder)
+import Data.List (nub)
 import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime)
 import Data.Typeable (Typeable)
 import Network.HTTP.Enumerator
 import Prelude hiding (catch)
 import Statistics.Quantile (weightedAvg)
-import Statistics.Resampling.Bootstrap (Estimate(..))
 import qualified Data.ByteString.Lazy as L
-import qualified Data.Text.Format as T
 import qualified Data.Vector as V
 import qualified Data.Vector.Algorithms.Intro as I
 import qualified Data.Vector.Generic as G
     HttpResponse {
       respCode :: {-# UNPACK #-} !Int
     , respLength :: {-# UNPACK #-} !Int
-    } | NetworkError
-      | Timeout
+    } | Timeout
       | Done
     deriving (Eq, Read, Show, Typeable, Data)
 
+-- | Exception thrown if issuing a HTTP request fails.
+data NetworkError = NetworkError {
+      fromNetworkError :: IOException
+    } deriving (Eq, Show, Typeable)
+
+instance Exception NetworkError
+
 data Summary = Summary {
       summEvent :: Event
     , summElapsed :: {-# UNPACK #-} !Double
 summEnd :: Summary -> Double
 summEnd Summary{..} = summStart + summElapsed
 
-run :: Config -> IO (V.Vector Summary)
+run :: Config -> IO (Either [NetworkError] (V.Vector Summary))
 run cfg@Config{..} = do
   req <- parseUrl url
   let reqs = zipWith (+) (replicate concurrency reqsPerThread)
     let cfg' = cfg {
                 numRequests = numReqs
               }
-    writeChan ch =<< client cfg' mgr req interval
-  V.concat <$> replicateM concurrency (readChan ch)
+    writeChan ch =<< try (client cfg' mgr req interval)
+  (errs,vs) <- partitionEithers <$> replicateM concurrency (readChan ch)
+  return $ case errs of
+             [] -> Right (V.concat vs)
+             _  -> Left (nub errs)
 
 client :: Config -> Manager -> Request IO -> POSIXTime
        -> IO (V.Vector Summary)
     loop !n acc now
         | n == numRequests = return $! V.fromList (reverse acc)
         | otherwise = do
-      !evt <- timedRequest `catch`
-              \(_::IOException) -> closeManager mgr >> return NetworkError
+      !evt <- timedRequest
       now' <- getPOSIXTime
       let elapsed = now' - now
           !s = Summary {
       when (elapsed < interval) $
         threadDelay . truncate $ (interval - elapsed) * 1000000
       loop (n+1) (s:acc) =<< getPOSIXTime
-    issueRequest = httpLbs req mgr
+    issueRequest = httpLbs req mgr `catch` (throwIO . NetworkError)
     timedRequest
       | timeout == 0 = respEvent <$> issueRequest
       | otherwise    = do
                , throughput10 = (/ timeSlice) . weightedAvg 10 100 $ slices
     }
 
-time :: Double -> Builder
-time t
-     | t < 1e-3  = build (t * 1e6) `mappend` " usec"
-     | t < 1     = build (t * 1e3) `mappend` " msec"
-     | otherwise = build t `mappend` " sec"
-
-report :: Analysis -> IO ()
-report Analysis{..} = do
-  T.print "latency:\n    mean:    {}\n    std dev: {}\n"
-    (time (estPoint (anMean latency)), time (estPoint (anStdDev latency)))
-  effect (anOutliers latency)
-  T.print "    99%:     {}\n    99.9%:   {}\n" (time latency99, time latency999)
-  T.print "\nthroughput:\n    mean:    {} req/sec\n    std dev: {} req/sec\n"
-    (estPoint (anMean throughput), estPoint (anStdDev throughput))
-  effect (anOutliers throughput)
-  T.print "    10%:     {} req/sec\n" [throughput10]
-
-effect :: OutlierVariance -> IO ()
-effect OutlierVariance{..} =
-    case ovEffect of
-      Unaffected -> return ()
-      _ -> T.print "    estimates {} affected by outliers ({}%)\n"
-           (howMuch, T.fixed 1 (ovFraction * 100))
-    where howMuch = case ovEffect of
-                      Unaffected -> "not" :: Text
-                      Slight     -> "slightly"
-                      Moderate   -> "moderately"
-                      Severe     -> "severely"
-
 -- | Sort a vector.
 sortBy :: (G.Vector v e) => I.Comparison e -> v e -> v e
 sortBy cmp = G.modify (I.sortBy cmp)
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.