diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,10 @@ +0.1.1 +===== + +* Make AWS region a configurable parameter. +* Support for Chart >= 1.3. +* Upgrade to optparse-applicative-0.10.0. + 0.1 === diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -55,7 +55,7 @@ cabal install alex happy gtk2hs-buildtools ~~~ -You then pass the flag '-fwith-chart' to the the installation commands: +You then pass the flag `-fwith-chart` to the the installation commands: ~~~{.bash} cabal install aws-performance-tests -fwith-chart @@ -72,14 +72,14 @@ Usage ===== -After installing the package you'll find the executable 'dynamodb-performance' in the +After installing the package you'll find the executable `dynamodb-performance` in the default location where cabal is configured to install binaries. In order to use the application you must put your AWS API credentials for -your AWS account in the file '~/.aws-keys' as described in the +your AWS account in the file `~/.aws-keys` as described in the [Documentation of the aws package](https://github.com/aristidb/aws#example-usage). -For help on available options you may call the executable with '--help': +For help on available options you may call the executable with `--help`: ~~~{.bash} dynamodb-performance --help diff --git a/aws-performance-tests.cabal b/aws-performance-tests.cabal --- a/aws-performance-tests.cabal +++ b/aws-performance-tests.cabal @@ -3,7 +3,7 @@ -- ------------------------------------------------------ -- Name: aws-performance-tests -Version: 0.1 +Version: 0.1.1 Synopsis: Performance Tests for the Haskell bindings for Amazon Web Services (AWS) Description: Performance Tests for the Haskell bindings for @@ -48,7 +48,7 @@ source-repository this type: git location: https://github.com/alephcloud/hs-aws-performance-tests.git - tag: 0.1 + tag: 0.1.1 Flag with-chart Description: Build applications with support for printing charts. @@ -86,12 +86,15 @@ aws >= 0.10.3, aws-performance-tests, base == 4.*, + bytestring >= 0.10, configuration-tools >= 0.2.4, containers >= 0.5, + dlist >= 0.7, errors >= 1.4.7, http-client >= 0.3, lens >= 4.2, monad-control >= 0.3, + optparse-applicative >= 0.10, resourcet >= 1.1, statistics >= 0.12, text >= 1.1, diff --git a/constraints b/constraints --- a/constraints +++ b/constraints @@ -13,7 +13,7 @@ attoparsec ==0.12.1.0, attoparsec-conduit ==1.1.0, aws ==0.10.3, - aws-performance-tests ==0.1, + aws-performance-tests ==0.1.1, base ==4.7.0.1, base-unicode-symbols ==0.2.2.4, base16-bytestring ==0.1.1.6, @@ -34,7 +34,7 @@ comonad ==4.2, conduit ==1.1.6, conduit-extra ==1.1.1, - configuration-tools ==0.2.4, + configuration-tools ==0.2.4.1, connection ==0.2.1, containers ==0.5.5.1, contravariant ==0.6, @@ -82,7 +82,7 @@ nats ==0.2, network ==2.5.0.0, old-locale ==1.0.0.6, - optparse-applicative ==0.9.0, + optparse-applicative ==0.10.0, parallel ==3.2.0.4, parsec ==3.1.5, pem ==0.2.2, diff --git a/src/Aws/Test/DynamoDb/Performance.hs b/src/Aws/Test/DynamoDb/Performance.hs --- a/src/Aws/Test/DynamoDb/Performance.hs +++ b/src/Aws/Test/DynamoDb/Performance.hs @@ -40,6 +40,8 @@ import Control.Monad.Trans.Control import Control.Monad.Trans.Resource +import qualified Data.ByteString.Char8 as B8 +import qualified Data.DList as D import qualified Data.List as L import qualified Data.Map as M import Data.Monoid @@ -128,14 +130,14 @@ data Stat = Stat { statFailure :: !Int , statSuccess :: !Int - , statFailureLatency :: !ST.Sample -- ^ latency in milliseconds - , statSuccessLatency :: !ST.Sample -- ^ latency in milliseconds + , statFailureLatency :: !(D.DList Double) -- ^ latency in milliseconds + , statSuccessLatency :: !(D.DList Double) -- ^ latency in milliseconds , statFailureMessages :: !(S.Set T.Text) } deriving (Show, Eq, Ord, Typeable) instance Monoid Stat where - mempty = Stat 0 0 V.empty V.empty S.empty + mempty = Stat 0 0 mempty mempty mempty (Stat a0 a1 a2 a3 a4) `mappend` (Stat b0 b1 b2 b3 b4) = Stat (a0 + b0) (a1 + b1) @@ -144,11 +146,16 @@ (a4 <> b4) successStat :: Double -> Stat -successStat l = Stat 0 1 V.empty (V.singleton l) S.empty +successStat l = Stat 0 1 mempty (D.singleton l) mempty failStat :: Double -> T.Text -> Stat -failStat l e = Stat 1 0 (V.singleton l) V.empty (S.singleton e) +failStat l e = Stat 1 0 (D.singleton l) mempty (S.singleton e) +toSample + :: D.DList Double + -> ST.Sample +toSample = V.fromList . D.toList + printResult :: T.Text -> NominalDiffTime @@ -165,18 +172,18 @@ (realToFrac totalTime :: Double) -- Successes - let (succMin, succMax) = ST.minMax statSuccessLatency - succMean = ST.mean statSuccessLatency - succStdDev = ST.stdDev statSuccessLatency + let (succMin, succMax) = ST.minMax succSample + succMean = ST.mean succSample + succStdDev = ST.stdDev succSample printf "Success latencies\n" printf " min: %.2fms, max %.2fms\n" succMin succMax printf " mean: %.2fms, standard deviation: %.2fms\n\n" succMean succStdDev -- Failures unless (statFailure == 0) $ do - let (failMin, failMax) = ST.minMax statFailureLatency - failMean = ST.mean statFailureLatency - failStdDev = ST.stdDev statFailureLatency + let (failMin, failMax) = ST.minMax failSample + failMean = ST.mean failSample + failStdDev = ST.stdDev failSample printf "Failure latencies\n" printf " min: %.2fms, max %.2fms\n" failMin failMax printf " mean: %.2fms, standard deviation %.2fms\n\n" failMean failStdDev @@ -186,6 +193,9 @@ forM_ (S.toList statFailureMessages) $ \e -> T.putStrLn $ " " <> sshow e printf "\n" + where + succSample = toSample statSuccessLatency + failSample = toSample statFailureLatency writeLatencyData :: String -- ^ file name prefix @@ -193,8 +203,8 @@ -> Stat -- ^ results -> IO () writeLatencyData prefix testName Stat{..} = do - writeSample (prefix <> "-" <> T.unpack testName <> "-success.txt") statSuccessLatency - writeSample (prefix <> "-" <> T.unpack testName <> "-failure.txt") statFailureLatency + writeSample (prefix <> "-" <> T.unpack testName <> "-success.txt") (toSample statSuccessLatency) + writeSample (prefix <> "-" <> T.unpack testName <> "-failure.txt") (toSample statFailureLatency) #ifdef WITH_CHART -- -------------------------------------------------------------------------- -- @@ -216,7 +226,9 @@ & layout_title .~ T.unpack chartTitle & layout_background .~ solidFillStyle (opaque white) & layout_left_axis_visibility . axis_show_ticks .~ False +#if !MIN_VERSION_Chart(1,3,0) & setLayoutForeground (opaque black) +#endif & layout_plots .~ [ toPlot (pl d) | d <- dats ] densityChart @@ -237,10 +249,16 @@ -> T.Text -- ^ test name -> Stat -- ^ results -> IO () -writeChart prefix testName Stat{..} = renderableToPDFFile render 800 600 $ - prefix <> "-" <> T.unpack testName <> "-density.pdf" +writeChart prefix testName Stat{..} = void $ +#if MIN_VERSION_Chart_cairo(1,3,0) + renderableToFile opts path render +#else + renderableToFile opts render path +#endif where - render = densityChart statSuccessLatency statFailureLatency + path = prefix <> "-" <> T.unpack testName <> "-density.pdf" + opts = FileOptions (800,600) PDF + render = densityChart (toSample statSuccessLatency) (toSample statFailureLatency) #endif @@ -277,11 +295,12 @@ runThread :: (Transaction r x, ServiceConfiguration r ~ DY.DdbConfiguration) => Configuration + -> DY.DdbConfiguration NormalQuery -> HTTP.Manager -> [r] -> IO Stat -runThread cfg manager = flip foldM mempty $ \stat req -> do - (t,response) <- time . runResourceT $ aws cfg dyConfiguration manager req +runThread cfg dyCfg manager = flip foldM mempty $ \stat req -> do + (t,response) <- time . runResourceT $ aws cfg dyCfg manager req case responseResult response of Right _ -> return $ stat <> successStat (realToFrac t * 1000) Left e -> return $ stat <> failStat (realToFrac t * 1000) (sshow e) @@ -299,7 +318,7 @@ cfg <- baseConfiguration (t, stats) <- HTTP.withManager managerSettings $ \manager -> time $ mapConcurrently - (runThread cfg manager) + (runThread cfg dyCfg manager) (map mkRequests [0.. _paramThreadCount - 1]) -- report results @@ -312,6 +331,9 @@ writeChart prefix testName stat #endif where + dyCfg = dyConfiguration + { DY.ddbcRegion = _paramRegion + } managerSettings = HTTP.defaultManagerSettings { HTTP.managerConnCount = _paramThreadCount + 5 , HTTP.managerResponseTimeout = Just (1000 * 1000000) -- 1 second @@ -333,7 +355,7 @@ T.putStrLn $ "Start test \"" <> testName <> "\"" cfg <- baseConfiguration (t, stats) <- time $ mapConcurrently - (\r -> HTTP.withManager managerSettings $ \m -> runThread cfg m r) + (\r -> HTTP.withManager managerSettings $ \m -> runThread cfg dyCfg m r) (map mkRequests [0.. _paramThreadCount - 1]) -- report results @@ -346,6 +368,9 @@ writeChart prefix testName stat #endif where + dyCfg = dyConfiguration + { DY.ddbcRegion = _paramRegion + } managerSettings = HTTP.defaultManagerSettings { HTTP.managerConnCount = 1 , HTTP.managerResponseTimeout = Just (1000 * 1000000) -- 1 second @@ -404,8 +429,9 @@ #ifdef WITH_CHART , _paramChartFilePrefix :: !(Maybe String) #endif + , _paramRegion :: !DY.Region } - deriving (Show, Read, Eq, Ord, Typeable) + deriving (Show, Read, Eq, Typeable) defaultTestParams :: TestParams defaultTestParams = TestParams @@ -419,6 +445,7 @@ #ifdef WITH_CHART , _paramChartFilePrefix = Nothing #endif + , _paramRegion = DY.ddbUsWest2 } $(makeLenses ''TestParams) @@ -435,6 +462,7 @@ #ifdef WITH_CHART , "ChartFilePrefix" .= _paramChartFilePrefix #endif + , "Region" .= B8.unpack (DY.rName _paramRegion) ] instance FromJSON (TestParams -> TestParams) where @@ -449,22 +477,25 @@ #ifdef WITH_CHART <*< paramChartFilePrefix ..: "ChartFilePrefix" % o #endif + <*< setProperty paramRegion "Region" parseRegion o + where + parseRegion = withText "Region" $ either fail return . readRegion pTestParams :: MParser TestParams pTestParams = id - <$< paramThreadCount .:: option + <$< paramThreadCount .:: option auto % long "thread-count" <> metavar "INT" <> help "number of request threads" - <*< paramRequestCount .:: option + <*< paramRequestCount .:: option auto % long "request-count" <> metavar "INT" <> help "number of requests PER THREAD" - <*< paramReadCapacity .:: option + <*< paramReadCapacity .:: option auto % long "read-capacity" <> metavar "INT" <> help "minimum provisioned read capacity for the test table" - <*< paramWriteCapacity .:: option + <*< paramWriteCapacity .:: option auto % long "write-capacity" <> metavar "INT" <> help "minimum provisioned write capacity for the test table" @@ -485,6 +516,10 @@ <> metavar "STRING" <> help "if present latency density chargts are written to files with this prefix.") #endif + <*< paramRegion .:: option (eitherReader (readRegion . T.pack)) + % long "region" + <> metavar "REGION-STRING" + <> help "the AWS region that is used for the test Dynamo database" -- -------------------------------------------------------------------------- -- -- Main diff --git a/src/Aws/Test/DynamoDb/Utils.hs b/src/Aws/Test/DynamoDb/Utils.hs --- a/src/Aws/Test/DynamoDb/Utils.hs +++ b/src/Aws/Test/DynamoDb/Utils.hs @@ -30,6 +30,7 @@ , withTable , withTable_ , createTestTable +, readRegion ) where import Aws @@ -43,8 +44,10 @@ import Control.Monad.IO.Class import Control.Monad.Trans.Control +import qualified Data.List as L import Data.Monoid import qualified Data.Text as T +import qualified Data.Text.Encoding as T import qualified Data.Text.IO as T import System.IO @@ -140,4 +143,19 @@ , DY.writeCapacityUnits = writeCapacity } - +readRegion + :: T.Text + -> Either String DY.Region +readRegion t = + maybe (Left $ "unknown region: " <> T.unpack t) Right $ + L.find (\(DY.Region _ n) -> T.decodeUtf8 n == t) + [ DY.ddbLocal + , DY.ddbUsEast1 + , DY.ddbUsWest1 + , DY.ddbUsWest2 + , DY.ddbEuWest1 + , DY.ddbApNe1 + , DY.ddbApSe1 + , DY.ddbApSe2 + , DY.ddbSaEast1 + ]