git.iko.soy/typeable/wai
on master help sign in
log request time
commit51adead0a3a1739011c7c44bcb023b1653d9e290 authorGreg Weber <greg@gregweber.info> dateWed 9 Jul 2014, 21:59 (12 years ago) parente3b8aae
2 files changed+18−11
compare with master
unifiedsplit
wai-extra/Network/Wai/Middleware/RequestLogger.hs+7−4 wai-extra/test/WaiExtraTest.hs+11−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
@@ -152,13 +153,11 @@ rotateColors (c:cs) = (cs ++ [c], c)
152153--
153154-- Example ouput:
154155--
155−-- > GET search
156−-- > Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
156+-- > GET search :: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
157157-- >
158158-- > Status: 200 OK. search
159159-- >
160−-- > GET static/css/normalize.css
161−-- > Accept: text/css,*/*;q=0.1
160+-- > GET static/css/normalize.css :: text/css,*/*;q=0.1
162161-- > GET [("LXwioiBG","")]
163162-- >
164163-- > Status: 304 Not Modified. static/css/normalize.css
@@ -235,11 +234,13 @@ detailedMiddleware' cb getAddColor app req sendResponse = do
235234 , "\n"
236235 ]
237236
237+ t0 <- getCurrentTime
238238 app req' $ \rsp -> do
239239 let isRaw =
240240 case rsp of
241241 ResponseRaw{} -> True
242242 _ -> False
243+ t1 <- getCurrentTime
243244
244245 -- log the status of the response
245246 -- this is color coordinated with the request logging
@@ -249,6 +250,8 @@ detailedMiddleware' cb getAddColor app req sendResponse = do
249250 [ " "
250251 , msgBS rsp
251252 , ". "
253+ , pack $ show $ diffUTCTime t1 t0
254+ , ". "
252255 , rawPathInfo req -- if you need help matching the 2 logging statements
253256 , "\n"
254257 ]
wai-extra/test/WaiExtraTest.hs+11−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
@@ -548,21 +548,25 @@ caseDebugRequestBody = do
548548 where
549549 params = [("foo", "bar"), ("baz", "bin")]
550550 -- FIXME change back once we include post parameter output in logging postOutput = T.pack $ "POST \nAccept: \nPOST " ++ (show params)
551− postOutput = T.pack $ "POST / :: \nStatus: 200 OK. /\n"
552− getOutput params' = T.pack $ "GET /location :: \nGET " ++ show params' ++ "\nStatus: 200 OK. /location\n"
551+ -- the time cannot be known, so match around it
552+ postOutput = ("POST / :: \nStatus: 200 OK. 0.00", "s. /\n")
553+ getOutput params' = ("GET /location :: \nGET " <> T.pack (show params') <> "\nStatus: 200 OK. 0.00", "s. /location\n")
553554
554− debugApp output' req send = do
555+ debugApp (beginning, ending) req send = do
555556 iactual <- I.newIORef mempty
556557 middleware <- mkRequestLogger def
557558 { destination = Callback $ \strs -> I.modifyIORef iactual $ (`mappend` strs)
558559 , outputFormat = Detailed False
559560 }
560561 res <- middleware (\_req f -> f $ responseLBS status200 [ ] "") req send
561− actual <- I.readIORef iactual
562− assertEqual "debug" output $ logToBs actual
562+ actual <- logToBs <$> I.readIORef iactual
563+ actual `shouldSatisfy` S.isPrefixOf begin
564+ actual `shouldSatisfy` S.isSuffixOf end
565+
563566 return res
564567 where
565− output = TE.encodeUtf8 $ T.toStrict output'
568+ begin = TE.encodeUtf8 $ T.toStrict beginning
569+ end = TE.encodeUtf8 $ T.toStrict ending
566570
567571 logToBs = fromLogStr
568572