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 +12/−8
- Network/Wai/Middleware/Gzip.hs +5/−6
- Network/Wai/Middleware/Jsonp.hs +3/−2
- Network/Wai/Middleware/RequestLogger.hs +33/−39
- Network/Wai/Parse.hs +93/−66
- test/WaiExtraTest.hs +16/−11
- wai-extra.cabal +6/−7
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