git.iko.soy/typeable/wai
on master help sign in
Debug outputs POST parameters
commit29076d018b0cc159c3ccf3050350e4b7469f2c6c authorMichael Snoyman <michael@snoyman.com> dateFri 15 Jul 2011, 09:22 (15 years ago) parent14f33d1
2 files changed+37−4
compare with master
unifiedsplit
Network/Wai/Middleware/Debug.hs+19−4 runtests.hs+18
Network/Wai/Middleware/Debug.hs+19−4
@@ -1,15 +1,28 @@
11{-# LANGUAGE OverloadedStrings #-}
2−module Network.Wai.Middleware.Debug (debug) where
2+module Network.Wai.Middleware.Debug
3+ ( debug
4+ , debugDest
5+ ) where
36
47import Network.Wai (Middleware, requestMethod, requestHeaders, rawPathInfo, rawQueryString)
8+import Network.Wai.Parse (parseRequestBody, lbsSink, fileName)
59import Data.ByteString.Char8 (unpack)
610import System.IO (hPutStrLn, stderr)
711import Control.Monad.IO.Class (liftIO)
12+import qualified Data.Text.Lazy as T
13+import Data.Enumerator (run_, ($$), enumList)
14+import Data.Enumerator.List (consume)
815
916-- | Prints a message to 'stderr' for each request.
1017debug :: Middleware
11−debug app req = do
12− liftIO $ hPutStrLn stderr $ concat
18+debug = debugDest $ hPutStrLn stderr . T.unpack
19+
20+-- | Prints a message using the given callback function for each request.
21+debugDest :: (T.Text -> IO ()) -> Middleware
22+debugDest cb app req = do
23+ body <- consume
24+ (params, files) <- liftIO $ run_ $ enumList 1 body $$ parseRequestBody lbsSink req
25+ liftIO $ cb $ T.pack $ concat
1326 [ unpack $ requestMethod req
1427 , " "
1528 , unpack $ rawPathInfo req
@@ -17,5 +30,7 @@ debug app req = do
1730 , "\n"
1831 , (++) "Accept: " $ maybe "" unpack $ lookup "Accept" $ requestHeaders req
1932 , "\n"
33+ , if null params then "" else "Post parameters: " ++ show params ++ "\n"
34+ , if null files then "" else "Post file names: " ++ show (map (fileName . snd) files) ++ "\n"
2035 ]
21− app req
36+ liftIO $ run_ $ enumList 1 body $$ app req
runtests.hs+18
@@ -18,6 +18,7 @@ import Network.Wai.Middleware.Vhost
1818import Network.Wai.Middleware.Autohead
1919import Network.Wai.Middleware.MethodOverride
2020import Network.Wai.Middleware.AcceptOverride
21+import Network.Wai.Middleware.Debug (debug)
2122import Codec.Compression.GZip (decompress)
2223
2324import Data.Enumerator (run_, enumList, ($$), Iteratee)
@@ -48,6 +49,7 @@ testSuite = testGroup "Network.Wai.Parse"
4849 , testCase "method override" caseMethodOverride
4950 , testCase "accept override" caseAcceptOverride
5051 , testCase "dalvik multipart" caseDalvikMultipart
52+ , testCase "debug request body" caseDebugRequestBody
5153 ]
5254
5355caseParseQueryString :: Assertion
@@ -160,6 +162,9 @@ caseParseRequestBody = run_ t where
160162toRequest :: S8.ByteString -> S8.ByteString -> SRequest
161163toRequest ctype content = SRequest (Request
162164 { requestHeaders = [("Content-Type", ctype)]
165+ , requestMethod = "POST"
166+ , rawPathInfo = ""
167+ , rawQueryString = ""
163168 }) (L.fromChunks [content])
164169
165170toRequest' :: S8.ByteString -> S8.ByteString -> SRequest
@@ -376,3 +381,16 @@ caseDalvikMultipart = do
376381 lookup "geoLong" params @?= Just "0"
377382 lookup "geoLat" params @?= Just "0"
378383 length files @?= 1
384+
385+caseDebugRequestBody :: Assertion
386+caseDebugRequestBody = flip runSession debugApp $ do
387+ let req = toRequest "application/x-www-form-urlencoded" "foo=bar&baz=bin"
388+ res <- srequest req
389+ assertStatus 200 res
390+ assertHeader "Parsed" (S8.pack $ show ([("foo", "bar"), ("baz", "bin")], [] :: [Int])) res
391+
392+debugApp = debug $ \req -> do
393+ x <- parseRequestBody lbsSink req
394+ return $ responseLBS status200
395+ [ ("Parsed", S8.pack $ show x)
396+ ] ""