on master help sign in
log request time

Conflicts: wai-extra/Network/Wai/Middleware/RequestLogger.hs wai-extra/test/WaiExtraTest.hs

commit2acbdb4fbc041975c1d62107e12584bfce1feb30 authorGreg Weber <greg@gregweber.info> dateWed 9 Jul 2014, 21:59 (12 years ago) parent46b5809
2 files changed+19−11
wai-extra/Network/Wai/Middleware/RequestLogger.hs+7−4 wai-extra/test/WaiExtraTest.hs+12−7
wai-extra/Network/Wai/Middleware/RequestLogger.hs+7−4
@@ -29,6 +29,7 @@ import System.Log.FastLogger
2929import Network.HTTP.Types as H
3030import Data.Maybe (fromMaybe)
3131import Data.Monoid (mconcat)
32+import Data.Time (getCurrentTime, diffUTCTime)
3233
3334import Network.Wai.Parse (sinkRequestBody, lbsBackEnd, fileName, Param, File, getRequestBodyType)
3435import qualified Data.ByteString.Lazy as LBS
@@ -155,13 +156,11 @@ rotateColors (c:cs) = (cs ++ [c], c)
155156--
156157-- Example ouput:
157158--
158−-- > GET search
159−-- > Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
159+-- > GET search :: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
160160-- >
161161-- > Status: 200 OK. search
162162-- >
163−-- > GET static/css/normalize.css
164−-- > Accept: text/css,*/*;q=0.1
163+-- > GET static/css/normalize.css :: text/css,*/*;q=0.1
165164-- > GET [("LXwioiBG","")]
166165-- >
167166-- > Status: 304 Not Modified. static/css/normalize.css
@@ -237,7 +236,9 @@ detailedMiddleware' cb getAddColor app req = do
237236 , "\n"
238237 ]
239238
239+ t0 <- getCurrentTime
240240 rsp <- app req'
241+ t1 <- getCurrentTime
241242
242243 -- log the status of the response
243244 -- this is color coordinated with the request logging
@@ -247,6 +248,8 @@ detailedMiddleware' cb getAddColor app req = do
247248 [ " "
248249 , msgBS rsp
249250 , ". "
251+ , pack $ show $ diffUTCTime t1 t0
252+ , ". "
250253 , rawPathInfo req -- if you need help matching the 2 logging statements
251254 , "\n"
252255 ]
wai-extra/test/WaiExtraTest.hs+12−7
@@ -3,7 +3,7 @@ module WaiExtraTest (specs) where
33
44import Test.Hspec
55import Test.HUnit hiding (Test)
6−import Data.Monoid (mappend, mempty)
6+import Data.Monoid (mappend, mempty, (<>))
77
88import Network.Wai
99import Network.Wai.Test
@@ -545,21 +545,26 @@ caseDebugRequestBody = do
545545 where
546546 params = [("foo", "bar"), ("baz", "bin")]
547547 -- FIXME change back once we include post parameter output in logging postOutput = T.pack $ "POST \nAccept: \nPOST " ++ (show params)
548− postOutput = T.pack $ "POST / :: \nStatus: 200 OK. /\n"
549− getOutput params' = T.pack $ "GET /location :: \nGET " ++ show params' ++ "\nStatus: 200 OK. /location\n"
548+ -- the time cannot be known, so match around it
549+ postOutput = ("POST / :: \nStatus: 200 OK. 0.00", "s. /\n")
550+ getOutput params' = ("GET /location :: \nGET " <> T.pack (show params') <> "\nStatus: 200 OK. 0.00", "s. /location\n")
550551
551− debugApp output' req = do
552+ debugApp (beginning, ending) req = do
552553 iactual <- liftIO $ I.newIORef mempty
553554 middleware <- liftIO $ mkRequestLogger def
554555 { destination = Callback $ \strs -> I.modifyIORef iactual $ (`mappend` strs)
555556 , outputFormat = Detailed False
556557 }
557558 res <- middleware (\_req -> return $ responseLBS status200 [ ] "") req
558− actual <- liftIO $ I.readIORef iactual
559− liftIO $ assertEqual "debug" output $ logToBs actual
559+ actual <- logToBs <$> liftIO (I.readIORef iactual)
560+ liftIO $ do
561+ actual `shouldSatisfy` S.isPrefixOf begin
562+ actual `shouldSatisfy` S.isSuffixOf end
563+
560564 return res
561565 where
562− output = TE.encodeUtf8 $ T.toStrict output'
566+ begin = TE.encodeUtf8 $ T.toStrict beginning
567+ end = TE.encodeUtf8 $ T.toStrict ending
563568
564569 logToBs = fromLogStr
565570