packages feed

wai-extra 1.0.0.1 → 1.1.0

raw patch · 7 files changed

+168/−139 lines, 7 filesdep ~blaze-builder-conduitdep ~conduitdep ~fast-loggerPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: blaze-builder-conduit, conduit, fast-logger, wai, zlib-bindings, zlib-conduit

API changes (from Hackage documentation)

- Network.Wai.Middleware.RequestLogger: logHandleDevLT :: (Text -> IO ()) -> Middleware
- Network.Wai.Middleware.RequestLogger: logStdoutDevLT :: Middleware
- Network.Wai.Parse: Sink :: IO x -> (x -> ByteString -> IO x) -> (x -> IO y) -> (y -> IO ()) -> Sink x y
- Network.Wai.Parse: data Sink x y
- Network.Wai.Parse: sinkAppend :: Sink x y -> x -> ByteString -> IO x
- Network.Wai.Parse: sinkClose :: Sink x y -> x -> IO y
- Network.Wai.Parse: sinkFinalize :: Sink x y -> y -> IO ()
- Network.Wai.Parse: sinkInit :: Sink x y -> IO x
+ Network.Wai.Middleware.RequestLogger: logCallback :: (ByteString -> IO ()) -> Middleware
+ Network.Wai.Middleware.RequestLogger: logCallbackDev :: (ByteString -> IO ()) -> Middleware
+ Network.Wai.Parse: BackEnd :: IO x -> (x -> ByteString -> IO x) -> (x -> IO y) -> (y -> IO ()) -> BackEnd y
+ Network.Wai.Parse: Multipart :: ByteString -> RequestBodyType
+ Network.Wai.Parse: UrlEncoded :: RequestBodyType
+ Network.Wai.Parse: append :: BackEnd y -> x -> ByteString -> IO x
+ Network.Wai.Parse: close :: BackEnd y -> x -> IO y
+ Network.Wai.Parse: data BackEnd y
+ Network.Wai.Parse: data RequestBodyType
+ Network.Wai.Parse: finalize :: BackEnd y -> y -> IO ()
+ Network.Wai.Parse: getRequestBodyType :: Request -> Maybe RequestBodyType
+ Network.Wai.Parse: initialize :: BackEnd y -> IO x
+ Network.Wai.Parse: lbsBackEnd :: BackEnd ByteString
+ Network.Wai.Parse: sinkRequestBody :: BackEnd y -> RequestBodyType -> Sink ByteString IO ([Param], [File y])
+ Network.Wai.Parse: tempFileBackEnd :: BackEnd FilePath
- Network.Wai.Parse: conduitRequestBody :: Sink x y -> Request -> Conduit ByteString IO (Either Param (File y))
+ Network.Wai.Parse: conduitRequestBody :: BackEnd y -> RequestBodyType -> Conduit ByteString IO (Either Param (File y))
- Network.Wai.Parse: lbsSink :: Sink ([ByteString] -> [ByteString]) ByteString
+ Network.Wai.Parse: lbsSink :: BackEnd ByteString
- Network.Wai.Parse: parseRequestBody :: Sink x y -> Request -> Sink ByteString IO ([Param], [File y])
+ Network.Wai.Parse: parseRequestBody :: BackEnd y -> Request -> ResourceT IO ([Param], [File y])
- Network.Wai.Parse: tempFileSink :: Sink (FilePath, Handle) FilePath
+ Network.Wai.Parse: tempFileSink :: BackEnd FilePath

Files

Network/Wai/Handler/CGI.hs view
@@ -22,7 +22,7 @@ import Data.Monoid (mconcat, mempty) import Blaze.ByteString.Builder (fromByteString, toLazyByteString) import Blaze.ByteString.Builder.Char8 (fromChar, fromString)-import Data.Conduit.Blaze (builderToByteString)+import Data.Conduit.Blaze (builderToByteStringFlush) import Control.Monad.IO.Class (liftIO) import Data.ByteString.Lazy.Internal (defaultChunkSize) import System.IO (Handle)@@ -117,7 +117,7 @@                 liftIO $ mapM_ outputH $ L.toChunks $ toLazyByteString $ sfBuilder s hs sf fp             _ -> do                 let (s, hs, b) = responseSource res-                    src = CL.sourceList [headers s hs `mappend` fromChar '\n']+                    src = CL.sourceList [C.Chunk $ headers s hs `mappend` fromChar '\n']                           `mappend` b                 src C.$$ builderSink   where@@ -141,11 +141,13 @@         , fromByteString sf         , fromByteString " not supported"         ]-    bsSink = C.Sink $ return $ C.SinkData push (return ())-    push bs = do+    bsSink = C.SinkData push (return ())+    push (C.Chunk bs) = do         liftIO $ outputH bs-        return C.Processing-    builderSink = builderToByteString C.=$ bsSink+        return $ C.Processing push (return ())+    -- FIXME actually flush?+    push C.Flush = return $ C.Processing push (return ())+    builderSink = builderToByteStringFlush C.=$ bsSink     fixHeaders h =         case lookup "content-type" h of             Nothing -> ("Content-Type", "text/html; charset=utf-8") : h@@ -173,8 +175,10 @@ requestBodyFunc get count0 =     C.sourceState count0 pull   where-    pull 0 = return (0, C.Closed)+    pull 0 = return C.StateClosed     pull count = do         mbs <- liftIO $ get $ min count defaultChunkSize         let count' = count - maybe 0 B.length mbs-        return (count', maybe C.Closed C.Open mbs)+        return $ case mbs of+            Nothing -> C.StateClosed+            Just bs -> C.StateOpen count' bs
Network/Wai/Middleware/Gzip.hs view
@@ -35,7 +35,7 @@ import qualified Data.Conduit.Zlib as CZ import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.List as CL-import Data.Conduit.Blaze (builderToByteString)+import Data.Conduit.Blaze (builderToByteStringFlush) import Blaze.ByteString.Builder (fromByteString) import Control.Exception (try, SomeException) @@ -51,8 +51,7 @@     def = GzipSettings GzipIgnore defaultCheckMime  defaultCheckMime :: S.ByteString -> Bool-defaultCheckMime "text/event-stream" = False-defaultCheckMime bs = S8.isPrefixOf "text/" bs+defaultCheckMime = S8.isPrefixOf "text/"  -- | Use gzip to compress the body of the response. --@@ -116,9 +115,9 @@     case lookup "content-type" hs of         Just m | gzipCheckMime set m ->             let hs' = fixHeaders hs-             in ResponseSource s hs' $ b C.$= builderToByteString-                                         C.$= CZ.gzip-                                         C.$= CL.map fromByteString+             in ResponseSource s hs' $ b C.$= builderToByteStringFlush+                                         C.$= CZ.compressFlush 1 (CZ.WindowBits 31)+                                         C.$= CL.map (fmap fromByteString)         _ -> res   where     (s, hs, b) = responseSource res
Network/Wai/Middleware/Jsonp.hs view
@@ -24,6 +24,7 @@ import Control.Monad (join) import Data.Maybe (fromMaybe) import qualified Data.ByteString as S+import qualified Data.Conduit as C import qualified Data.Conduit.List as CL  -- | Wrap json responses in a jsonp callback.@@ -79,9 +80,9 @@      addCallback cb s hs b =         return $ ResponseSource s hs $-            CL.sourceList [copyByteString cb `mappend` fromChar '(']+            CL.sourceList [C.Chunk $ copyByteString cb `mappend` fromChar '(']             `mappend` b-            `mappend` CL.sourceList [fromChar ')']+            `mappend` CL.sourceList [C.Chunk $ fromChar ')']  changeVal :: Eq a           => a
Network/Wai/Middleware/RequestLogger.hs view
@@ -1,11 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} module Network.Wai.Middleware.RequestLogger     ( logStdout-    , logHandle+    , logCallback     , logStdoutDev+    , logCallbackDev+    -- * Deprecated+    , logHandle     , logHandleDev-    , logStdoutDevLT-    , logHandleDevLT     ) where  import System.IO (stdout, hFlush)@@ -15,37 +16,41 @@ import Network.Wai (Request(..), Middleware) import System.Log.FastLogger import Network.HTTP.Types as H-import qualified Data.Text.Lazy as LT-import qualified Data.Text.Encoding as TE -import Network.Wai.Parse (parseRequestBody, lbsSink, fileName, Param, File)+import Network.Wai.Parse (sinkRequestBody, lbsBackEnd, fileName, Param, File, getRequestBodyType) import qualified Data.ByteString.Lazy as LBS-import System.IO (hPutStrLn, stderr)  import qualified Data.Conduit as C import qualified Data.Conduit.List as CL --- | like @logHandle@, but prints to 'stdout'+logHandle :: (BS.ByteString -> IO ()) -> Middleware+logHandle = logCallback+{-# DEPRECATED logHandle "Please use logCallback instead." #-}+logHandleDev :: (BS.ByteString -> IO ()) -> Middleware+logHandleDev = logCallbackDev+{-# DEPRECATED logHandleDev "Please use logCallbackDev instead." #-}++-- | Production request logger middleware.+-- Implemented on top of "logCallback", but prints to 'stdout' logStdout :: Middleware logStdout = logHandle $ \bs -> hPutLogStr stdout [LB bs] --- | like @logHandleDev@, but prints to 'stdout'+-- | Development request logger middleware.+-- Implemented on top of "logCallbackDev", but prints to 'stdout' ----- Note that this flushes 'stdout' on each call to make it useful for--- development. This is very inefficient for production use.+-- Flushes 'stdout' on each request, which would be inefficient in production use.+-- Use "logStdout" in production. logStdoutDev :: Middleware logStdoutDev = logHandleDev $ \bs -> hPutLogStr stdout [LB bs] >> hFlush stdout --- FIXME This is not appropriately named at all. It's not working on a Handle,--- it's working on a function. I find the functions in this module to be very--- confusing.--- - Michael- -- | Prints a message using the given callback function for each request. -- Designed for fast production use at the expense of convenience. -- In particular, no POST parameter information is currently given-logHandle :: (BS.ByteString -> IO ()) -> Middleware-logHandle cb app req = do+--+-- This is lower-level - use "logStdout" unless you need this greater control+logCallback :: (BS.ByteString -> IO ()) -- ^ A function that logs the ByteString log message.+            -> Middleware+logCallback cb app req = do     liftIO $ cb $ BS.concat         [ requestMethod req         , " "@@ -61,32 +66,18 @@ toBS :: H.Ascii -> BS.ByteString toBS = id --- FIXME: What's the purpose of this function? Why would it ever be preferable--- to logStdoutDev? And why is it implemented via unpack instead of using a--- more efficient Data.Text.IO function?--- - Michael---- | Inefficient, but convenient Development load logger middleware--- Prints a message to 'stderr' for each request using logHandleDevLT-logStdoutDevLT :: Middleware-logStdoutDevLT = logHandleDevLT $ hPutStrLn stderr . LT.unpack---- | logHandleDev, but expects Lazy Text instead of a ByteString-logHandleDevLT :: (LT.Text -> IO ()) -> Middleware-logHandleDevLT cb app req =-    logHandleDev (\msg -> cb $ LT.fromStrict $ TE.decodeUtf8 msg) app req- -- | Prints a message using the given callback function for each request. -- This is not for serious production use- it is inefficient. -- It immediately consumes a POST body and fills it back in and is otherwise inefficient ----- Note that this function will not flush output.-logHandleDev :: (BS.ByteString -> IO ()) -> Middleware-logHandleDev cb app req = do+-- This is lower-level - use "logStdoutDev" unless you need this greater control+logCallbackDev :: (BS.ByteString -> IO ()) -- ^ A function that logs the ByteString log message.+               -> Middleware+logCallbackDev cb app req = do     body <- requestBody req C.$$ CL.consume     postParams <- if any (requestMethod req ==) ["GET", "HEAD"]       then return []-      else do postParams <- liftIO $ allPostParams req body+      else do postParams <- liftIO $ allPostParams body               return $ collectPostParams postParams     let getParams = map emptyGetParam $ queryString req @@ -101,14 +92,17 @@         , paramsToBS "POST " postParams         , "\n"         ]-    -- we just consumed the body- fill the enumerator back up so it is available again+    -- The body was consumed. Fill it back up so it is available again     app req { requestBody = CL.sourceList body }   where     paramsToBS prefix params =       if null params then ""         else BS.concat ["\n", prefix, pack (show params)] -    allPostParams req' body = C.runResourceT $ CL.sourceList body C.$$ parseRequestBody lbsSink req'+    allPostParams body =+        case getRequestBodyType req of+            Nothing -> return ([], [])+            Just rbt -> C.runResourceT $ CL.sourceList body C.$$ sinkRequestBody lbsBackEnd rbt      emptyGetParam :: (BS.ByteString, Maybe BS.ByteString) -> (BS.ByteString, BS.ByteString)     emptyGetParam (k, Just v) = (k,v)
Network/Wai/Parse.hs view
@@ -1,17 +1,24 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ExistentialQuantification #-} -- | Some helpers for parsing data out of a raw WAI 'Request'.  module Network.Wai.Parse     ( parseHttpAccept     , parseRequestBody+    , RequestBodyType (..)+    , getRequestBodyType+    , sinkRequestBody     , conduitRequestBody-    , Sink (..)-    , lbsSink-    , tempFileSink+    , lbsBackEnd+    , tempFileBackEnd+    , BackEnd (..)     , Param     , File     , FileInfo (..)+    -- ** Deprecated+    , lbsSink+    , tempFileSink #if TEST     , Bound (..)     , findBound@@ -31,7 +38,7 @@ import Data.List (sortBy) import Data.Function (on) import System.Directory (removeFile, getTemporaryDirectory)-import System.IO (hClose, openBinaryTempFile, Handle)+import System.IO (hClose, openBinaryTempFile) import Network.Wai import qualified Data.Conduit as C import qualified Data.Conduit.List as CL@@ -89,34 +96,48 @@                 _ -> 1.0     trimWhite = S.dropWhile (== 32) -- space --- | A destination for data, the opposite of a 'Source'.-data Sink x y = Sink-    { sinkInit :: IO x-    , sinkAppend :: x -> S.ByteString -> IO x-    , sinkClose :: x -> IO y-    , sinkFinalize :: y -> IO ()+-- | A destination for file data, with concrete implemtations+-- provided by 'lbsBackEnd' and 'tempFileBackEnd'+data BackEnd y = forall x . BackEnd+    { initialize :: IO x+    , append :: x -> S.ByteString -> IO x+    , close :: x -> IO y+    , finalize :: y -> IO ()     } -lbsSink :: Sink ([S.ByteString] -> [S.ByteString]) L.ByteString-lbsSink = Sink-    { sinkInit = return id-    , sinkAppend = \front bs -> return $ front . (:) bs-    , sinkClose = \front -> return $ L.fromChunks $ front []-    , sinkFinalize = \_ -> return ()+-- | Store uploaded files in memory+lbsBackEnd :: BackEnd L.ByteString+lbsBackEnd = BackEnd+    { initialize = return id+    , append = \front bs -> return $ front . (:) bs+    , close = \front -> return $ L.fromChunks $ front []+    , finalize = \_ -> return ()     } -tempFileSink :: Sink (FilePath, Handle) FilePath-tempFileSink = Sink-    { sinkInit = do+-- | Save uploaded files on disk as temporary files+tempFileBackEnd :: BackEnd FilePath+tempFileBackEnd = BackEnd+    { initialize = do         tempDir <- getTemporaryDirectory         openBinaryTempFile tempDir "webenc.buf"-    , sinkAppend = \(fp, h) bs -> S.hPut h bs >> return (fp, h)-    , sinkClose = \(fp, h) -> do+    , append = \(fp, h) bs -> S.hPut h bs >> return (fp, h)+    , close = \(fp, h) -> do         hClose h         return fp-    , sinkFinalize = \fp -> removeFile fp+    , finalize = \fp -> removeFile fp     } +-- | This function has been renamed to 'lbsBackEnd'+lbsSink :: BackEnd L.ByteString+lbsSink = lbsBackEnd++-- | This function has been renamed to  'tempFileBackEnd'+tempFileSink :: BackEnd FilePath+tempFileSink = tempFileBackEnd++{-# DEPRECATED lbsSink "Please use 'lbsBackEnd'" #-}+{-# DEPRECATED tempFileSink "Please use 'tempFileBackEnd'" #-}+ -- | Information on an uploaded file. data FileInfo c = FileInfo     { fileName :: S.ByteString@@ -128,29 +149,16 @@ type Param = (S.ByteString, S.ByteString) type File y = (S.ByteString, FileInfo y) -parseRequestBody :: Sink x y-                 -> Request-                 -> C.Sink S.ByteString IO ([Param], [File y])-parseRequestBody s r = fmap partitionEithers $ conduitRequestBody s r C.=$ CL.consume+data RequestBodyType = UrlEncoded | Multipart S.ByteString -conduitRequestBody :: Sink x y-                   -> Request-                   -> C.Conduit S.ByteString IO (Either Param (File y))-conduitRequestBody sink req = do-    case ctype of-        Nothing -> C.Conduit $ return $ C.PreparedConduit-            { C.conduitPush = \bs -> return $ C.Finished (Just bs) []-            , C.conduitClose = return []-            }-        Just Nothing -> C.sequenceSink () $ \() -> do -- url-encoded-            -- NOTE: in general, url-encoded data will be in a single chunk.-            -- Therefore, I'm optimizing for the usual case by sticking with-            -- strict byte strings here.-            bs <- CL.consume-            return $ C.Emit () $ map Left $ H.parseSimpleQuery $ S.concat bs-        Just (Just bound) -> -- multi-part-            let bound'' = S8.pack "--" `S.append` bound-             in parsePieces sink bound''+getRequestBodyType :: Request -> Maybe RequestBodyType+getRequestBodyType req = do+    ctype <- lookup "Content-Type" $ requestHeaders req+    if urlenc `S.isPrefixOf` ctype+        then Just UrlEncoded+        else case boundary ctype of+                Just x -> Just $ Multipart x+                Nothing -> Nothing   where     urlenc = S8.pack "application/x-www-form-urlencoded"     formBound = S8.pack "multipart/form-data;"@@ -163,26 +171,44 @@                         then Just $ S.drop (S.length bound') s'                         else Nothing             else Nothing-    ctype = do-      ctype' <- lookup "Content-Type" $ requestHeaders req-      if urlenc `S.isPrefixOf` ctype'-          then Just Nothing-          else case boundary ctype' of-                Just x -> Just $ Just x-                Nothing -> Nothing +parseRequestBody :: BackEnd y+                 -> Request+                 -> C.ResourceT IO ([Param], [File y])+parseRequestBody s r =+    case getRequestBodyType r of+        Nothing -> return ([], [])+        Just rbt -> fmap partitionEithers $ requestBody r C.$$ conduitRequestBody s rbt C.=$ CL.consume++sinkRequestBody :: BackEnd y+                -> RequestBodyType+                -> C.Sink S.ByteString IO ([Param], [File y])+sinkRequestBody s r = fmap partitionEithers $ conduitRequestBody s r C.=$ CL.consume++conduitRequestBody :: BackEnd y+                   -> RequestBodyType+                   -> C.Conduit S.ByteString IO (Either Param (File y))+conduitRequestBody _ UrlEncoded = C.sequenceSink () $ \() -> do -- url-encoded+    -- NOTE: in general, url-encoded data will be in a single chunk.+    -- Therefore, I'm optimizing for the usual case by sticking with+    -- strict byte strings here.+    bs <- CL.consume+    return $ C.Emit () $ map Left $ H.parseSimpleQuery $ S.concat bs+conduitRequestBody backend (Multipart bound) =+    parsePieces backend $ S8.pack "--" `S.append` bound+ takeLine :: C.Sink S.ByteString IO (Maybe S.ByteString) takeLine =-    C.sinkState id push close+    C.sinkState id push close'   where-    close _ = return Nothing+    close' _ = return Nothing     push front bs = do         let (x, y) = S.break (== 10) $ front bs -- LF          in if S.null y-                then return (S.append x, C.Processing)+                then return $ C.StateProcessing $ S.append x                 else do                     let lo = if S.length y > 1 then Just (S.drop 1 y) else Nothing-                    return (error "takeLine", C.Done lo $ Just $ killCR x)+                    return $ C.StateDone lo $ Just $ killCR x  takeLines :: C.Sink S.ByteString IO [S.ByteString] takeLines = do@@ -195,15 +221,16 @@                 ls <- takeLines                 return $ l : ls -parsePieces :: Sink x y -> S.ByteString+parsePieces :: BackEnd y -> S.ByteString             -> C.Conduit S.ByteString IO (Either Param (File y)) parsePieces sink bound = C.sequenceSink True (parsePiecesSink sink bound) -parsePiecesSink :: Sink x y+parsePiecesSink :: BackEnd y                 -> S.ByteString                 -> C.SequencedSink Bool S.ByteString IO (Either Param (File y)) parsePiecesSink _ _ False = return C.Stop-parsePiecesSink sink bound True = do+parsePiecesSink BackEnd{initialize=initialize',append=append',close=close'}+                bound True = do     _boundLine <- takeLine     res' <- takeLines     case res' of@@ -219,10 +246,10 @@             case x of                 Just (mct, name, Just filename) -> do                     let ct = fromMaybe "application/octet-stream" mct-                    seed <- liftIO $ sinkInit sink+                    seed <- liftIO initialize'                     (seed', wasFound) <--                        sinkTillBound bound (sinkAppend sink) seed-                    y <- liftIO $ sinkClose sink seed'+                        sinkTillBound bound append' seed+                    y <- liftIO $ close' seed'                     let fi = FileInfo filename ct y                     let y' = (name, fi)                     return $ C.Emit wasFound [Right y']@@ -276,9 +303,9 @@ sinkTillBound bound iter seed0 = C.sinkState     (id, seed0)     push-    close+    close'   where-    close (front, seed) = do+    close' (front, seed) = do         seed' <- liftIO $ iter seed $ front S.empty         return (seed', False)     push (front, seed) bs' = do@@ -287,7 +314,7 @@             FoundBound before after -> do                 let before' = killCRLF before                 seed' <- liftIO $ iter seed before'-                return (undefined, C.Done (Just after) (seed', True))+                return $ C.StateDone (Just after) (seed', True)             NoBound -> do                 -- don't emit newlines, in case it's part of a bound                 let (toEmit, front') =@@ -296,8 +323,8 @@                                   in (x, S.append y)                             else (bs, id)                 seed' <- liftIO $ iter seed toEmit-                return ((front', seed'), C.Processing)-            PartialBound -> return ((S.append bs, seed), C.Processing)+                return $ C.StateProcessing (front', seed')+            PartialBound -> return $ C.StateProcessing (S.append bs, seed)  parseAttrs :: S.ByteString -> [(S.ByteString, S.ByteString)] parseAttrs = map go . S.split 59 -- semicolon
test/WaiExtraTest.hs view
@@ -22,7 +22,7 @@ import Network.Wai.Middleware.Autohead import Network.Wai.Middleware.MethodOverride import Network.Wai.Middleware.AcceptOverride-import Network.Wai.Middleware.RequestLogger (logHandle)+import Network.Wai.Middleware.RequestLogger (logCallback) import Codec.Compression.GZip (decompress)  import qualified Data.Conduit as C@@ -96,11 +96,13 @@         expected = ["text/html", "text/x-c", "text/x-dvi", "text/plain"]     expected @=? parseHttpAccept input -parseRequestBody' :: Sink ([S8.ByteString] -> [S8.ByteString]) L.ByteString+parseRequestBody' :: BackEnd L.ByteString                   -> SRequest                   -> C.ResourceT IO ([(S.ByteString, S.ByteString)], [(S.ByteString, FileInfo L.ByteString)]) parseRequestBody' sink (SRequest req bod) =-    CL.sourceList (L.toChunks bod) C.$$ parseRequestBody sink req+    case getRequestBodyType req of+        Nothing -> return ([], [])+        Just rbt -> CL.sourceList (L.toChunks bod) C.$$ sinkRequestBody sink rbt  caseParseRequestBody :: Assertion caseParseRequestBody =@@ -126,13 +128,13 @@     t = do         let content1 = "foo=bar&baz=bin"         let ctype1 = "application/x-www-form-urlencoded"-        result1 <- parseRequestBody' lbsSink $ toRequest ctype1 content1+        result1 <- parseRequestBody' lbsBackEnd $ toRequest ctype1 content1         liftIO $ assertEqual "parsing post x-www-form-urlencoded"                     (map (S8.pack *** S8.pack) [("foo", "bar"), ("baz", "bin")], [])                     result1          let ctype2 = "multipart/form-data; boundary=AaB03x"-        result2 <- parseRequestBody' lbsSink $ toRequest ctype2 content2+        result2 <- parseRequestBody' lbsBackEnd $ toRequest ctype2 content2         let expectedsmap2 =               [ ("title", "A File")               , ("summary", "This is my file\nfile test")@@ -147,7 +149,7 @@                     result2          let ctype3 = "multipart/form-data; boundary=----WebKitFormBoundaryB1pWXPZ6lNr8RiLh"-        result3 <- parseRequestBody' lbsSink $ toRequest ctype3 content3+        result3 <- parseRequestBody' lbsBackEnd $ toRequest ctype3 content3         let expectedsmap3 = []         let expectedfile3 = [(S8.pack "yaml", FileInfo (S8.pack "README") (S8.pack "application/octet-stream") $                                 L8.pack "Photo blog using Hack.\n")]@@ -156,12 +158,12 @@                     expected3                     result3 -        result2' <- parseRequestBody' lbsSink $ toRequest' ctype2 content2+        result2' <- parseRequestBody' lbsBackEnd $ toRequest' ctype2 content2         liftIO $ assertEqual "parsing post multipart/form-data 2"                     expected2                     result2' -        result3' <- parseRequestBody' lbsSink $ toRequest' ctype3 content3+        result3' <- parseRequestBody' lbsBackEnd $ toRequest' ctype3 content3         liftIO $ assertEqual "parsing actual post multipart/form-data 2"                     expected3                     result3'@@ -399,8 +401,11 @@     let request' = defaultRequest             { requestHeaders = headers             }-    (params, files) <- C.runResourceT $ sourceFile "test/requests/dalvik-request"-                       C.$$ parseRequestBody lbsSink request'+    (params, files) <-+        case getRequestBodyType request' of+            Nothing -> return ([], [])+            Just rbt -> C.runResourceT $ sourceFile "test/requests/dalvik-request"+                       C.$$ sinkRequestBody lbsBackEnd rbt     lookup "scannedTime" params @?= Just "1.298590056748E9"     lookup "geoLong" params @?= Just "0"     lookup "geoLat" params @?= Just "0"@@ -429,7 +434,7 @@     -- FIXME getOutput _qs = T.pack $ "GET /location" ++ "\nAccept: \nGET " ++ (show params) -- \nAccept: \n" ++ (show params)     getOutput _qs = T.pack $ "GET /location?foo=bar&baz=bin Accept: \n" -    debugApp output' = logHandle (\t -> liftIO $ assertEqual "debug" output t) $ \_req -> do+    debugApp output' = logCallback (\t -> liftIO $ assertEqual "debug" output t) $ \_req -> do         return $ responseLBS status200 [ ] ""       where         output = TE.encodeUtf8 $ T.toStrict output'
wai-extra.cabal view
@@ -1,5 +1,5 @@ Name:                wai-extra-Version:             1.0.0.1+Version:             1.1.0 Synopsis:            Provides some basic WAI handlers and middleware. Description:         The goal here is to provide common features without many dependencies. License:             BSD3@@ -22,22 +22,21 @@ Library   Build-Depends:     base                      >= 4 && < 5                    , bytestring                >= 0.9.1.4  && < 0.10-                   , wai                       >= 1.0      && < 1.1+                   , wai                       >= 1.1      && < 1.2                    , old-locale                >= 1.0.0.2  && < 1.1                    , time                      >= 1.1.4                    , network                   >= 2.2.1.5  && < 2.4                    , directory                 >= 1.0.1    && < 1.2-                   , zlib-bindings             >= 0.0      && < 0.1                    , transformers              >= 0.2.2    && < 0.3                    , blaze-builder             >= 0.2.1.4  && < 0.4                    , http-types                >= 0.6      && < 0.7                    , text                      >= 0.7      && < 0.12                    , case-insensitive          >= 0.2                    , data-default              >= 0.3      && < 0.4-                   , fast-logger                >= 0.0.1-                   , conduit-                   , zlib-conduit              >= 0.0.1-                   , blaze-builder-conduit     >= 0.0.1+                   , fast-logger               >= 0.0.2+                   , conduit                   >= 0.2+                   , zlib-conduit              >= 0.2+                   , blaze-builder-conduit     >= 0.2    Exposed-modules:   Network.Wai.Handler.CGI                      Network.Wai.Middleware.AcceptOverride