wai-extra 3.0.1.2 → 3.0.2

raw patch · 3 files changed

+19/−12 lines, 3 files

Files

• Network/Wai/Middleware/RequestLogger.hs +7/−4
• test/WaiExtraTest.hs +11/−7
• wai-extra.cabal +1/−1

@@ -29,6 +29,7 @@ import Network.HTTP.Types as H import Data.Maybe (fromMaybe) import Data.Monoid (mconcat)+import Data.Time (getCurrentTime, diffUTCTime)  import Network.Wai.Parse (sinkRequestBody, lbsBackEnd, fileName, Param, File, getRequestBodyType) import qualified Data.ByteString.Lazy as LBS@@ -152,13 +153,11 @@ -- -- Example ouput: ----- > GET search--- > Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8+-- > GET search :: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8 -- > -- > Status: 200 OK. search -- >--- > GET static/css/normalize.css--- > Accept: text/css,*/*;q=0.1+-- > GET static/css/normalize.css :: text/css,*/*;q=0.1 -- > GET [("LXwioiBG","")] -- > -- > Status: 304 Not Modified. static/css/normalize.css@@ -235,11 +234,13 @@         , "\n"         ] +    t0 <- getCurrentTime     app req' $ \rsp -> do         let isRaw =                 case rsp of                     ResponseRaw{} -> True                     _ -> False+        t1 <- getCurrentTime          -- log the status of the response         -- this is color coordinated with the request logging@@ -248,6 +249,8 @@             addColor "Status: " ++ statusBS rsp ++             [ " "             , msgBS rsp+            , ". "+            , pack $ show $ diffUTCTime t1 t0             , ". "             , rawPathInfo req -- if you need help matching the 2 logging statements             , "\n"

@@ -3,7 +3,7 @@  import Test.Hspec import Test.HUnit hiding (Test)-import Data.Monoid (mappend, mempty)+import Data.Monoid (mappend, mempty, (<>))  import Network.Wai import Network.Wai.Test@@ -548,21 +548,25 @@   where     params = [("foo", "bar"), ("baz", "bin")]     -- FIXME change back once we include post parameter output in logging postOutput = T.pack $ "POST \nAccept: \nPOST " ++ (show params)-    postOutput = T.pack $ "POST / :: \nStatus: 200 OK. /\n"-    getOutput params' = T.pack $ "GET /location :: \nGET " ++ show params' ++ "\nStatus: 200 OK. /location\n"+    -- the time cannot be known, so match around it+    postOutput = ("POST / :: \nStatus: 200 OK. 0", "s. /\n")+    getOutput params' = ("GET /location :: \nGET " <> T.pack (show params') <> "\nStatus: 200 OK. 0", "s. /location\n") -    debugApp output' req send = do+    debugApp (beginning, ending) req send = do         iactual <- I.newIORef mempty         middleware <- mkRequestLogger def             { destination = Callback $ \strs -> I.modifyIORef iactual $ (`mappend` strs)             , outputFormat = Detailed False             }         res <- middleware (\_req f -> f $ responseLBS status200 [ ] "") req send-        actual <- I.readIORef iactual-        assertEqual "debug" output $ logToBs actual+        actual <- logToBs <$> I.readIORef iactual+        actual `shouldSatisfy` S.isPrefixOf begin+        actual `shouldSatisfy` S.isSuffixOf end+         return res       where-        output = TE.encodeUtf8 $ T.toStrict output'+        begin = TE.encodeUtf8 $ T.toStrict beginning+        end   = TE.encodeUtf8 $ T.toStrict ending          logToBs = fromLogStr 

@@ -1,5 +1,5 @@ Name:                wai-extra-Version:             3.0.1.2+Version:             3.0.2 Synopsis:            Provides some basic WAI handlers and middleware. Description:         The goal here is to provide common features without many dependencies. License:             MIT