packages feed

inspector-wrecker (empty) → 0.1.0.0

raw patch · 9 files changed

+409/−0 lines, 9 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, case-insensitive, connection, data-default, http-client, http-client-tls, http-types, inspector-wrecker, optparse-applicative, text, time, wrecker

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright skedge.me (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ inspector-wrecker.cabal view
@@ -0,0 +1,61 @@+name:                inspector-wrecker+version:             0.1.0.0+synopsis:            Create benchmarks from the HAR files+description:         +  inspector-wrecker is a library and executable for creating HTTP benchmarks from+  a HAR file dump from Chrome's Inspector. +  +  The executable exposes the wrecker options and additionally takes in a path to +  a HAR file.+  +  The library exposes a single function, 'runHar', which produces a function +  'wrecker''s library can use for benchmarks.+   +homepage:            https://github.com/skedgeme/inspector-wrecker#readme+license:             BSD3+license-file:        LICENSE+author:              Jonathan Fischoff+maintainer:          jonathangfischoff@gmail.com+copyright:           2016 skedge.me+category:            Web+build-type:          Simple+-- extra-source-files:+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules: Wrecker.Inspector.HAR+                 , Wrecker.Inspector.Options+                 , Wrecker.Inspector.Main+                 , Wrecker.Inspector+  build-depends: base >= 4.7 && < 5+               , wrecker+               , optparse-applicative+               , http-client+               , http-types+               , time+               , text+               , bytestring+               , case-insensitive+               , aeson+               , http-client-tls >= 0.3.3 && < 0.4+               , connection+               , data-default+  default-language:    Haskell2010++executable inspector-wrecker-exe+  main-is:             src/Main.hs+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  build-depends:       base+                     , inspector-wrecker+  default-language:    Haskell2010++test-suite inspector-wrecker-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , inspector-wrecker+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010+
+ src/Main.hs view
@@ -0,0 +1,5 @@+import qualified Wrecker.Inspector.Main as Wrecker++main :: IO ()+main = Wrecker.main+
+ src/Wrecker/Inspector.hs view
@@ -0,0 +1,13 @@+{- | +  'inspector-wrecker' is a library and executable for creating HTTP benchmarks from+  a HAR file dump from Chrome's Inspector. +  +  The executable exposes the wrecker options and additionally takes in a path to +  a HAR file.+  +  The library exposes a single function, 'runHar', which produces a function +  'wrecker''s library can use for benchmarks.++-}+module Wrecker.Inspector (runHar) where+import Wrecker.Inspector.HAR
+ src/Wrecker/Inspector/HAR.hs view
@@ -0,0 +1,226 @@+{-# LANGUAGE LambdaCase, RecordWildCards, OverloadedStrings, CPP #-}+module Wrecker.Inspector.HAR where+import Control.Exception+import qualified Network.HTTP.Client as HTTP+import qualified Network.HTTP.Types as HTTP+import Wrecker(Recorder, record)+import Data.Time.Clock +import qualified Data.Text as T+import Data.Text (Text)+import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Char8 as BSC+import Data.ByteString (ByteString)+import qualified Data.CaseInsensitive as CI+import Data.Text.Encoding+import Data.Maybe+import Data.Time.Calendar+import Data.Aeson+import Data.Either+import Control.Monad+import Network.HTTP.Client.TLS+import Data.Time.Format+import Network.Connection+import Data.Default++parseExpiry :: Text -> Either SomeException UTCTime+parseExpiry +  = maybe (Left $ toException $ userError "can't format expires time") Right +  . parseTimeM True defaultTimeLocale "%FT%T%QZ"+  . T.unpack++data HAR = HAR +  { hLog :: Log+  } deriving (Show, Eq)+  +instance FromJSON HAR where+  parseJSON = withObject "HAR" $ \o -> do+    HAR <$> o .: "log"+  +data Log = Log+  { lEntries :: [Entry]+  } deriving (Show, Eq)+  +instance FromJSON Log where+  parseJSON = withObject "Log" $ \o -> do+    Log <$> o .: "entries" +  +data Entry = Entry +  { eRequest :: Request+  } deriving (Show, Eq)+  +instance FromJSON Entry where+  parseJSON = withObject "Entry" $ \o -> do+    Entry <$> o .: "request"+  +data Request = Request+  { rMethod      :: Text+  , rUrl         :: Text+  , rHttpVersion :: Text+  , rHeaders     :: [Header]+  , rQueryString :: [QueryItem]+  , rCookies     :: [Cookie]+  , rPostData    :: Maybe PostData+  } deriving (Show, Eq)+  +instance FromJSON Request where+  parseJSON = withObject "Request" $ \o -> do+    Request <$> o .: "method"+            <*> o .: "url"+            <*> o .: "httpVersion"+            <*> o .: "headers"+            <*> o .: "queryString"+            <*> o .: "cookies"+            <*> o .:? "postData" .!= Nothing+  +data Cookie = Cookie +  { cName     :: Text+  , cValue    :: Text+  , cDomain   :: Maybe Text+  , cPath     :: Maybe Text+  , cExpires  :: Maybe Text+  , cHttpOnly :: Maybe Bool+  , cSecure   :: Maybe Bool+  } deriving (Show, Eq)++instance FromJSON Cookie where+  parseJSON = withObject "Cookie" $ \o -> do    +    Cookie <$> o .: "name"+           <*> o .: "value" +           <*> o .:? "domain"   .!= Nothing +           <*> o .:? "path"     .!= Nothing+           <*> o .:? "expires"  .!= Nothing+           <*> o .:? "httpOnly" .!= Nothing+           <*> o .:? "secure"   .!= Nothing++data Header = Header +  { hName  :: Text+  , hValue :: Text+  } deriving (Show, Eq)++instance FromJSON Header where+  parseJSON = withObject "Header" $ \o -> do+    Header <$> o .: "name"+           <*> o .: "value"+  +data QueryItem = QueryItem+  { qName  :: Text+  , qValue :: Text+  } deriving (Show, Eq)+  +instance FromJSON QueryItem where+  parseJSON = withObject "QueryItem" $ \o -> do +    QueryItem <$> o .: "name"+              <*> o .: "value"+  +data PostData = PostData+  { pMimeType :: Text+  , pText     :: Text+  } deriving (Show, Eq)+  +instance FromJSON PostData where+  parseJSON = withObject "PostData" $ \o -> do+    PostData <$> o .: "mimeType"+             <*> o .: "text"++toHTTP :: UTCTime -> Request -> Either SomeException HTTP.Request+toHTTP now Request {..} = do+  initRequest <- HTTP.parseUrlThrow +               $ T.unpack+               $ head+               $ T.splitOn "?"+               $ decodeUtf8 +               $ HTTP.urlDecode False +               $ encodeUtf8 rUrl +  +  version <- parseHTTPVersion rHttpVersion+  +  httpCookies <- mapM (toHTTPCookie now) rCookies+  +  return $ initRequest +    { HTTP.method         = encodeUtf8 rMethod +    , HTTP.queryString    = toHTTPQueryString rQueryString+    , HTTP.requestHeaders = filter ((/= "Content-Length"). fst) $ map toHTTPHeader rHeaders+    , HTTP.requestBody    = HTTP.RequestBodyLBS . BSL.fromStrict $ maybe "" toBody rPostData+    , HTTP.requestVersion = version+    , HTTP.cookieJar      = Just $ HTTP.createCookieJar httpCookies+    }++toBody :: PostData -> ByteString+toBody PostData {..} = encodeUtf8 pText++parseHTTPVersion :: Text -> Either SomeException HTTP.HttpVersion+parseHTTPVersion = \case+  "HTTP/2.0" -> Right $ HTTP.HttpVersion 2 0+  "HTTP/1.1" -> Right $ HTTP.http11+  "HTTP/1.0" -> Right $ HTTP.http10+  "HTTP/0.9" -> Right $ HTTP.http09+  "unknown"  -> Right $ HTTP.http11+  x          -> Left  $ toException $ userError $ "unknown http version " ++ T.unpack x++toHTTPQueryString :: [QueryItem] -> ByteString+toHTTPQueryString = HTTP.urlDecode False . HTTP.renderQuery False . map toQueryItem ++toQueryItem :: QueryItem -> HTTP.QueryItem+toQueryItem QueryItem {..} = (encodeUtf8 qName, Just $ encodeUtf8 qValue)++toHTTPHeader :: Header -> HTTP.Header+toHTTPHeader Header {..} = (CI.mk $ encodeUtf8 hName, encodeUtf8 hValue) ++toHTTPCookie :: UTCTime -> Cookie -> Either SomeException HTTP.Cookie+toHTTPCookie now Cookie {..} = do+  let nullUTCTime = UTCTime (365000 `addDays` utctDay now) (secondsToDiffTime 0)+  expiryTime <- maybe (return nullUTCTime) parseExpiry cExpires +  return HTTP.Cookie+    { HTTP.cookie_name              = encodeUtf8 cName+    , HTTP.cookie_value             = encodeUtf8 cValue+    , HTTP.cookie_expiry_time       = expiryTime+    , HTTP.cookie_domain            = maybe "" encodeUtf8 cDomain+    , HTTP.cookie_path              = maybe "" encodeUtf8 cPath+    , HTTP.cookie_creation_time     = now+    , HTTP.cookie_last_access_time  = now+    , HTTP.cookie_persistent        = True+    , HTTP.cookie_host_only         = False+    , HTTP.cookie_secure_only       = fromMaybe False cSecure+    , HTTP.cookie_http_only         = fromMaybe False cHttpOnly+    }++makeRequestKey :: Int -> HTTP.Request -> String+makeRequestKey index req = show index ++ " " ++ show (HTTP.getUri req)++harFileToRequests :: FilePath -> IO ([SomeException], [HTTP.Request])+harFileToRequests filePath = do +  harFile <-  either (throwIO . userError) return +          =<< eitherDecode <$> BSL.readFile filePath+  now  <- getCurrentTime++  let harRequests = map eRequest $ lEntries $ hLog harFile+  return $ partitionEithers $ map (toHTTP now) harRequests ++recordRequest :: HTTP.Manager -> Recorder -> Int -> HTTP.Request -> IO ()+recordRequest manager recorder index req = do +  let key = makeRequestKey index req+  record recorder key $ void $ HTTP.httpLbs req manager++-- | 'runHar' takes in a file path to HAR dump created by Chrome's Inspector+--   and creates a function that be used by 'wrecker''s 'run' or +--   'defaultMain'.+runHar :: FilePath -> IO (Recorder -> IO ())+runHar filePath = do +  (errors, reqs) <- harFileToRequests filePath+  mapM_ print errors+  +  context <- initConnectionContext+  +  return $ \recorder -> do +#if MIN_VERSION_http_client(0,5,0)+    manager <- HTTP.newManager +           $ (mkManagerSettingsContext (Just context) def Nothing)+               { HTTP.managerResponseTimeout = HTTP.responseTimeoutNone }+#else+    manager <- HTTP.newManager +           $ (mkManagerSettingsContext (Just context) def Nothing)+               { HTTP.managerResponseTimeout = Nothing }+#endif++  +    mapM_ (uncurry $ recordRequest manager recorder) $ zip [0..] reqs
+ src/Wrecker/Inspector/Main.hs view
@@ -0,0 +1,10 @@+module Wrecker.Inspector.Main where+import Wrecker.Inspector.HAR+import Wrecker.Inspector.Options+import Wrecker++main :: IO ()+main = do +  options <- runParser+  runner <- runHar (harFilePath options)+  run (wreckerOptions options) [(harFilePath options, runner)]
+ src/Wrecker/Inspector/Options.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE RecordWildCards, CPP #-}+module Wrecker.Inspector.Options where+import qualified Wrecker.Options as W+import Options.Applicative.Builder+import Options.Applicative+import Control.Exception+#if __GLASGOW_HASKELL__ < 800+import Data.Monoid+#endif++data Options = Options +  { harFilePath    :: FilePath+  , wreckerOptions :: W.Options+  } deriving (Show, Eq)+  +data PartialOptions = PartialOptions+  { mHarFilePath    :: Maybe FilePath+  , mWreckerOptions :: Maybe W.PartialOptions+  } deriving (Show, Eq)+  +instance Monoid PartialOptions where+  mempty = PartialOptions { mHarFilePath = Nothing, mWreckerOptions = mempty }+  mappend x y = PartialOptions +    { mHarFilePath    = mHarFilePath    x <|> mHarFilePath    y+    , mWreckerOptions = mWreckerOptions x <|> mWreckerOptions y+    } +  +optionalOption :: Read a => Mod OptionFields a -> Parser (Maybe a)+optionalOption = optional . option auto  +  +pPartialOptions :: Parser PartialOptions+pPartialOptions +   =  PartialOptions +  <$> optionalOption +      (  long "file-path"+      <> help "HAR file path"+      )+  <*> optional W.pPartialOptions++completeOptions :: PartialOptions -> Maybe Options+completeOptions options = case mempty <> options of+  PartialOptions +    { mHarFilePath    = Just harFilePath+    , mWreckerOptions = Just partialWreckerOptions+    } -> Options harFilePath +     <$> W.completeOptions partialWreckerOptions+  _ -> Nothing+      +runParser :: IO Options+runParser = do +  let opts = info (helper <*> pPartialOptions)+               ( fullDesc+               <> progDesc "Welcome to inspector-wrecker"+               <> header "inspector-wrecker - HTTP stress tester and benchmarker with HAR reader" +               )+  +  partialOptions <- execParser opts +  case completeOptions partialOptions of+    Nothing -> throwIO $ userError "Missing file-path argument!"+    Just  x -> return x
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"