git.iko.soy/typeable/wai
on master help sign in
show GET and POST params separately, no querystring
f02dcf9Greg Weber
Network/Wai/Middleware/Debug.hs+7−5
compare with master
unifiedsplit
@@ -25,24 +25,26 @@ debug = debugDest $ hPutStrLn stderr . T.unpack
25debugDest :: (T.Text -> IO ()) -> Middleware
25debugDest :: (T.Text -> IO ()) -> Middleware
26debugDest cb app req = do
26debugDest cb app req = do
27 body <- consume
27 body <- consume
28− params <- if any (requestMethod req ==) ["GET", "HEAD"]
28+ postParams <- if any (requestMethod req ==) ["GET", "HEAD"]
29− then return $ map emptyGetParam $ queryString req
29+ then return []
30 else do postParams <- liftIO $ allPostParams req body
30 else do postParams <- liftIO $ allPostParams req body
31 return $ collectPostParams postParams
31 return $ collectPostParams postParams
32− let paramS = if null params then "" else "\n" ++ (show params)
32+ let getParams = map emptyGetParam $ queryString req
33
33
34 liftIO $ cb $ T.pack $ concat
34 liftIO $ cb $ T.pack $ concat
35 [ unpack $ requestMethod req
35 [ unpack $ requestMethod req
36 , " "
36 , " "
37 , unpack $ rawPathInfo req
37 , unpack $ rawPathInfo req
38− , unpack $ rawQueryString req
39 , "\n"
38 , "\n"
40 , (++) "Accept: " $ maybe "" unpack $ lookup "Accept" $ requestHeaders req
39 , (++) "Accept: " $ maybe "" unpack $ lookup "Accept" $ requestHeaders req
41− , paramS
40+ , paramsToStr "GET " getParams
41+ , paramsToStr "POST " postParams
42 ]
42 ]
43 -- we just consumed the body- fill the enumerator back up so it is available again
43 -- we just consumed the body- fill the enumerator back up so it is available again
44 liftIO $ run_ $ enumList 1 body $$ app req
44 liftIO $ run_ $ enumList 1 body $$ app req
45 where
45 where
46+ paramsToStr prefix params = if null params then "" else "\n" ++ prefix ++ (show params)
47+
46 allPostParams req body = run_ $ enumList 1 body $$ parseRequestBody lbsSink req
48 allPostParams req body = run_ $ enumList 1 body $$ parseRequestBody lbsSink req
47
49
48 emptyGetParam :: (S.ByteString, Maybe S.ByteString) -> (S.ByteString, S.ByteString)
50 emptyGetParam :: (S.ByteString, Maybe S.ByteString) -> (S.ByteString, S.ByteString)
runtests.hs+2−2
@@ -406,8 +406,8 @@ caseDebugRequestBody = do
406 }
406 }
407 where
407 where
408 params = [("foo", "bar"), ("baz", "bin")]
408 params = [("foo", "bar"), ("baz", "bin")]
409− postOutput = T.pack $ "POST \nAccept: \n" ++ (show params)
409+ postOutput = T.pack $ "POST \nAccept: \nPOST " ++ (show params)
410− getOutput qs = T.pack $ "GET /location" ++ S8.unpack qs ++ "\nAccept: \n" ++ (show params) -- \nAccept: \n" ++ (show params)
410+ getOutput qs = T.pack $ "GET /location" ++ "\nAccept: \nGET " ++ (show params) -- \nAccept: \n" ++ (show params)
411
411
412 debugApp output = debugDest (\t -> liftIO $ assertEqual "debug" output t) $ \req -> do
412 debugApp output = debugDest (\t -> liftIO $ assertEqual "debug" output t) $ \req -> do
413 return $ responseLBS status200 [ ] ""
413 return $ responseLBS status200 [ ] ""