@@ -1,14 +1,15 @@
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 (..)
1010 , lbsSink
1111 , tempFileSink
12+ , BackEnd (..)
1213 , Param
1314 , File
1415 , FileInfo (..)
@@ -89,24 +90,27 @@ parseHttpAccept = map fst
8990 _ -> 1.0
9091 trimWhite = S.dropWhile (== 32) -- space
9192
92−-- | A destination for data, the opposite of a 'Source'.
93−data Sink x y = Sink
93+-- | A destination for data, with concrete implemtations
94+-- provided by 'lbsSink' and 'tempFileSink'
95+data BackEnd y = forall x . BackEnd
9496 { sinkInit :: IO x
9597 , sinkAppend :: x -> S.ByteString -> IO x
9698 , sinkClose :: x -> IO y
9799 , sinkFinalize :: y -> IO ()
98100 }
99101
100−lbsSink :: Sink ([S.ByteString] -> [S.ByteString]) L.ByteString
101−lbsSink = Sink
102+-- | Store uploaded files in memory
103+lbsSink :: BackEnd L.ByteString
104+lbsSink = BackEnd
102105 { sinkInit = return id
103106 , sinkAppend = \front bs -> return $ front . (:) bs
104107 , sinkClose = \front -> return $ L.fromChunks $ front []
105108 , sinkFinalize = \_ -> return ()
106109 }
107110
108−tempFileSink :: Sink (FilePath, Handle) FilePath
109−tempFileSink = Sink
111+-- | Save uploaded files on disk as temporary files
112+tempFileSink :: BackEnd FilePath
113+tempFileSink = BackEnd
110114 { sinkInit = do
111115 tempDir <- getTemporaryDirectory
112116 openBinaryTempFile tempDir "webenc.buf"
@@ -128,12 +132,12 @@ data FileInfo c = FileInfo
128132type Param = (S.ByteString, S.ByteString)
129133type File y = (S.ByteString, FileInfo y)
130134
131−parseRequestBody :: Sink x y
135+parseRequestBody :: BackEnd y
132136 -> Request
133137 -> C.Sink S.ByteString IO ([Param], [File y])
134138parseRequestBody s r = fmap partitionEithers $ conduitRequestBody s r C.=$ CL.consume
135139
136−conduitRequestBody :: Sink x y
140+conduitRequestBody :: BackEnd y
137141 -> Request
138142 -> C.Conduit S.ByteString IO (Either Param (File y))
139143conduitRequestBody sink req = do
@@ -195,15 +199,16 @@ takeLines = do
195199 ls <- takeLines
196200 return $ l : ls
197201
198−parsePieces :: Sink x y -> S.ByteString
202+parsePieces :: BackEnd y -> S.ByteString
199203 -> C.Conduit S.ByteString IO (Either Param (File y))
200204parsePieces sink bound = C.sequenceSink True (parsePiecesSink sink bound)
201205
202−parsePiecesSink :: Sink x y
206+parsePiecesSink :: BackEnd y
203207 -> S.ByteString
204208 -> C.SequencedSink Bool S.ByteString IO (Either Param (File y))
205209parsePiecesSink _ _ False = return C.Stop
206−parsePiecesSink sink bound True = do
210+parsePiecesSink BackEnd{sinkInit=init,sinkAppend=append,sinkClose=close}
211+ bound True = do
207212 _boundLine <- takeLine
208213 res' <- takeLines
209214 case res' of
@@ -219,10 +224,10 @@ parsePiecesSink sink bound True = do
219224 case x of
220225 Just (mct, name, Just filename) -> do
221226 let ct = fromMaybe "application/octet-stream" mct
222− seed <- liftIO $ sinkInit sink
227+ seed <- liftIO init
223228 (seed', wasFound) <-
224− sinkTillBound bound (sinkAppend sink) seed
225− y <- liftIO $ sinkClose sink seed'
229+ sinkTillBound bound append seed
230+ y <- liftIO $ close seed'
226231 let fi = FileInfo filename ct y
227232 let y' = (name, fi)
228233 return $ C.Emit wasFound [Right y']