wrecker 0.1.3.0 → 0.1.3.1
raw patch · 8 files changed
+122/−105 lines, 8 filesdep ~aesondep ~arraydep ~base
Dependency ranges changed: aeson, array, base, clock, connection, containers, cookie, cryptonite, data-default, data-default-class, deepseq, exceptions, filepath, http-client, http-types, immortal, memory, network, network-uri, optparse-applicative, statistics, streaming-commons, text, time, tls, transformers, unix, unordered-containers, vector, warp, wreq
Files
- app/Main.hs +8/−7
- examples/Client.lhs +23/−19
- examples/Main.lhs +11/−9
- examples/Server.hs +17/−21
- src/Wrecker/Options.hs +6/−6
- src/Wrecker/Recorder.hs +5/−2
- src/Wrecker/Runner.hs +5/−2
- wrecker.cabal +47/−39
app/Main.hs view
@@ -3,11 +3,9 @@ import Network.HTTP.Client import Options.Applicative.Builder import Options.Applicative-import Data.Monoid import Control.Exception import Control.Monad (void)-import qualified Network.Wreq as Wreq-import Control.Lens+import Data.Monoid parser :: Parser (PartialOptions, String) parser@@ -32,7 +30,10 @@ main :: IO () main = do (options, url) <- runParser'- man <- newManager defaultManagerSettings { managerConnCount = concurrency options }- void $ runOne options $ \env -> do- void $ record (recorder env) url- $ Wreq.getWith (Wreq.defaults & Wreq.manager .~ Right man) url+ man <- newManager defaultManagerSettings { managerConnCount = concurrency options+ , managerIdleConnectionCount = concurrency options+ }++ req <- parseRequest url+ void $ runOne options $ \env ->+ void $ record (recorder env) url $ httpLbs req man
examples/Client.lhs view
@@ -50,13 +50,7 @@ This is Haskell, so first we turn on the extensions we would like to use. ```haskell-{-# LANGUAGE NamedFieldPuns- , DeriveAnyClass- , DeriveGeneric- , OverloadedStrings- , DuplicateRecordFields- , CPP-#-}+{-# LANGUAGE NamedFieldPuns, DeriveGeneric, OverloadedStrings, CPP #-} ``` - `NamedFieldPuns` will let us destructure records conveniently. @@ -64,8 +58,6 @@ can generate the JSON conversion functions for us automatically. - `OverloadedStrings` is a here so Redditors don't yell at me for using `String` instead of `Text`.-- `DuplicateRecordFields` lets us use the `username` field in two records...welcome-to the future. - `CPP`...ignore that... ```haskell@@ -106,7 +98,6 @@ ```haskell import GHC.Generics import Data.ByteString.Lazy (ByteString)-import Data.Text (Text) import Data.Text as T import Network.HTTP.Client (responseBody) ```@@ -127,7 +118,10 @@ It is represented in Haskell as ```haskell data Envelope a = Envelope { value :: a }- deriving (Show, Eq, Generic, FromJSON, ToJSON)+ deriving (Show, Eq, Generic)++instance FromJSON a => FromJSON (Envelope a)+instance ToJSON a => ToJSON (Envelope a) ``` The `Envelope` only exists to transmit data between the server and the browser.@@ -270,7 +264,9 @@ , users :: Ref [Ref User ] , login :: RPC Credentials (Ref User) , checkout :: RPC (Ref Cart) () - } deriving (Eq, Show, Generic, FromJSON)+ } deriving (Eq, Show, Generic)++instance FromJSON Root ``` Since the JSON is so uniform, we can use `aeson`'s generic instances.@@ -286,7 +282,9 @@ ```haskell data Product = Product { summary :: Text - } deriving (Eq, Show, Generic, FromJSON)+ } deriving (Eq, Show, Generic)++instance FromJSON Product ``` Calling `GET` on a `Ref Cart` or "/carts/:id" gives@@ -300,7 +298,9 @@ ```haskell data Cart = Cart { items :: Ref [Ref Product] - } deriving (Eq, Show, Generic, FromJSON)+ } deriving (Eq, Show, Generic)++instance FromJSON Cart ``` Calling `GET` on a `Ref User` or "/users/:id" gives @@ -314,7 +314,9 @@ data User = User { cart :: Ref Cart , username :: Text - } deriving (Eq, Show, Generic, FromJSON)+ } deriving (Eq, Show, Generic)++instance FromJSON User ``` ## RPC Types@@ -323,15 +325,17 @@ ```json { "password" : "password"-, "username" : "a@example.com"+, "userid" : "a@example.com" } ``` ```haskell data Credentials = Credentials { password :: Text - , username :: Text - } deriving (Eq, Show, Generic, ToJSON) + , userid :: Text + } deriving (Eq, Show, Generic)++instance ToJSON Credentials ``` ## <a name="Profiling_Script"> Profiling Script@@ -362,7 +366,7 @@ ```haskell userRef <- rpc sess login ( Credentials- { username = "a@example.com"+ { userid = "a@example.com" , password = "password" } )
examples/Main.lhs view
@@ -1,10 +1,10 @@ ## Running the Examples -- To run whole benchmark example `cabal run example`-- Just the client `cabal run example-client `-- Just the server `cabal run example-server`+- Run the whole benchmark example with `cabal run example`+- Run just the client with `cabal run example-client `+- Run just the server with `cabal run example-server` -Additionally the examples take the standard `wrecker` command line arguments, which can be viewed with+Additionally, the examples take the standard `wrecker` command line arguments, which can be viewed with cabal run example -- --help @@ -32,13 +32,14 @@ --silent Disable all output ``` -Below is the source for `example` which creates a client and server.+Below is the source for `example`, which creates a client and server: ```haskell {-# LANGUAGE ScopedTypeVariables #-} import qualified Client as Client import qualified Server as Server-import Wrecker (run, runParser)+import Wrecker (run)+import Wrecker.Options (runParser) import Data.Function (fix) import Control.Exception (handle, IOException) import Control.Concurrent ( threadDelay@@ -52,9 +53,10 @@ , ConnectionParams (..) , initConnectionContext )+import System.Environment ``` -A little utility function which loops until a port is ready for connections.+A little utility function which loops until a port is ready for connections: ```haskell waitFor :: Int -> IO ()@@ -72,13 +74,13 @@ ) ``` -Entry point+Entry point: ```haskell main :: IO () main = do -- Start the server on it's own thread- forkIO $ Server.main+ forkIO $ withArgs [] Server.main -- The examples use port 3000 by default let port = 3000
examples/Server.hs view
@@ -1,20 +1,8 @@-{-# LANGUAGE ScopedTypeVariables- , TypeOperators- , OverloadedStrings- , DeriveGeneric- , FlexibleInstances- , QuasiQuotes- , DeriveAnyClass- , CPP- , FlexibleContexts- , UndecidableInstances- , RecordWildCards- , DeriveFunctor- , LambdaCase- , RecursiveDo- , OverloadedStrings- , TupleSections-#-}+{-# LANGUAGE ScopedTypeVariables, TypeOperators, OverloadedStrings #-}+{-# LANGUAGE DeriveGeneric, FlexibleInstances, QuasiQuotes #-}+{-# LANGUAGE CPP, FlexibleContexts, UndecidableInstances, RecordWildCards #-}+{-# LANGUAGE DeriveFunctor, LambdaCase, OverloadedStrings #-}+{-# LANGUAGE TupleSections, GeneralizedNewtypeDeriving #-} #ifndef _SERVER_IS_MAIN_ module Server where@@ -36,6 +24,7 @@ import qualified Data.Text as T import Data.Monoid import Wrecker+import Wrecker.Runner import Control.Concurrent.NextRef (NextRef) import qualified Control.Concurrent.NextRef as NextRef import qualified Control.Immortal as Immortal@@ -45,10 +34,15 @@ import Network.Socket (Socket) import qualified Network.Socket as N import Control.Exception+import Data.Maybe (listToMaybe)+import System.Environment+import Control.Applicative -newtype Envelope a = Envelope { value :: a }- deriving (Show, Eq, Generic, ToJSON)+data Envelope a = Envelope { value :: a }+ deriving (Show, Eq, Generic) +instance ToJSON a => ToJSON (Envelope a)+ rootRef :: Int -> Text rootRef port = T.pack $ "http://localhost:" ++ show port @@ -189,7 +183,7 @@ Just port -> do s <- N.socket N.AF_INET N.Stream N.defaultProtocol localhost <- N.inet_addr "127.0.0.1" N.bind s (N.SockAddrInet (fromIntegral port) localhost)- N.listen s 100+ N.listen s 1000 return (port, s) Nothing -> openFreePort@@ -213,10 +207,12 @@ main :: IO () main = do+ xs <- getArgs+ let delay = maybe 0 read $ listToMaybe xs (port, socket) <- getASocket $ Just 3000 (ref, recorderThread, recorder) <- newStandaloneRecorder- scottyApp <- Scotty.scottyApp $ app (pure 0) port+ scottyApp <- Scotty.scottyApp $ app (pure delay) port (Warp.runSettingsSocket defaultSettings socket $ recordMiddleware recorder
src/Wrecker/Options.hs view
@@ -95,7 +95,7 @@ , mRequestNameColumnSize = requestNameColumnSize defaultOptions , mOutputFilePath = outputFilePath defaultOptions , mSilent = Just $ silent defaultOptions- , murlDisplay = Just $ urlDisplay defaultOptions+ , murlDisplay = Just $ urlDisplay defaultOptions } mappend x y = PartialOptions { mConcurrency = mConcurrency x <|> mConcurrency y@@ -127,7 +127,7 @@ , mRequestNameColumnSize = requestNameColumnSize , mOutputFilePath = outputFilePath , mSilent = Just silent- , murlDisplay = Just urlDisplay+ , murlDisplay = Just urlDisplay } -> Just $ Options {..} _ -> Nothing @@ -154,11 +154,11 @@ <*> optional ( RunCount <$> option auto ( long "run-count"- <> help "number of times to repeat "+ <> help "number of times to repeat" ) <|> RunTimed <$> option auto ( long "run-timed"- <> help "number of seconds to repeat "+ <> help "number of seconds to repeat" ) ) <*> optionalOption@@ -166,8 +166,8 @@ <> help "How long to wait for all requests to finish" ) <*> optional- ( Interactive <$ switch (long "interactive")- <|> NonInteractive <$ switch (long "non-interactive")+ ( NonInteractive <$ switch (long "non-interactive")+ <|> Interactive <$ switch (long "interactive") ) <*> optionalOption ( long "log-level"
src/Wrecker/Recorder.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE RecordWildCards, ScopedTypeVariables #-} {-# LANGUAGE GeneralizedNewtypeDeriving, DeriveGeneric #-}-{-# LANGUAGE DeriveAnyClass, CPP, BangPatterns #-}+{-# LANGUAGE CPP, BangPatterns #-} module Wrecker.Recorder where import Control.Concurrent.STM import Control.Concurrent.STM.TBMQueue@@ -9,6 +9,9 @@ import System.Clock import Control.Exception import System.Clock.TimeIt+#if !MIN_VERSION_base(4,8,0)+import Control.Applicative+#endif data RunResult = Success { resultTime :: !Double@@ -58,7 +61,7 @@ {- | 'record' is a low level function for collecting timing information. Wrap each action of interest in a call to record. -> record recorder $ threadDelay 1000000 +> record recorder $ threadDelay 1000000 'record' measures the elapsed time of the call, and catches 'HttpException' in the case of failure. This means failures
src/Wrecker/Runner.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE RecordWildCards, ScopedTypeVariables, LambdaCase, BangPatterns #-}-{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TupleSections, CPP #-} module Wrecker.Runner where import Wrecker.Logger import System.Posix.Signals@@ -29,6 +29,9 @@ import Data.Maybe import Network.Connection (ConnectionContext) import qualified Network.Connection as Connection+#if !MIN_VERSION_base(4,8,0)+import Control.Applicative+#endif -- TODO configure whether errors are used in times or not @@ -261,7 +264,7 @@ -} runOne :: Options -> (Environment -> IO ()) -> IO AllStats runOne options f- = let key = "key"+ = let key = "" in fromMaybe (error "runOne: impossible!") . H.lookup key <$> run options [(key, f)]
wrecker.cabal view
@@ -1,5 +1,5 @@ name: wrecker-version: 0.1.3.0+version: 0.1.3.1 synopsis: An HTTP Performance Benchmarker description: 'wrecker' is a library and executable for creating HTTP benchmarks. It is designed for@@ -8,7 +8,7 @@ 'wrecker' includes a wrapped version of the `wreq` Session API , mainly through 'Network.Wreq.Wrecker'. - See https://github.com/skedgeme/wrecker#readme for more information.+ See <https://github.com/skedgeme/wrecker#readme> for more information. homepage: https://github.com/skedgeme/wrecker#readme license: BSD3 license-file: LICENSE@@ -54,53 +54,53 @@ , Network.PublicSuffixList.Serialize , Network.PublicSuffixList.DataStructure - build-depends: base >= 4.7 && < 5- , aeson >= 0.7.0.3+ build-depends: base >= 4.6 && < 5+ , aeson >= 0.7 , ansi-terminal >= 0.6.2 , ansigraph >= 0.3.0- , array >= 0.5.1+ , array >= 0.5.0 , base64-bytestring >= 1.0.0 , blaze-builder >= 0.4.0 , bytestring >= 0.10 , case-insensitive >= 1.2.0- , clock >= 0.7.2+ , clock >= 0.4 , clock-extras >= 0.1.0- , connection >= 0.2.6- , containers >= 0.5.7- , cookie >= 0.4.2- , cryptonite >= 0.20- , data-default >= 0.7.1- , data-default-class >= 0.1.2- , deepseq >= 1.4.2- , exceptions >= 0.8.3- , filepath >= 1.4.1- , http-client >= 0.4.31- , http-types >= 0.9.1- , immortal >= 0.2.2- , memory >= 0.13+ , connection >= 0.2.4+ , containers >= 0.5.5+ , cookie >= 0.4.1+ , cryptonite >= 0.6+ , data-default >= 0.5.3+ , data-default-class >= 0.0.1+ , deepseq >= 1.3+ , exceptions >= 0.8+ , filepath >= 1.3+ , http-client >= 0.4.11+ , http-types >= 0.8.6+ , immortal >= 0.2+ , memory >= 0.7 , mime-types >= 0.1.0- , network >= 2.6.3- , network-uri >= 2.6.1+ , network >= 2.6+ , network-uri >= 2.6 , next-ref >= 0.1.0- , optparse-applicative >= 0.13.0+ , optparse-applicative >= 0.11.0 , random >= 1.1- , statistics >= 0.13.3+ , statistics >= 0.13.2 , stm >= 2.4.4 , stm-chans >= 3.0.0- , streaming-commons >= 0.1.16+ , streaming-commons >= 0.1.10 , tabular >= 0.2.2- , text >= 1.2.2+ , text >= 1.2 , threads >= 0.5.1 , threads-extras >= 0.1.0- , time >= 1.6.0- , tls >= 1.3.8- , transformers >= 0.5.2+ , time >= 1.4+ , tls >= 1.2+ , transformers >= 0.3 , unagi-chan >= 0.4.0- , unix >= 2.7.2- , unordered-containers >= 0.2.7- , vector >= 0.11.0+ , unix >= 2.7+ , unordered-containers >= 0.2.5+ , vector >= 0.10.12 , vty >= 5.11- , wreq >= 0.4.1+ , wreq >= 0.3 default-language: Haskell2010 ghc-options: -Wall -fno-warn-unused-do-bind -pgmL markdown-unlit @@ -114,8 +114,9 @@ , http-client , wreq , lens+ cpp-options: -D_SERVER_IS_MAIN_- ghc-options: -O2 -Wall -Wno-unused-do-bind -Wno-unused-top-binds -threaded -pgmL markdown-unlit -rtsopts "-with-rtsopts=-N -I0 -qg"+ ghc-options: -Wall -fno-warn-unused-do-bind -threaded -pgmL markdown-unlit -rtsopts "-with-rtsopts=-N -I0 -qg" default-language: Haskell2010 executable example-server@@ -125,7 +126,7 @@ , wrecker , scotty , aeson-qq- , warp+ , warp >= 3.2.4 , markdown-unlit , aeson , text@@ -133,8 +134,9 @@ , next-ref , wai , network+ , transformers cpp-options: -D_SERVER_IS_MAIN_- ghc-options: -O2 -Wall -Wno-unused-do-bind -Wno-unused-top-binds -threaded -pgmL markdown-unlit -rtsopts "-with-rtsopts=-N -I0 -qg"+ ghc-options: -Wall -fno-warn-unused-do-bind -threaded -pgmL markdown-unlit -rtsopts "-with-rtsopts=-N -I0 -qg" default-language: Haskell2010 executable example-client@@ -150,7 +152,7 @@ , http-client , connection cpp-options: -D_CLIENT_IS_MAIN_- ghc-options: -O2 -Wall -Wno-unused-top-binds -Wno-unused-do-bind -threaded -pgmL markdown-unlit -rtsopts "-with-rtsopts=-N -I0 -qg"+ ghc-options: -Wall -fno-warn-unused-do-bind -threaded -pgmL markdown-unlit -rtsopts "-with-rtsopts=-N -I0 -qg" default-language: Haskell2010 executable example@@ -160,7 +162,7 @@ , wrecker , scotty , aeson-qq- , warp+ , warp >= 3.2.4 , wreq , markdown-unlit , aeson@@ -173,7 +175,8 @@ , wai , network , connection- ghc-options: -O2 -Wall -Wno-unused-do-bind -O2 -threaded -pgmL markdown-unlit -rtsopts "-with-rtsopts=-N -I0 -qg"+ , transformers+ ghc-options: -Wall -fno-warn-unused-do-bind -threaded -pgmL markdown-unlit -rtsopts "-with-rtsopts=-N -I0 -qg" default-language: Haskell2010 test-suite wrecker-test@@ -199,5 +202,10 @@ , immortal , next-ref , connection- ghc-options: -Wall -Wno-unused-do-bind -O2 -threaded -pgmL markdown-unlit -rtsopts -with-rtsopts=-N+ , transformers+ ghc-options: -Wall -fno-warn-unused-do-bind -threaded -pgmL markdown-unlit -rtsopts "-with-rtsopts=-N -I0 -qg" default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/skedgeme/wrecker