From b2d85d571233cf4973bd46b5ebe176d0cc03391f Mon Sep 17 00:00:00 2001 From: Felipe Lessa Date: Sat, 5 Jan 2013 13:20:11 -0200 Subject: [PATCH 1/3] Avoid http-conduit exceptions from non-2XX codes and default timeouts. --- lib/Network/HTTP/LoadTest.hs | 5 ++++- pronk.cabal | 2 +- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/lib/Network/HTTP/LoadTest.hs b/lib/Network/HTTP/LoadTest.hs index 4dfd892..72f876a 100644 --- a/lib/Network/HTTP/LoadTest.hs +++ b/lib/Network/HTTP/LoadTest.hs @@ -67,8 +67,11 @@ client Config{..} mgr interval = loop 0 [] liftIO . threadDelay . truncate $ (interval - elapsed) * 1000000 loop (n+1) (s:acc) issueRequest :: ResourceT IO (Response L.ByteString) - issueRequest = httpLbs (fromReq request) mgr + issueRequest = httpLbs (clear $ fromReq request) mgr `catch` (throwIO . NetworkError) + where clear r = r { checkStatus = \_ _ -> Nothing + , responseTimeout = Nothing + } timedRequest :: ResourceT IO Event timedRequest | timeout == 0 = respEvent <$> issueRequest diff --git a/pronk.cabal b/pronk.cabal index 1e1ec6e..57a20b8 100644 --- a/pronk.cabal +++ b/pronk.cabal @@ -58,7 +58,7 @@ library ghc-prim >= 0.2.0.0, hashable >= 1.2.0.2, hastache, - http-conduit >= 1.6, + http-conduit >= 1.7, http-types, lifted-base, meldable-heap, From 884aeff27eb2fb917472eedd6f8619d762269d8f Mon Sep 17 00:00:00 2001 From: "Adam C. Foltzer" Date: Tue, 19 Feb 2013 22:18:07 -0800 Subject: [PATCH 2/3] fix for new monadic Hastache contexts --- lib/Network/HTTP/LoadTest/Report.hs | 22 ++++++++++++---------- pronk.cabal | 2 +- 2 files changed, 13 insertions(+), 11 deletions(-) diff --git a/lib/Network/HTTP/LoadTest/Report.hs b/lib/Network/HTTP/LoadTest/Report.hs index da494a3..b687e99 100644 --- a/lib/Network/HTTP/LoadTest/Report.hs +++ b/lib/Network/HTTP/LoadTest/Report.hs @@ -131,17 +131,19 @@ templateDir = unsafePerformIO $ getDataFileName "templates" writeReport :: (Data a) => FilePath -> Handle -> Double -> Analysis a -> IO () writeReport template h elapsed a@Analysis{..} = do - let context "include" = MuLambdaM $ + let context "include" = return . MuLambdaM $ R.includeFile [templateDir, R.templateDir] - context "elapsed" = MuVariable elapsed - context "latKdeTimes" = R.vector "x" latKdeTimes - context "latKdePDF" = R.vector "x" latKdePDF - context "latKde" = R.vector2 "time" "pdf" latKdeTimes latKdePDF - context "latValues" = MuList . map mkGenericContext . G.toList $ lats - context "thrTimes" = R.vector "x" thrTimes - context "thrValues" = R.vector "x" thrValues - context "concTimes" = R.vector "x" . U.fromList $ map fstS conc - context "concValues" = R.vector "x" . U.fromList $ map sndS conc + context "elapsed" = return $ MuVariable elapsed + context "latKdeTimes" = return $ R.vector "x" latKdeTimes + context "latKdePDF" = return $ R.vector "x" latKdePDF + context "latKde" = return $ + R.vector2 "time" "pdf" latKdeTimes latKdePDF + context "latValues" = return . MuList + . map mkGenericContext . G.toList $ lats + context "thrTimes" = return $ R.vector "x" thrTimes + context "thrValues" = return $ R.vector "x" thrValues + context "concTimes" = return . R.vector "x" . U.fromList $ map fstS conc + context "concValues" = return . R.vector "x" . U.fromList $ map sndS conc context n = mkGenericContext a n (latKdeTimes,latKdePDF) = kde 128 . G.convert . G.map summElapsed $ latValues lats = G.map (\s -> s { summStart = summStart s - t }) latValues diff --git a/pronk.cabal b/pronk.cabal index 57a20b8..ee3edd7 100644 --- a/pronk.cabal +++ b/pronk.cabal @@ -57,7 +57,7 @@ library filepath, ghc-prim >= 0.2.0.0, hashable >= 1.2.0.2, - hastache, + hastache >= 0.5.0, http-conduit >= 1.7, http-types, lifted-base, From 0563aacd5381fe08335ccb4bd3f3497f4cc528b9 Mon Sep 17 00:00:00 2001 From: Thomas Woolford Date: Thu, 1 Aug 2013 23:29:53 +0930 Subject: [PATCH 3/3] Keep up to date with changes in conduit HTTP lib. --- app/App.hs | 2 +- lib/Network/HTTP/LoadTest.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/app/App.hs b/app/App.hs index 9543c95..23bbafa 100644 --- a/app/App.hs +++ b/app/App.hs @@ -169,7 +169,7 @@ createRequest Args{..} = do check (Just "POST") = return "POST" check (Just "PUT") = return "PUT" check _ = fatal "only POST or PUT may have a body" - req = req0 { E.redirectCount = 0, E.checkStatus = \_ _ -> Nothing } + req = req0 { E.redirectCount = 0, E.checkStatus = \_ _ _ -> Nothing } case (from_file, literal) of (Nothing,Nothing) -> return req { E.method = maybe "GET" B.pack method } (Just f,Nothing) -> do diff --git a/lib/Network/HTTP/LoadTest.hs b/lib/Network/HTTP/LoadTest.hs index 72f876a..8175109 100644 --- a/lib/Network/HTTP/LoadTest.hs +++ b/lib/Network/HTTP/LoadTest.hs @@ -69,7 +69,7 @@ client Config{..} mgr interval = loop 0 [] issueRequest :: ResourceT IO (Response L.ByteString) issueRequest = httpLbs (clear $ fromReq request) mgr `catch` (throwIO . NetworkError) - where clear r = r { checkStatus = \_ _ -> Nothing + where clear r = r { checkStatus = \_ _ _ -> Nothing , responseTimeout = Nothing } timedRequest :: ResourceT IO Event