@@ -1,17 +1,21 @@
11{-# LANGUAGE CPP #-}
22{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE ExistentialQuantification #-}
34-- | Some helpers for parsing data out of a raw WAI 'Request'.
45
56module Network.Wai.Parse
67 ( parseHttpAccept
78 , parseRequestBody
89 , conduitRequestBody
9− , Sink (..)
10− , lbsSink
11− , tempFileSink
10+ , lbsBackEnd
11+ , tempFileBackEnd
12+ , BackEnd (..)
1213 , Param
1314 , File
1415 , FileInfo (..)
16+ -- ** Deprecated
17+ , lbsSink
18+ , tempFileSink
1519#if TEST
1620 , Bound (..)
1721 , findBound
@@ -89,34 +93,48 @@ parseHttpAccept = map fst
8993 _ -> 1.0
9094 trimWhite = S.dropWhile (== 32) -- space
9195
92−-- | A destination for data, the opposite of a 'Source'.
93−data Sink x y = Sink
94− { sinkInit :: IO x
95− , sinkAppend :: x -> S.ByteString -> IO x
96− , sinkClose :: x -> IO y
97− , sinkFinalize :: y -> IO ()
96+-- | A destination for file data, with concrete implemtations
97+-- provided by 'lbsBackEnd' and 'tempFileBackEnd'
98+data BackEnd y = forall x . BackEnd
99+ { initialize :: IO x
100+ , append :: x -> S.ByteString -> IO x
101+ , close :: x -> IO y
102+ , finalize :: y -> IO ()
98103 }
99104
100−lbsSink :: Sink ([S.ByteString] -> [S.ByteString]) L.ByteString
101−lbsSink = Sink
102− { sinkInit = return id
103− , sinkAppend = \front bs -> return $ front . (:) bs
104− , sinkClose = \front -> return $ L.fromChunks $ front []
105− , sinkFinalize = \_ -> return ()
105+-- | Store uploaded files in memory
106+lbsBackEnd :: BackEnd L.ByteString
107+lbsBackEnd = BackEnd
108+ { initialize = return id
109+ , append = \front bs -> return $ front . (:) bs
110+ , close = \front -> return $ L.fromChunks $ front []
111+ , finalize = \_ -> return ()
106112 }
107113
108−tempFileSink :: Sink (FilePath, Handle) FilePath
109−tempFileSink = Sink
110− { sinkInit = do
114+-- | Save uploaded files on disk as temporary files
115+tempFileBackEnd :: BackEnd FilePath
116+tempFileBackEnd = BackEnd
117+ { initialize = do
111118 tempDir <- getTemporaryDirectory
112119 openBinaryTempFile tempDir "webenc.buf"
113− , sinkAppend = \(fp, h) bs -> S.hPut h bs >> return (fp, h)
114− , sinkClose = \(fp, h) -> do
120+ , append = \(fp, h) bs -> S.hPut h bs >> return (fp, h)
121+ , close = \(fp, h) -> do
115122 hClose h
116123 return fp
117− , sinkFinalize = \fp -> removeFile fp
124+ , finalize = \fp -> removeFile fp
118125 }
119126
127+-- | This function has been renamed to 'lbsBackEnd'
128+lbsSink :: BackEnd L.ByteString
129+lbsSink = lbsBackEnd
130+
131+-- | This function has been renamed to 'tempFileBackEnd'
132+tempFileSink :: BackEnd FilePath
133+tempFileSink = tempFileBackEnd
134+
135+{-# DEPRECATED lbsSink "Please use 'lbsBackEnd'" #-}
136+{-# DEPRECATED tempFileSink "Please use 'tempFileBackEnd'" #-}
137+
120138-- | Information on an uploaded file.
121139data FileInfo c = FileInfo
122140 { fileName :: S.ByteString
@@ -128,12 +146,12 @@ data FileInfo c = FileInfo
128146type Param = (S.ByteString, S.ByteString)
129147type File y = (S.ByteString, FileInfo y)
130148
131−parseRequestBody :: Sink x y
149+parseRequestBody :: BackEnd y
132150 -> Request
133151 -> C.Sink S.ByteString IO ([Param], [File y])
134152parseRequestBody s r = fmap partitionEithers $ conduitRequestBody s r C.=$ CL.consume
135153
136−conduitRequestBody :: Sink x y
154+conduitRequestBody :: BackEnd y
137155 -> Request
138156 -> C.Conduit S.ByteString IO (Either Param (File y))
139157conduitRequestBody sink req = do
@@ -173,9 +191,9 @@ conduitRequestBody sink req = do
173191
174192takeLine :: C.Sink S.ByteString IO (Maybe S.ByteString)
175193takeLine =
176− C.sinkState id push close
194+ C.sinkState id push close'
177195 where
178− close _ = return Nothing
196+ close' _ = return Nothing
179197 push front bs = do
180198 let (x, y) = S.break (== 10) $ front bs -- LF
181199 in if S.null y
@@ -195,15 +213,16 @@ takeLines = do
195213 ls <- takeLines
196214 return $ l : ls
197215
198−parsePieces :: Sink x y -> S.ByteString
216+parsePieces :: BackEnd y -> S.ByteString
199217 -> C.Conduit S.ByteString IO (Either Param (File y))
200218parsePieces sink bound = C.sequenceSink True (parsePiecesSink sink bound)
201219
202−parsePiecesSink :: Sink x y
220+parsePiecesSink :: BackEnd y
203221 -> S.ByteString
204222 -> C.SequencedSink Bool S.ByteString IO (Either Param (File y))
205223parsePiecesSink _ _ False = return C.Stop
206−parsePiecesSink sink bound True = do
224+parsePiecesSink BackEnd{initialize=initialize',append=append',close=close'}
225+ bound True = do
207226 _boundLine <- takeLine
208227 res' <- takeLines
209228 case res' of
@@ -219,10 +238,10 @@ parsePiecesSink sink bound True = do
219238 case x of
220239 Just (mct, name, Just filename) -> do
221240 let ct = fromMaybe "application/octet-stream" mct
222− seed <- liftIO $ sinkInit sink
241+ seed <- liftIO initialize'
223242 (seed', wasFound) <-
224− sinkTillBound bound (sinkAppend sink) seed
225− y <- liftIO $ sinkClose sink seed'
243+ sinkTillBound bound append' seed
244+ y <- liftIO $ close' seed'
226245 let fi = FileInfo filename ct y
227246 let y' = (name, fi)
228247 return $ C.Emit wasFound [Right y']
@@ -276,9 +295,9 @@ sinkTillBound :: S.ByteString
276295sinkTillBound bound iter seed0 = C.sinkState
277296 (id, seed0)
278297 push
279− close
298+ close'
280299 where
281− close (front, seed) = do
300+ close' (front, seed) = do
282301 seed' <- liftIO $ iter seed $ front S.empty
283302 return (seed', False)
284303 push (front, seed) bs' = do