Bryan O'Sullivan avatar Bryan O'Sullivan committed ae402a5

Add support for dumping analysis as JSON.

Comments (0)

Files changed (4)

 import Control.Monad (forM_, unless)
 import Criterion.Analysis (SampleAnalysis(..), OutlierEffect(..),
                            OutlierVariance(..))
+import Data.Aeson (encode)
 import Data.Maybe (catMaybes)
 import Data.Monoid (mappend)
 import Data.Text (Text)
 import System.Console.CmdArgs
 import System.Exit (ExitCode(ExitFailure), exitWith)
 import System.IO (hPutStrLn, stderr)
+import qualified Data.ByteString.Lazy as L
 import qualified Data.Text.Format as T
 import qualified Network.HTTP.LoadTest as LoadTest
 
 data Args = Args {
       concurrency :: Int
+    , json :: Maybe FilePath
     , num_requests :: Int
     , requests_per_second :: Double
     , timeout :: Double
 defaultArgs :: Args
 defaultArgs = Args {
                 concurrency = 1
+              , json = def
               , num_requests = 1
               , requests_per_second = def
               , timeout = 60
       exitWith (ExitFailure 1)
     Right results -> do
       whenNormal $ T.print "analysing results\n" ()
-      report =<< LoadTest.analyse results
+      analysis <- LoadTest.analyse results
+      case json of
+        Just "-" -> L.putStrLn (encode analysis)
+        Just f   -> L.writeFile f (encode analysis)
+        _        -> return ()
+      whenNormal $ report analysis
 
 validateArgs :: Args -> IO ()
 validateArgs Args{..} = do

http-load-tester.cabal

   hs-source-dirs: lib
   exposed-modules:
     Network.HTTP.LoadTest
+    Network.HTTP.LoadTest.Types
 
   ghc-options: -Wall
   if flag(developer)
     ghc-prof-options: -auto-all
 
   build-depends:
+    aeson,
     base < 5,
     bytestring,
     criterion >= 0.5.1.0,
     ghc-prof-options: -auto-all
 
   build-depends:
+    aeson,
     base < 5,
+    bytestring,
     cmdargs >= 0.7,
     criterion,
     http-load-tester,

lib/Network/HTTP/LoadTest.hs

-{-# LANGUAGE BangPatterns, DeriveDataTypeable, OverloadedStrings,
-    RecordWildCards, ScopedTypeVariables #-}
+{-# LANGUAGE BangPatterns, RecordWildCards #-}
 
 module Network.HTTP.LoadTest
     (
     -- * Running a load test
-      Config(..)
-    , NetworkError(..)
+      NetworkError(..)
+    , Config(..)
     , defaultConfig
     , run
-    -- * Results
-    , Event(..)
-    , Summary(..)
-    , summEnd
     -- * Result analysis
     , Analysis(..)
     , analyse
 import Control.Applicative ((<$>))
 import Control.Concurrent (forkIO, threadDelay)
 import Control.Concurrent.Chan (newChan, readChan, writeChan)
-import Control.Exception (Exception, IOException, catch, throwIO, try)
+import Control.Exception (catch, throwIO, try)
 import Control.Monad (forM_, replicateM, when)
-import Criterion.Analysis (SampleAnalysis(..), analyseSample, scale)
-import Data.Data (Data)
+import Criterion.Analysis (analyseSample, scale)
 import Data.Either (partitionEithers)
 import Data.Function (on)
 import Data.List (nub)
 import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime)
-import Data.Typeable (Typeable)
 import Network.HTTP.Enumerator
+import Network.HTTP.LoadTest.Types
 import Prelude hiding (catch)
 import Statistics.Quantile (weightedAvg)
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Vector.Unboxed as U
 import qualified System.Timeout as T
 
-data Config = Config {
-      concurrency :: Int
-    , numRequests :: Int
-    , requestsPerSecond :: Double
-    , timeout :: Double
-    , url :: String
-    } deriving (Eq, Read, Show, Typeable, Data)
-
-defaultConfig :: Config
-defaultConfig = Config {
-                concurrency = 1
-              , numRequests = 1
-              , requestsPerSecond = 0
-              , timeout = 60
-              , url = ""
-              }
-
-data Event =
-    HttpResponse {
-      respCode :: {-# UNPACK #-} !Int
-    , respLength :: {-# UNPACK #-} !Int
-    } | 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
-    , summStart :: {-# UNPACK #-} !Double
-    } deriving (Eq, Read, Show, Typeable, Data)
-
-summEnd :: Summary -> Double
-summEnd Summary{..} = summStart + summElapsed
-
 run :: Config -> IO (Either [NetworkError] (V.Vector Summary))
 run cfg@Config{..} = do
   req <- parseUrl url
         _         -> closeManager mgr >> return Timeout
 
 respEvent :: Response -> Event
-respEvent resp = HttpResponse {
-                   respCode = statusCode resp
-                 , respLength = fromIntegral . L.length . responseBody $ resp
-                 }
-
-data Analysis = Analysis {
-      latency :: SampleAnalysis
-    , latency99 :: Double
-    , latency999 :: Double
-    , throughput :: SampleAnalysis
-    , throughput10 :: Double
-    } deriving (Eq, Show, Typeable, Data)
+respEvent resp =
+    HttpResponse {
+      respCode = statusCode resp
+    , respContentLength = fromIntegral . L.length . responseBody $ resp
+    }
 
 analyse :: V.Vector Summary -> IO Analysis
 analyse sums = do

lib/Network/HTTP/LoadTest/Types.hs

+{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, RecordWildCards #-}
+
+module Network.HTTP.LoadTest.Types
+    (
+    -- * Running a load test
+      Config(..)
+    , defaultConfig
+    , NetworkError(..)
+    -- * Results
+    , Event(..)
+    , Summary(..)
+    , summEnd
+    -- * Result analysis
+    , Analysis(..)
+    ) 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)
+
+data Config = Config {
+      concurrency :: Int
+    , numRequests :: Int
+    , requestsPerSecond :: Double
+    , timeout :: Double
+    , url :: String
+    } deriving (Eq, Read, Show, Typeable, Data)
+
+instance ToJSON Config where
+    toJSON Config{..} = object [
+                          "concurrency" .= concurrency
+                        , "numRequests" .= numRequests
+                        , "requestsPerSecond" .= requestsPerSecond
+                        , "timeout" .= timeout
+                        , "url" .= url
+                        ]
+
+instance FromJSON Config where
+    parseJSON (Object v) = Config <$>
+                           v .: "concurrency" <*>
+                           v .: "numRequests" <*>
+                           v .: "requestsPerSecond" <*>
+                           v .: "timeout" <*>
+                           v .: "url"
+    parseJSON _ = empty
+
+defaultConfig :: Config
+defaultConfig = Config {
+                concurrency = 1
+              , numRequests = 1
+              , requestsPerSecond = 0
+              , timeout = 60
+              , url = ""
+              }
+
+data Event =
+    HttpResponse {
+      respCode :: {-# UNPACK #-} !Int
+    , respContentLength :: {-# UNPACK #-} !Int
+    } | Timeout
+    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
+    , summStart :: {-# UNPACK #-} !Double
+    } deriving (Eq, Read, Show, Typeable, Data)
+
+summEnd :: Summary -> Double
+summEnd Summary{..} = summStart + summElapsed
+
+data Analysis = Analysis {
+      latency :: !SampleAnalysis
+    , latency99 :: !Double
+    , latency999 :: !Double
+    , throughput :: !SampleAnalysis
+    , throughput10 :: !Double
+    } deriving (Eq, Show, Typeable, Data)
+
+instance ToJSON Analysis where
+    toJSON Analysis{..} = object [
+                            "latency" .= latency
+                          , "latency99" .= latency99
+                          , "latency999" .= latency999
+                          , "throughput" .= throughput
+                          , "throughput10" .= throughput10
+                          ]
+
+instance FromJSON Analysis where
+    parseJSON (Object v) = Analysis <$>
+                           v .: "latency" <*>
+                           v .: "latency99" <*>
+                           v .: "latency999" <*>
+                           v .: "throughput" <*>
+                           v .: "throughput10"
+    parseJSON _ = empty
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.