Bryan O'Sullivan avatar Bryan O'Sullivan committed b71cf6a

Use a cheap analysis by default.

Comments (0)

Files changed (3)

 
 module Main (main) where
 
+import Control.Applicative ((<$>))
 import Control.Monad (forM_, unless)
 import Criterion.Analysis (SampleAnalysis(..), OutlierEffect(..),
                            OutlierVariance(..))
 import Data.Text (Text)
 import Data.Text.Buildable (build)
 import Data.Text.Lazy.Builder (Builder)
-import Network.HTTP.LoadTest (Analysis(..), NetworkError(..))
+import Network.HTTP.LoadTest (Analysis(..), Basic(..), NetworkError(..))
 import Network.Socket (withSocketsDo)
 import Statistics.Resampling.Bootstrap (Estimate(..))
 import System.Console.CmdArgs
 import qualified Network.HTTP.LoadTest as LoadTest
 
 data Args = Args {
-      concurrency :: Int
+      bootstrap :: Bool
+    , concurrency :: Int
     , json :: Maybe FilePath
     , num_requests :: Int
     , requests_per_second :: Double
 
 defaultArgs :: Args
 defaultArgs = Args {
-                concurrency = 1
+                bootstrap = def
+              , concurrency = 1
               , json = def
               , num_requests = 1
               , requests_per_second = def
       exitWith (ExitFailure 1)
     Right results -> do
       whenNormal $ T.print "analysing results\n" ()
-      analysis <- LoadTest.analyse results
+      analysis <- if bootstrap
+                  then Right <$> LoadTest.analyseFull results
+                  else return . Left . LoadTest.analyseBasic $ results
       case json of
         Just "-" -> L.putStrLn (encode analysis)
         Just f   -> L.writeFile f (encode analysis)
         _        -> return ()
-      whenNormal $ report analysis
+      whenNormal $ either reportBasic reportFull analysis
 
 validateArgs :: Args -> IO ()
 validateArgs Args{..} = do
   forM_ problems $ hPutStrLn stderr . ("Error: " ++)
   unless (null problems) $ exitWith (ExitFailure 1)
 
-report :: Analysis -> IO ()
-report Analysis{..} = do
+reportBasic :: Analysis Basic -> IO ()
+reportBasic Analysis{..} = do
+  T.print "latency:\n" ()
+  T.print "    mean:    {}\n" [time (mean latency)]
+  T.print "    std dev: {}\n" [time (stdDev latency)]
+  T.print "    99%:     {}\n    99.9%:   {}\n" (time latency99, time latency999)
+  T.print "\nthroughput:\n" ()
+  T.print "    mean:    {} req/sec\n" [mean throughput]
+  T.print "    std dev: {} req/sec\n" [stdDev throughput]
+  T.print "    10%:     {} req/sec\n" [throughput10]
+
+
+reportFull :: Analysis SampleAnalysis -> IO ()
+reportFull Analysis{..} = do
   T.print "latency:\n" ()
   T.print "    mean:    {}\n" [time (estPoint (anMean latency))]
   whenLoud $ do

lib/Network/HTTP/LoadTest.hs

     , run
     -- * Result analysis
     , Analysis(..)
-    , analyse
+    , Basic(..)
+    , analyseBasic
+    , analyseFull
     ) where
 
 import Control.Applicative ((<$>))
 import Control.Concurrent.Chan (newChan, readChan, writeChan)
 import Control.Exception (catch, throwIO, try)
 import Control.Monad (forM_, replicateM, when)
-import Criterion.Analysis (analyseSample, scale)
+import Criterion.Analysis (SampleAnalysis, analyseSample, scale)
 import Data.Either (partitionEithers)
 import Data.Function (on)
 import Data.List (nub)
 import Network.HTTP.LoadTest.Types
 import Prelude hiding (catch)
 import Statistics.Quantile (weightedAvg)
+import qualified Statistics.Sample as S
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Vector as V
 import qualified Data.Vector.Algorithms.Intro as I
     , respContentLength = fromIntegral . L.length . responseBody $ resp
     }
 
-analyse :: V.Vector Summary -> IO Analysis
-analyse sums = do
+analyseFull :: V.Vector Summary -> IO (Analysis SampleAnalysis)
+analyseFull sums = do
   let sumv = sortBy (compare `on` summStart) sums
       start = summStart . G.head $ sumv
       end = summEnd . G.last $ sumv
                , throughput10 = (/ timeSlice) . weightedAvg 10 100 $ slices
     }
 
+analyseBasic :: V.Vector Summary -> Analysis Basic
+analyseBasic sums = Analysis {
+                      latency = Basic {
+                                  mean = S.mean . G.map summElapsed $ sums
+                                , stdDev = S.stdDev . G.map summElapsed $ sums
+                                }
+                    , latency99 = weightedAvg 99 100 . G.map summElapsed $ sums
+                    , latency999 = weightedAvg 999 1000 . G.map summElapsed $ sums
+                    , throughput = Basic {
+                                     mean = S.mean slices / timeSlice
+                                   , stdDev = S.stdDev slices / timeSlice
+                                   }
+                    , throughput10 = (/ timeSlice) . weightedAvg 10 100 $ slices
+                    }
+ where sumv = sortBy (compare `on` summStart) sums
+       start = summStart . G.head $ sumv
+       end = summEnd . G.last $ sumv
+       elapsed = end - start
+       timeSlice = min elapsed 1 / 200
+       slices = U.unfoldrN (round (elapsed / timeSlice)) go (sumv,1)
+         where go (v,i) = let (a,b) = G.span (\s -> summStart s <= t) v
+                              t = start + (i * timeSlice)
+                          in Just (fromIntegral $ G.length a,(b,i+1))
+
 -- | Sort a vector.
 sortBy :: (G.Vector v e) => I.Comparison e -> v e -> v e
 sortBy cmp = G.modify (I.sortBy cmp)

lib/Network/HTTP/LoadTest/Types.hs

     , summEnd
     -- * Result analysis
     , Analysis(..)
+    , Basic(..)
     ) where
 
 import Control.Applicative ((<$>), (<*>), empty)
 import Control.Exception (Exception, IOException)
-import Criterion.Analysis (SampleAnalysis(..))
 import Data.Data (Data)
 import Data.Aeson.Types (Value(Object), FromJSON(..), ToJSON(..), (.:), (.=), object)
 import Data.Typeable (Typeable)
 summEnd :: Summary -> Double
 summEnd Summary{..} = summStart + summElapsed
 
-data Analysis = Analysis {
-      latency :: !SampleAnalysis
+data Analysis a = Analysis {
+      latency :: !a
     , latency99 :: !Double
     , latency999 :: !Double
-    , throughput :: !SampleAnalysis
+    , throughput :: !a
     , throughput10 :: !Double
     } deriving (Eq, Show, Typeable, Data)
 
-instance ToJSON Analysis where
+data Basic = Basic {
+      mean :: !Double
+    , stdDev :: !Double
+    } deriving (Eq, Show, Typeable, Data)
+
+instance ToJSON Basic where
+    toJSON Basic{..} = object [
+                         "mean" .= mean
+                       , "stdDev" .= stdDev
+                       ]
+
+instance FromJSON Basic where
+    parseJSON (Object v) = Basic <$>
+                           v .: "mean" <*>
+                           v .: "stdDev"
+    parseJSON _ = empty
+
+instance (ToJSON a) => ToJSON (Analysis a) where
     toJSON Analysis{..} = object [
                             "latency" .= latency
                           , "latency99" .= latency99
                           , "throughput10" .= throughput10
                           ]
 
-instance FromJSON Analysis where
+instance (FromJSON a) => FromJSON (Analysis a) where
     parseJSON (Object v) = Analysis <$>
                            v .: "latency" <*>
                            v .: "latency99" <*>
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.