2d2582c · typeable/wai

wai-app-static/wai-app-static.cabal+4−4

@@ -1,5 +1,5 @@

11name: wai-app-static

2−version: 1.2.0.3

2+version: 1.3.0

33license: MIT

44license-file: LICENSE

55author: Michael Snoyman <michael@snoyman.com>

@@ -24,7 +24,7 @@ Flag print

2424

2525library

2626 build-depends: base >= 4 && < 5

27− , wai >= 1.2 && < 1.3

27+ , wai >= 1.3 && < 1.4

2828 , bytestring >= 0.9.1.4

2929 , http-types >= 0.6 && < 0.7

3030 , transformers >= 0.2.2 && < 0.4

@@ -43,7 +43,7 @@ library

4343 , http-date

4444 , blaze-html >= 0.5 && < 0.6

4545 , blaze-markup >= 0.5.1 && < 0.6

46− , crypto-conduit >= 0.3.2 && < 0.4

46+ , crypto-conduit >= 0.4 && < 0.5

4747 , cereal >= 0.3.5 && < 0.4

4848

4949 exposed-modules: Network.Wai.Application.Static

@@ -53,7 +53,7 @@ library

5353 WaiAppStatic.Mime

5454 WaiAppStatic.Types

5555 other-modules: Util

56− ghc-options: -Wall -Werror

56+ ghc-options: -Wall

5757 extensions: CPP

5858

5959 if flag(print)

wai-eventsource/src/Network/Wai/EventSource.hs+16−23

@@ -10,8 +10,7 @@ module Network.Wai.EventSource (

1010import Blaze.ByteString.Builder (Builder)

1111import Control.Concurrent.Chan (Chan, dupChan, readChan)

1212import Control.Monad.IO.Class (liftIO)

13−import Data.Conduit (($=))

14−import qualified Data.Conduit as C

13+import Data.Conduit

1514import qualified Data.Conduit.List as CL

1615import Network.HTTP.Types (status200)

1716import Network.Wai (Application, Response(..))

@@ -27,7 +26,7 @@ eventSourceAppChan chan _ = do

2726

2827-- | Make a new WAI EventSource application reading events from

2928-- the given source.

30−eventSourceAppSource :: C.Source (C.ResourceT IO) ServerEvent -> Application

29+eventSourceAppSource :: Source (ResourceT IO) ServerEvent -> Application

3130eventSourceAppSource src _ = return $ response sourceToSource src

3231

3332-- | Make a new WAI EventSource application reading events from

@@ -35,37 +34,31 @@ eventSourceAppSource src _ = return $ response sourceToSource src

3534eventSourceAppIO :: IO ServerEvent -> Application

3635eventSourceAppIO act _ = return $ response ioToSource act

3736

38−response :: (a -> C.Source (C.ResourceT IO) (C.Flush Builder)) -> a -> Response

37+response :: (a -> Source (ResourceT IO) (Flush Builder)) -> a -> Response

3938response f a = ResponseSource status200 [("Content-Type", "text/event-stream")] $ f a

4039

41−chanToSource :: Chan ServerEvent -> C.Source (C.ResourceT IO) (C.Flush Builder)

42−chanToSource chan =

43− C.sourceState Nothing pull

44− where

45− pull Nothing = do

46− x <- liftIO $ readChan chan

47− return $ case eventToBuilder x of

48− Nothing -> C.StateClosed

49− Just y -> C.StateOpen (Just C.Flush) (C.Chunk y)

50− pull (Just x) = return $ C.StateOpen Nothing x

40+chanToSource :: Chan ServerEvent -> Source (ResourceT IO) (Flush Builder)

41+chanToSource = ioToSource . readChan

5142

52−ioToSource :: IO ServerEvent -> C.Source (C.ResourceT IO) (C.Flush Builder)

43+ioToSource :: IO ServerEvent -> Source (ResourceT IO) (Flush Builder)

5344ioToSource act =

54− C.sourceState Nothing pull

45+ loop

5546 where

56− pull Nothing = do

47+ loop = do

5748 x <- liftIO act

58− return $ case eventToBuilder x of

59− Nothing -> C.StateClosed

60− Just y -> C.StateOpen (Just C.Flush) (C.Chunk y)

61− pull (Just x) = return $ C.StateOpen Nothing x

49+ case eventToBuilder x of

50+ Nothing -> return ()

51+ Just y -> do

52+ yield $ Chunk y

53+ yield Flush

54+ loop

6255

6356-- | Convert a ServerEvent source into a Builder source of serialized

6457-- events.

65−sourceToSource :: Monad m => C.Source m ServerEvent -> C.Source m (C.Flush Builder)

58+sourceToSource :: Monad m => Source m ServerEvent -> Source m (Flush Builder)

6659sourceToSource src = src $= CL.concatMap eventToFlushBuilder

6760 where

6861 eventToFlushBuilder event =

6962 case eventToBuilder event of

7063 Nothing -> []

71− Just x -> [C.Chunk x, C.Flush]

64+ Just x -> [Chunk x, Flush]

wai-eventsource/wai-eventsource.cabal+4−4

@@ -1,5 +1,5 @@

11Name: wai-eventsource

2−Version: 1.2.0.2

2+Version: 1.3.0

33Synopsis: WAI support for server-sent events

44Description: WAI support for server-sent events

55License: MIT

@@ -17,10 +17,10 @@ Library

1717 base >= 4.3 && < 5

1818 , bytestring >= 0.9.1.4

1919 , blaze-builder >= 0.3 && < 0.4

20− , conduit >= 0.4 && < 0.5

20+ , conduit >= 0.5 && < 0.6

2121 , http-types >= 0.6 && < 0.7

22− , wai >= 1.2 && < 1.3

23− , warp >= 1.2 && < 1.3

22+ , wai >= 1.3 && < 1.4

23+ , warp >= 1.3 && < 1.4

2424 , transformers

2525

2626 ghc-options: -Wall

wai-extra/Network/Wai/Handler/CGI.hs+19−19

@@ -30,7 +30,7 @@ import Network.HTTP.Types (Status (..))

3030import qualified Network.HTTP.Types as H

3131import qualified Data.CaseInsensitive as CI

3232import Data.Monoid (mappend)

33−import qualified Data.Conduit as C

33+import Data.Conduit

3434import qualified Data.Conduit.List as CL

3535

3636safeRead :: Read a => a -> String -> a

@@ -66,7 +66,7 @@ runSendfile sf app = do

6666-- stick with 'run' or 'runSendfile'.

6767runGeneric

6868 :: [(String, String)] -- ^ all variables

69− -> (Int -> C.Source (C.ResourceT IO) B.ByteString) -- ^ responseBody of input

69+ -> (Int -> Source (ResourceT IO) B.ByteString) -- ^ responseBody of input

7070 -> (B.ByteString -> IO ()) -- ^ destination for output

7171 -> Maybe B.ByteString -- ^ does the server support the X-Sendfile header?

7272 -> Application

@@ -94,7 +94,7 @@ runGeneric vars inputH outputH xsendfile app = do

9494 case addrs of

9595 a:_ -> addrAddress a

9696 [] -> error $ "Invalid REMOTE_ADDR or REMOTE_HOST: " ++ remoteHost'

97− C.runResourceT $ do

97+ runResourceT $ do

9898 let env = Request

9999 { requestMethod = rmethod

100100 , rawPathInfo = B.pack pinfo

@@ -117,9 +117,9 @@ runGeneric vars inputH outputH xsendfile app = do

117117 liftIO $ mapM_ outputH $ L.toChunks $ toLazyByteString $ sfBuilder s hs sf fp

118118 _ -> do

119119 let (s, hs, b) = responseSource res

120− src = CL.sourceList [C.Chunk $ headers s hs `mappend` fromChar '\n']

120+ src = CL.sourceList [Chunk $ headers s hs `mappend` fromChar '\n']

121121 `mappend` b

122− src C.$$ builderSink

122+ src $$ builderSink

123123 where

124124 headers s hs = mconcat (map header $ status s : map header' (fixHeaders hs))

125125 status (Status i m) = (fromByteString "Status", mconcat

@@ -141,13 +141,13 @@ runGeneric vars inputH outputH xsendfile app = do

141141 , fromByteString sf

142142 , fromByteString " not supported"

143143 ]

144− bsSink = C.NeedInput push (return ())

145− push (C.Chunk bs) = C.PipeM (do

144+ bsSink = awaitE >>= either return push

145+ push (Chunk bs) = do

146146 liftIO $ outputH bs

147− return bsSink) (return ())

147+ bsSink

148148 -- FIXME actually flush?

149− push C.Flush = bsSink

150− builderSink = builderToByteStringFlush C.=$ bsSink

149+ push Flush = bsSink

150+ builderSink = builderToByteStringFlush =$ bsSink

151151 fixHeaders h =

152152 case lookup "content-type" h of

153153 Nothing -> ("Content-Type", "text/html; charset=utf-8") : h

@@ -166,19 +166,19 @@ cleanupVarName s =

166166 helper' (x:rest) = toLower x : helper' rest

167167 helper' [] = []

168168

169−requestBodyHandle :: Handle -> Int -> C.Source (C.ResourceT IO) B.ByteString

169+requestBodyHandle :: Handle -> Int -> Source (ResourceT IO) B.ByteString

170170requestBodyHandle h = requestBodyFunc $ \i -> do

171171 bs <- B.hGet h i

172172 return $ if B.null bs then Nothing else Just bs

173173

174−requestBodyFunc :: (Int -> IO (Maybe B.ByteString)) -> Int -> C.Source (C.ResourceT IO) B.ByteString

175−requestBodyFunc get count0 =

176− C.sourceState count0 pull

174+requestBodyFunc :: (Int -> IO (Maybe B.ByteString)) -> Int -> Source (ResourceT IO) B.ByteString

175+requestBodyFunc get =

176+ loop

177177 where

178− pull 0 = return C.StateClosed

179− pull count = do

178+ loop 0 = return ()

179+ loop count = do

180180 mbs <- liftIO $ get $ min count defaultChunkSize

181181 let count' = count - maybe 0 B.length mbs

182− return $ case mbs of

183− Nothing -> C.StateClosed

184− Just bs -> C.StateOpen count' bs

182+ case mbs of

183+ Nothing -> return ()

184+ Just bs -> yield bs >> loop count'

wai-extra/Network/Wai/Parse.hs+76−88

@@ -36,15 +36,15 @@ import Data.Function (on)

3636import System.Directory (removeFile, getTemporaryDirectory)

3737import System.IO (hClose, openBinaryTempFile)

3838import Network.Wai

39−import qualified Data.Conduit as C

39+import Data.Conduit

4040import qualified Data.Conduit.List as CL

4141import qualified Data.Conduit.Binary as CB

4242import Control.Monad.IO.Class (liftIO)

4343import qualified Network.HTTP.Types as H

4444import Data.Either (partitionEithers)

45+import Control.Monad (when, unless)

4546import Control.Monad.Trans.Class (lift)

4647import Control.Monad.Trans.Resource (allocate, release, register)

47−import Data.Void (absurd)

4848

4949uncons :: S.ByteString -> Maybe (Word8, S.ByteString)

5050uncons s

@@ -97,11 +97,11 @@ parseHttpAccept = map fst

9797 trimWhite = S.dropWhile (== 32) -- space

9898

9999-- | Store uploaded files in memory

100−lbsSink :: Monad m => C.Sink S.ByteString m L.ByteString

100+lbsSink :: Monad m => Sink S.ByteString m L.ByteString

101101lbsSink = fmap L.fromChunks CL.consume

102102

103103-- | Save uploaded files on disk as temporary files

104−tempFileSink :: C.MonadResource m => C.Sink S.ByteString m FilePath

104+tempFileSink :: MonadResource m => Sink S.ByteString m FilePath

105105tempFileSink = do

106106 (key, (fp, h)) <- lift $ allocate (do

107107 tempDir <- getTemporaryDirectory

@@ -145,45 +145,47 @@ getRequestBodyType req = do

145145 else Nothing

146146 else Nothing

147147

148−parseRequestBody :: C.Sink S.ByteString (C.ResourceT IO) y

148+parseRequestBody :: Sink S.ByteString (ResourceT IO) y

149149 -> Request

150− -> C.ResourceT IO ([Param], [File y])

150+ -> ResourceT IO ([Param], [File y])

151151parseRequestBody s r =

152152 case getRequestBodyType r of

153153 Nothing -> return ([], [])

154− Just rbt -> fmap partitionEithers $ requestBody r C.$$ conduitRequestBody s rbt C.=$ CL.consume

154+ Just rbt -> fmap partitionEithers $ requestBody r $$ conduitRequestBody s rbt =$ CL.consume

155155

156−sinkRequestBody :: C.Sink S.ByteString (C.ResourceT IO) y

156+sinkRequestBody :: Sink S.ByteString (ResourceT IO) y

157157 -> RequestBodyType

158− -> C.Sink S.ByteString (C.ResourceT IO) ([Param], [File y])

159−sinkRequestBody s r = fmap partitionEithers $ conduitRequestBody s r C.=$ CL.consume

158+ -> Sink S.ByteString (ResourceT IO) ([Param], [File y])

159+sinkRequestBody s r = fmap partitionEithers $ conduitRequestBody s r =$ CL.consume

160160

161−conduitRequestBody :: C.Sink S.ByteString (C.ResourceT IO) y

161+conduitRequestBody :: Sink S.ByteString (ResourceT IO) y

162162 -> RequestBodyType

163− -> C.Conduit S.ByteString (C.ResourceT IO) (Either Param (File y))

164−conduitRequestBody _ UrlEncoded = C.sequenceSink () $ \() -> do -- url-encoded

163+ -> Conduit S.ByteString (ResourceT IO) (Either Param (File y))

164+conduitRequestBody _ UrlEncoded = do

165165 -- NOTE: in general, url-encoded data will be in a single chunk.

166166 -- Therefore, I'm optimizing for the usual case by sticking with

167167 -- strict byte strings here.

168168 bs <- CL.consume

169− return $ C.Emit () $ map Left $ H.parseSimpleQuery $ S.concat bs

169+ mapM_ yield $ map Left $ H.parseSimpleQuery $ S.concat bs

170170conduitRequestBody backend (Multipart bound) =

171171 parsePieces backend $ S8.pack "--" `S.append` bound

172172

173−takeLine :: C.Sink S.ByteString (C.ResourceT IO) (Maybe S.ByteString)

173+takeLine :: Monad m => Pipe S.ByteString S.ByteString o u m (Maybe S.ByteString)

174174takeLine =

175− C.sinkState id push close'

175+ go id

176176 where

177− close' _ = return Nothing

177+ go front = await >>= maybe (close front) (push front)

178+

179+ close front = leftover (front S.empty) >> return Nothing

178180 push front bs = do

179181 let (x, y) = S.break (== 10) $ front bs -- LF

180182 in if S.null y

181− then return $ C.StateProcessing $ S.append x

183+ then go $ S.append x

182184 else do

183− let lo = if S.length y > 1 then Just (S.drop 1 y) else Nothing

184− return $ C.StateDone lo $ Just $ killCR x

185+ when (S.length y > 1) $ leftover $ S.drop 1 y

186+ return $ Just $ killCR x

185187

186−takeLines :: C.Sink S.ByteString (C.ResourceT IO) [S.ByteString]

188+takeLines :: Pipe S.ByteString S.ByteString o u (ResourceT IO) [S.ByteString]

187189takeLines = do

188190 res <- takeLine

189191 case res of

@@ -194,20 +196,16 @@ takeLines = do

194196 ls <- takeLines

195197 return $ l : ls

196198

197−parsePieces :: C.Sink S.ByteString (C.ResourceT IO) y -> S.ByteString

198− -> C.Conduit S.ByteString (C.ResourceT IO) (Either Param (File y))

199−parsePieces sink bound = C.sequenceSink True (parsePiecesSink sink bound)

200−

201−parsePiecesSink :: C.Sink S.ByteString (C.ResourceT IO) y

202− -> S.ByteString

203− -> C.SequencedSink Bool S.ByteString (C.ResourceT IO) (Either Param (File y))

204−parsePiecesSink _ _ False = return C.Stop

205−parsePiecesSink sink bound True = do

206− _boundLine <- takeLine

207− res' <- takeLines

208− case res' of

209− [] -> return C.Stop

210− _ -> do

199+parsePieces :: Sink S.ByteString (ResourceT IO) y

200+ -> S.ByteString

201+ -> Pipe S.ByteString S.ByteString (Either Param (File y)) u (ResourceT IO) ()

202+parsePieces sink bound =

203+ loop

204+ where

205+ loop = do

206+ _boundLine <- takeLine

207+ res' <- takeLines

208+ unless (null res') $ do

211209 let ls' = map parsePair res'

212210 let x = do

213211 cd <- lookup contDisp ls'

@@ -218,30 +216,31 @@ parsePiecesSink sink bound True = do

218216 case x of

219217 Just (mct, name, Just filename) -> do

220218 let ct = fromMaybe "application/octet-stream" mct

221− (y, wasFound) <- sinkTillBound' Nothing bound sink

219+ (wasFound, y) <- sinkTillBound' bound sink

222220 let fi = FileInfo filename ct y

223221 let y' = (name, fi)

224− return $ C.Emit wasFound [Right y']

222+ yield $ Right y'

223+ when wasFound loop

225224 Just (_ct, name, Nothing) -> do

226225 let seed = id

227226 let iter front bs = return $ front . (:) bs

228− (front, wasFound) <-

229− sinkTillBound bound iter seed

227+ (wasFound, front) <- sinkTillBound bound iter seed

230228 let bs = S.concat $ front []

231229 let x' = (name, qsDecode bs)

232− return $ C.Emit wasFound [Left x']

230+ yield $ Left x'

231+ when wasFound loop

233232 _ -> do

234233 -- ignore this part

235234 let seed = ()

236235 iter () _ = return ()

237− ((), wasFound) <- sinkTillBound bound iter seed

238− return $ C.Emit wasFound []

239− where

240− contDisp = S8.pack "Content-Disposition"

241− contType = S8.pack "Content-Type"

242− parsePair s =

243− let (x, y) = breakDiscard 58 s -- colon

244− in (x, S.dropWhile (== 32) y) -- space

236+ (wasFound, ()) <- sinkTillBound bound iter seed

237+ when wasFound loop

238+ where

239+ contDisp = S8.pack "Content-Disposition"

240+ contType = S8.pack "Content-Type"

241+ parsePair s =

242+ let (x, y) = breakDiscard 58 s -- colon

243+ in (x, S.dropWhile (== 32) y) -- space

245244

246245data Bound = FoundBound S.ByteString S.ByteString

247246 | NoBound

@@ -265,60 +264,49 @@ findBound b bs = go [0..S.length bs - 1]

265264 | S.index b x == S.index bs y = mismatch xs ys

266265 | otherwise = True

267266

268−sinkTillBound' :: Maybe S.ByteString -> S.ByteString -> C.Sink S.ByteString (C.ResourceT IO) y -> C.Sink S.ByteString (C.ResourceT IO) (y, Bool)

269−sinkTillBound' mfront _ (C.Done _ y) = C.Done mfront (y, False)

270−sinkTillBound' _ _ (C.HaveOutput _ _ o) = absurd o

271−sinkTillBound' mfront bound (C.PipeM mp mc) = C.PipeM (fmap (sinkTillBound' mfront bound) mp) (fmap (\y -> (y, False)) mc)

272−sinkTillBound' mfront bound (C.NeedInput pushI closeI) =

273− C.NeedInput push close

267+sinkTillBound' :: S.ByteString

268+ -> Sink S.ByteString (ResourceT IO) y

269+ -> Pipe S.ByteString S.ByteString o u (ResourceT IO) (Bool, y)

270+sinkTillBound' bound sink = conduitTillBound bound >+> withUpstream (sinkToPipe sink)

271+

272+conduitTillBound :: Monad m

273+ => S.ByteString -- bound

274+ -> Pipe S.ByteString S.ByteString S.ByteString u m Bool

275+conduitTillBound bound =

276+ go id

274277 where

275− push bs' = do

276− let bs = maybe id S.append mfront $ bs'

278+ go front = await >>= maybe (close front) (push front)

279+ close front = do

280+ let bs = front S.empty

281+ unless (S.null bs) $ yield bs

282+ return False

283+ push front bs' = do

284+ let bs = front bs'

277285 case findBound bound bs of

278286 FoundBound before after -> do

279287 let before' = killCRLF before

280− res <- lift $ return () C.$$ pushI before'

281− C.Done (Just after) (res, True)

288+ yield before'

289+ leftover after

290+ return True

282291 NoBound -> do

283292 -- don't emit newlines, in case it's part of a bound

284293 let (toEmit, front') =

285294 if not (S8.null bs) && S8.last bs `elem` "\r\n"

286295 then let (x, y) = S.splitAt (S.length bs - 2) bs

287− in (x, Just y)

288− else (bs, Nothing)

289− sinkTillBound' front' bound (pushI toEmit)

290− PartialBound -> sinkTillBound' (Just bs) bound (C.NeedInput pushI closeI)

291− close = fmap (\y -> (y, False)) closeI

296+ in (x, S.append y)

297+ else (bs, id)

298+ yield toEmit

299+ go front'

300+ PartialBound -> go $ S.append bs

292301

293302sinkTillBound :: S.ByteString

294303 -> (x -> S.ByteString -> IO x)

295304 -> x

296− -> C.Sink S.ByteString (C.ResourceT IO) (x, Bool)

297−sinkTillBound bound iter seed0 = C.sinkState

298− (id, seed0)

299− push

300− close'

305+ -> Pipe S.ByteString S.ByteString o u (ResourceT IO) (Bool, x)

306+sinkTillBound bound iter seed0 =

307+ conduitTillBound bound >+> withUpstream (CL.foldM iter' seed0)

301308 where

302− close' (front, seed) = do

303− seed' <- liftIO $ iter seed $ front S.empty

304− return (seed', False)

305− push (front, seed) bs' = do

306− let bs = front bs'

307− case findBound bound bs of

308− FoundBound before after -> do

309− let before' = killCRLF before

310− seed' <- liftIO $ iter seed before'

311− return $ C.StateDone (Just after) (seed', True)

312− NoBound -> do

313− -- don't emit newlines, in case it's part of a bound

314− let (toEmit, front') =

315− if not (S8.null bs) && S8.last bs `elem` "\r\n"

316− then let (x, y) = S.splitAt (S.length bs - 2) bs

317− in (x, S.append y)

318− else (bs, id)

319− seed' <- liftIO $ iter seed toEmit

320− return $ C.StateProcessing (front', seed')

321− PartialBound -> return $ C.StateProcessing (S.append bs, seed)

309+ iter' a b = liftIO $ iter a b

322310

323311parseAttrs :: S.ByteString -> [(S.ByteString, S.ByteString)]

324312parseAttrs = map go . S.split 59 -- semicolon

wai-extra/wai-extra.cabal+7−7

@@ -1,5 +1,5 @@

11Name: wai-extra

2−Version: 1.2.0.4

2+Version: 1.3.0

33Synopsis: Provides some basic WAI handlers and middleware.

44Description: The goal here is to provide common features without many dependencies.

55License: MIT

@@ -22,7 +22,7 @@ extra-source-files:

2222Library

2323 Build-Depends: base >= 4 && < 5

2424 , bytestring >= 0.9.1.4

25− , wai >= 1.2 && < 1.3

25+ , wai >= 1.3 && < 1.4

2626 , old-locale >= 1.0.0.2 && < 1.1

2727 , time >= 1.1.4

2828 , network >= 2.2.1.5 && < 2.4

@@ -34,9 +34,9 @@ Library

3434 , case-insensitive >= 0.2

3535 , data-default >= 0.3 && < 0.5

3636 , fast-logger >= 0.0.2

37− , conduit >= 0.4 && < 0.5

38− , zlib-conduit >= 0.4 && < 0.5

39− , blaze-builder-conduit >= 0.4 && < 0.5

37+ , conduit >= 0.5 && < 0.6

38+ , zlib-conduit >= 0.5 && < 0.6

39+ , blaze-builder-conduit >= 0.5 && < 0.6

4040 , ansi-terminal

4141 , resourcet >= 0.3 && < 0.4

4242 , void >= 0.5 && < 0.6

@@ -63,8 +63,8 @@ test-suite tests

6363

6464 build-depends: base >= 4 && < 5

6565 , wai-extra

66− , wai-test

67− , hspec >= 0.8 && < 1.2

66+ , wai-test >= 1.3

67+ , hspec

6868 , HUnit

6969

7070 , wai

wai-frontend-monadcgi/wai-frontend-monadcgi.cabal+3−3

@@ -1,5 +1,5 @@

11name: wai-frontend-monadcgi

2−version: 1.2.0.2

2+version: 1.3.0

33license: MIT

44license-file: LICENSE

55author: Michael Snoyman <michael@snoyman.com>

@@ -16,11 +16,11 @@ library

1616 , bytestring

1717 , containers >= 0.2

1818 , cgi

19− , conduit >= 0.4

19+ , conduit >= 0.5 && < 0.6

2020 , http-types

2121 , transformers

2222 , case-insensitive

23− , wai >= 1.2 && < 1.3

23+ , wai >= 1.3 && < 1.4

2424 exposed-modules: Network.Wai.Frontend.MonadCGI

2525 ghc-options: -Wall

2626

wai-handler-devel/wai-handler-devel.cabal+6−6

@@ -1,5 +1,5 @@

11Name: wai-handler-devel

2−Version: 1.2.0.2

2+Version: 1.3.0

33Synopsis: WAI server that automatically reloads code after modification.

44Description: This handler automatically reloads your source code upon any changes. It works by using the hint package, essentially embedding GHC inside the handler. The handler (both the executable and library) takes three arguments: the port to listen on, the module name containing the application function, and the name of the function.

55 .

@@ -22,12 +22,12 @@ Source-repository head

2222

2323Library

2424 Build-Depends: base >= 4 && < 5

25− , wai >= 1.2 && < 1.3

26− , wai-extra >= 1.2 && < 1.3

25+ , wai >= 1.3 && < 1.4

26+ , wai-extra >= 1.3 && < 1.4

2727 , http-types >= 0.6 && < 0.7

28− , warp >= 1.2 && < 1.3

29− , directory >= 1.0.1 && < 1.2

30− , network >= 2.2.1.5 && < 2.4

28+ , warp >= 1.3 && < 1.4

29+ , directory >= 1.0.1 && < 1.2

30+ , network >= 2.2.1.5 && < 2.4

3131 , bytestring >= 0.9.1.4

3232 , hint >= 0.3.2.3 && < 0.4

3333 , text >= 0.7 && < 0.12

wai-handler-fastcgi/wai-handler-fastcgi.cabal+3−3

@@ -1,5 +1,5 @@

11name: wai-handler-fastcgi

2−version: 1.2.0.2

2+version: 1.3.0

33license: MIT

44license-file: LICENSE

55author: Michael Snoyman <michael@snoyman.com>

@@ -15,8 +15,8 @@ description: Calls out to the libfcgi C library.

1515

1616library

1717 build-depends: base >= 4 && < 5

18− , wai >= 1.2 && < 1.3

19− , wai-extra >= 1.2 && < 1.3

18+ , wai >= 1.3 && < 1.4

19+ , wai-extra >= 1.3 && < 1.4

2020 , bytestring >= 0.9.1.4

2121 exposed-modules: Network.Wai.Handler.FastCGI

2222 ghc-options: -Wall

wai-handler-launch/Network/Wai/Handler/Launch.hs+22−19

@@ -11,19 +11,19 @@ import Network.Wai

1111import Network.HTTP.Types

1212import qualified Network.Wai.Handler.Warp as Warp

1313import Data.IORef

14−import Control.Concurrent

14+import Control.Concurrent (forkIO, threadDelay)

1515import Control.Monad.IO.Class (liftIO)

1616import qualified Data.ByteString as S

1717import Blaze.ByteString.Builder (fromByteString)

1818#if WINDOWS

1919import Foreign

20−import Foreign.C.String

20+import Foreign.String

2121#else

2222import System.Cmd (rawSystem)

2323#endif

2424import Data.Conduit.Zlib (decompressFlush, WindowBits (WindowBits))

2525import Data.Conduit.Blaze (builderToByteStringFlush)

26−import qualified Data.Conduit as C

26+import Data.Conduit

2727import qualified Data.Conduit.List as CL

2828

2929ping :: IORef Bool -> Middleware

@@ -50,42 +50,45 @@ ping var app req

5050 let headers'' = filter (\(x, _) -> x /= "content-length") headers'

5151 let fixEnc src =

5252 if isEnc then

53− src C.$= decompressFlush (WindowBits 31)

53+ src $= decompressFlush (WindowBits 31)

5454 else src

5555 return $ ResponseSource s headers''

56− $ fixEnc (body C.$= builderToByteStringFlush)

57− C.$= insideHead

58− C.$= CL.map (fmap fromByteString)

56+ $ fixEnc (body $= builderToByteStringFlush)

57+ $= insideHead

58+ $= CL.map (fmap fromByteString)

5959

6060toInsert :: S.ByteString

6161toInsert = "<script>setInterval(function(){var x;if(window.XMLHttpRequest){x=new XMLHttpRequest();}else{x=new ActiveXObject(\"Microsoft.XMLHTTP\");}x.open(\"GET\",\"/_ping\",false);x.send();},60000)</script>"

6262

63−insideHead :: C.Conduit (C.Flush S.ByteString) (C.ResourceT IO) (C.Flush S.ByteString)

63+insideHead :: Pipe l (Flush S.ByteString) (Flush S.ByteString) r (ResourceT IO) r

6464insideHead =

65− C.conduitState (Just (S.empty, whole)) push' close

65+ loop' (S.empty, whole)

6666 where

67+ loop' state = awaitE >>= either (close state) (push' state)

6768 whole = "<head>"

68− push' state (C.Chunk x) = (fmap . fmap) C.Chunk (push state x)

69− push' state C.Flush = return $ C.StateProducing state [C.Flush]

70− push (Just (held, atFront)) x

69+ push' state (Chunk x) = push state x

70+ push' state Flush = yield Flush >> loop' state

71+

72+ push (held, atFront) x

7173 | atFront `S.isPrefixOf` x = do

7274 let y = S.drop (S.length atFront) x

73− return $ C.StateProducing Nothing [held, atFront, toInsert, y]

75+ mapM_ (yield . Chunk) [held, atFront, toInsert, y]

76+ CL.map id

7477 | whole `S.isInfixOf` x = do

7578 let (before, rest) = S.breakSubstring whole x

7679 let after = S.drop (S.length whole) rest

77− return $ C.StateProducing Nothing [held, before, whole, toInsert, after]

80+ mapM_ (yield . Chunk) [held, before, whole, toInsert, after]

81+ CL.map id

7882 | x `S.isPrefixOf` atFront = do

7983 let held' = held `S.append` x

8084 atFront' = S.drop (S.length x) atFront

81− return $ C.StateProducing (Just (held', atFront')) []

85+ loop' (held', atFront')

8286 | otherwise = do

8387 let (held', atFront', x') = getOverlap whole x

84− return $ C.StateProducing (Just (held', atFront')) [held, x']

85− push Nothing x = return $ C.StateProducing Nothing [x]

88+ mapM_ (yield . Chunk) [held, x']

89+ loop' (held', atFront')

8690

87− close (Just (held, _)) = return [C.Chunk held, C.Chunk toInsert]

88− close Nothing = return []

91+ close (held, _) r = mapM_ yield [Chunk held, Chunk toInsert] >> return r

8992

9093getOverlap :: S.ByteString -> S.ByteString -> (S.ByteString, S.ByteString, S.ByteString)

9194getOverlap whole x =

wai-handler-launch/wai-handler-launch.cabal+6−6

@@ -1,5 +1,5 @@

11Name: wai-handler-launch

2−Version: 1.2.0.2

2+Version: 1.3.0

33Synopsis: Launch a web app in the default browser.

44Description: This handles cross-platform launching and inserts Javascript code to ping the server. When the server no longer receives pings, it shuts down.

55License: MIT

@@ -13,15 +13,15 @@ Cabal-version: >=1.6

1313Library

1414 Exposed-modules: Network.Wai.Handler.Launch

1515 build-depends: base >= 4 && < 5

16− , wai >= 1.2 && < 1.3

17− , warp >= 1.2 && < 1.3

16+ , wai >= 1.3 && < 1.4

17+ , warp >= 1.3 && < 1.4

1818 , http-types >= 0.6 && < 0.7

1919 , transformers >= 0.2.2 && < 0.4

2020 , bytestring >= 0.9.1.4

2121 , blaze-builder >= 0.2.1.4 && < 0.4

22− , conduit >= 0.4 && < 0.5

23− , blaze-builder-conduit >= 0.4 && < 0.5

24− , zlib-conduit >= 0.4 && < 0.5

22+ , conduit >= 0.5 && < 0.6

23+ , blaze-builder-conduit >= 0.5 && < 0.6

24+ , zlib-conduit >= 0.5 && < 0.6

2525

2626 if os(windows)

2727 c-sources: windows.c

wai-handler-scgi/wai-handler-scgi.cabal+3−3

@@ -1,5 +1,5 @@

11name: wai-handler-scgi

2−version: 1.2.0.2

2+version: 1.3.0

33license: MIT

44license-file: LICENSE

55author: Michael Snoyman <michael@snoyman.com>

@@ -14,8 +14,8 @@ description: Wai handler to SCGI

1414

1515library

1616 build-depends: base >= 4 && < 5

17− , wai >= 1.2 && < 1.3

18− , wai-extra >= 1.2 && < 1.3

17+ , wai >= 1.3 && < 1.4

18+ , wai-extra >= 1.3 && < 1.4

1919 , bytestring >= 0.9.1.4

2020 exposed-modules: Network.Wai.Handler.SCGI

2121 ghc-options: -Wall

wai-handler-webkit/wai-handler-webkit.cabal+3−3

@@ -1,5 +1,5 @@

11name: wai-handler-webkit

2−version: 1.2.0

2+version: 1.3.0

33license: MIT

44license-file: LICENSE

55author: Michael Snoyman <michael@snoyman.com>

@@ -16,8 +16,8 @@ homepage: http://www.yesodweb.com/book/wai

1616

1717library

1818 build-depends: base >= 4 && < 5

19− , wai >= 1.2 && < 1.3

20− , warp >= 1.2 && < 1.3

19+ , wai >= 1.3 && < 1.4

20+ , warp >= 1.3 && < 1.4

2121 ghc-options: -Wall

2222 exposed-modules: Network.Wai.Handler.Webkit

2323 c-sources: webkit.cpp

wai-test/Network/Wai/Test.hs+1−7

@@ -99,19 +99,13 @@ srequest (SRequest req bod) = do

9999

100100runResponse :: Response -> C.ResourceT IO SResponse

101101runResponse res = do

102− bss <- fmap2 toBuilder body C.$= builderToByteString C.$$ CL.consume

102+ bss <- C.mapOutput toBuilder body C.$= builderToByteString C.$$ CL.consume

103103 return $ SResponse s h $ L.fromChunks bss

104104 where

105105 (s, h, body) = responseSource res

106106 toBuilder (C.Chunk builder) = builder

107107 toBuilder C.Flush = flush

108108

109−fmap2 :: Functor m => (a -> b) -> C.Source m a -> C.Source m b

110−fmap2 f (C.HaveOutput p c o) = C.HaveOutput (fmap2 f p) c (f o)

111−fmap2 f (C.NeedInput p c) = C.NeedInput (fmap2 f . p) (fmap2 f c)

112−fmap2 _ (C.Done i r) = C.Done i r

113−fmap2 f (C.PipeM mp c) = C.PipeM (fmap (fmap2 f) mp) c

114−

115109assertBool :: String -> Bool -> Session ()

116110assertBool s b = liftIO $ H.assertBool s b

117111

wai-test/wai-test.cabal+4−4

@@ -1,5 +1,5 @@

11name: wai-test

2−version: 1.2.0.2

2+version: 1.3.0

33license: MIT

44license-file: LICENSE

55author: Michael Snoyman <michael@snoyman.com>

@@ -14,14 +14,14 @@ description: Unit test framework (built on HUnit) for WAI applications.

1414

1515library

1616 build-depends: base >= 4 && < 5

17− , wai >= 1.2 && < 1.3

17+ , wai >= 1.3 && < 1.4

1818 , bytestring >= 0.9.1.4

1919 , text >= 0.7 && < 0.12

2020 , blaze-builder >= 0.2.1.4 && < 0.4

2121 , transformers >= 0.2.2 && < 0.4

2222 , containers >= 0.2

23− , conduit >= 0.4 && < 0.5

24− , blaze-builder-conduit >= 0.4 && < 0.5

23+ , conduit >= 0.5 && < 0.6

24+ , blaze-builder-conduit >= 0.5 && < 0.6

2525 , cookie >= 0.2 && < 0.5

2626 , HUnit >= 1.2 && < 1.3

2727 , http-types >= 0.6 && < 0.7

wai-websockets/Network/Wai/Handler/WebSockets.hs+11−9

@@ -8,7 +8,7 @@ import Control.Monad.IO.Class (liftIO)

88import Data.ByteString (ByteString)

99import Data.Char (toLower)

1010import qualified Data.ByteString.Char8 as S

11−import qualified Data.Conduit as C

11+import Data.Conduit

1212import qualified Data.Enumerator as E

1313import qualified Network.Wai as Wai

1414import qualified Network.Wai.Handler.Warp as Warp

@@ -18,7 +18,7 @@ import qualified Network.WebSockets as WS

1818intercept :: WS.Protocol p

1919 => (WS.Request -> WS.WebSockets p ())

2020 -> Wai.Request

21− -> Maybe (C.Source (C.ResourceT IO) ByteString -> Warp.Connection -> C.ResourceT IO ())

21+ -> Maybe (Source (ResourceT IO) ByteString -> Warp.Connection -> ResourceT IO ())

2222intercept = interceptWith WS.defaultWebSocketsOptions

2323

2424-- | Variation of 'intercept' which allows custom options.

@@ -26,7 +26,7 @@ interceptWith :: WS.Protocol p

2626 => WS.WebSocketsOptions

2727 -> (WS.Request -> WS.WebSockets p ())

2828 -> Wai.Request

29− -> Maybe (C.Source (C.ResourceT IO) ByteString -> Warp.Connection -> C.ResourceT IO ())

29+ -> Maybe (Source (ResourceT IO) ByteString -> Warp.Connection -> ResourceT IO ())

3030interceptWith opts app req = case lookup "upgrade" $ Wai.requestHeaders req of

3131 Just s

3232 | S.map toLower s == "websocket" -> Just $ runWebSockets opts req' app

@@ -41,21 +41,23 @@ runWebSockets :: WS.Protocol p

4141 => WS.WebSocketsOptions

4242 -> WS.RequestHttpPart

4343 -> (WS.Request -> WS.WebSockets p ())

44− -> C.Source (C.ResourceT IO) ByteString

44+ -> Source (ResourceT IO) ByteString

4545 -> Warp.Connection

46− -> C.ResourceT IO ()

46+ -> ResourceT IO ()

4747runWebSockets opts req app source conn = do

4848 step <- liftIO $ E.runIteratee $ WS.runWebSocketsWith opts req app send

49− source C.$$ C.sinkState (E.returnI step) push close

49+ source $$ sink (E.returnI step)

5050 where

5151 send = iterConnection conn

5252

53+ sink iter = await >>= maybe (close iter) (push iter)

54+

5355 push iter bs = do

5456 step <- liftIO $ E.runIteratee $ E.enumList 1 [bs] E.$$ iter

5557 case step of

56− E.Continue _ -> return $ C.StateProcessing $ E.returnI step

57− E.Yield out inp -> return $ C.StateDone (streamToMaybe inp) out

58− E.Error e -> C.monadThrow e

58+ E.Continue _ -> sink $ E.returnI step

59+ E.Yield out inp -> maybe (return ()) leftover (streamToMaybe inp) >> return out

60+ E.Error e -> liftIO $ monadThrow e

5961 close iter = do

6062 _ <- liftIO $ E.runIteratee $ E.enumEOF E.$$ iter

6163 return ()

wai-websockets/server.lhs+1−3

@@ -87,9 +87,7 @@ actual server. For this purpose, we use the simple server provided by

8787> } staticApp

8888

8989> staticApp :: Network.Wai.Application

90−> staticApp = Static.staticApp Static.defaultFileServerSettings

91−> { Static.ssFolder = Static.embeddedLookup $ Static.toEmbedded $(embedDir "static")

92−> }

90+> staticApp = Static.staticApp $ Static.embeddedSettings $(embedDir "static")

9391

9492When a client connects, we accept the connection, regardless of the path.

9593

wai-websockets/wai-websockets.cabal+4−4

@@ -1,5 +1,5 @@

11Name: wai-websockets

2−Version: 1.2.0.3

2+Version: 1.3.0

33Synopsis: Provide a bridge betweeen WAI and the websockets package.

44License: MIT

55License-file: LICENSE

@@ -19,8 +19,8 @@ flag example

1919Library

2020 Build-Depends: base >= 3 && < 5

2121 , bytestring >= 0.9.1.4

22− , conduit >= 0.4 && < 0.5

23− , wai >= 1.2 && < 1.3

22+ , conduit >= 0.5 && < 0.6

23+ , wai >= 1.3 && < 1.4

2424 , enumerator >= 0.4.8 && < 0.5

2525 , network-enumerator >= 0.1.2 && < 0.2

2626 , blaze-builder >= 0.2.1.4 && < 0.4

@@ -28,7 +28,7 @@ Library

2828 , network >= 2.2.1.5 && < 2.4

2929 , transformers >= 0.2 && < 0.4

3030 , websockets >= 0.6 && < 0.7

31− , warp >= 1.2 && < 1.3

31+ , warp >= 1.3 && < 1.4

3232 Exposed-modules: Network.Wai.Handler.WebSockets

3333 ghc-options: -Wall

3434

wai/wai.cabal+2−2

@@ -1,5 +1,5 @@

11Name: wai

2−Version: 1.2.0.3

2+Version: 1.3.0

33Synopsis: Web Application Interface.

44Description: Provides a common protocol for communication between web applications and web servers.

55License: MIT

@@ -20,7 +20,7 @@ Library

2020 Build-Depends: base >= 4 && < 5

2121 , bytestring >= 0.9.1.4

2222 , blaze-builder >= 0.2.1.4 && < 0.4

23− , conduit >= 0.4 && < 0.6

23+ , conduit >= 0.5 && < 0.6

2424 , network >= 2.2.1.5 && < 2.4

2525 , http-types >= 0.6 && < 0.7

2626 , text >= 0.7 && < 0.12

warp-static/warp-static.cabal+5−5

@@ -1,5 +1,5 @@

11Name: warp-static

2−Version: 1.2.0.2

2+Version: 1.3.0

33Synopsis: Static file server based on Warp and wai-app-static

44Homepage: http://github.com/yesodweb/wai

55License: MIT

@@ -15,14 +15,14 @@ Description: Serve up static files by running the warp executable. Based

1515Executable warp

1616 Main-is: warp.hs

1717 Build-depends: base >= 4 && < 5

18− , warp >= 1.2 && < 1.3

19− , wai-app-static >= 1.2 && < 1.3

20− , wai-extra >= 1.2 && < 1.3

18+ , warp >= 1.3 && < 1.4

19+ , wai-app-static >= 1.3 && < 1.4

20+ , wai-extra >= 1.3 && < 1.4

2121 , cmdargs >= 0.6.7

2222 , directory >= 1.0

2323 , containers >= 0.2

2424 , bytestring >= 0.9.1.4

25− , text >= 0.7 && < 0.12

25+ , text >= 0.7 && < 0.12

2626

2727source-repository head

2828 type: git

warp-static/warp.hs+9−15

@@ -1,11 +1,5 @@

11{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-}

2−import Network.Wai.Application.Static

3− ( StaticSettings (..), staticApp, defaultMimeType, defaultListing

4− , defaultMimeTypes, mimeTypeByExt

5− , defaultFileServerSettings, fileSystemLookup

6− , fileName, toFilePath

7− , ssRedirectToIndex

8− )

2+import Network.Wai.Application.Static (staticApp, defaultFileServerSettings)

93import Network.Wai.Handler.Warp

104 ( runSettings, defaultSettings, settingsHost, settingsPort

115 )

@@ -21,6 +15,9 @@ import qualified Data.ByteString.Char8 as S8

2115import Control.Arrow ((***))

2216import Data.Text (pack)

2317import Data.String (fromString)

18+import WaiAppStatic.Mime (defaultMimeMap, mimeByExt, defaultMimeType)

19+import WaiAppStatic.Types (ssIndices, toPiece, ssGetMimeType, fileName)

20+import Data.Maybe (mapMaybe)

2421

2522data Args = Args

2623 { docroot :: FilePath

@@ -40,8 +37,8 @@ defaultArgs = Args "." ["index.html", "index.htm"] 3000 False False False [] "*"

4037main :: IO ()

4138main = do

4239 Args {..} <- cmdArgs defaultArgs

43− let mime' = map (toFilePath *** S8.pack) mime

44− let mimeMap = Map.fromList mime' `Map.union` defaultMimeTypes

40+ let mime' = map (pack *** S8.pack) mime

41+ let mimeMap = Map.fromList mime' `Map.union` defaultMimeMap

4542 docroot' <- canonicalizePath docroot

4643 unless quiet $ printf "Serving directory %s on port %d with %s index files.\n" docroot' port (if noindex then "no" else show index)

4744 let middle = gzip def

@@ -50,10 +47,7 @@ main = do

5047 runSettings defaultSettings

5148 { settingsPort = port

5249 , settingsHost = fromString host

53− } $ middle $ staticApp defaultFileServerSettings

54− { ssFolder = fileSystemLookup $ toFilePath docroot

55− , ssIndices = if noindex then [] else map pack index

56− , ssRedirectToIndex = False

57− , ssListing = Just defaultListing

58− , ssGetMimeType = return . mimeTypeByExt mimeMap defaultMimeType . fileName

50+ } $ middle $ staticApp (defaultFileServerSettings $ fromString docroot)

51+ { ssIndices = if noindex then [] else mapMaybe (toPiece . pack) index

52+ , ssGetMimeType = return . mimeByExt mimeMap defaultMimeType . fileName

5953 }

warp-tls/warp-tls.cabal+5−5

@@ -1,5 +1,5 @@

11Name: warp-tls

2−Version: 1.2.0.4

2+Version: 1.3.0

33Synopsis: SSL support for Warp via the TLS package

44License: MIT

55License-file: LICENSE

@@ -15,11 +15,11 @@ Description: SSL support for Warp via the TLS package

1515Library

1616 Build-Depends: base >= 4 && < 5

1717 , bytestring >= 0.9

18− , wai >= 1.2 && < 1.3

19− , warp >= 1.2 && < 1.3

18+ , wai >= 1.3 && < 1.4

19+ , warp >= 1.3 && < 1.4

2020 , transformers >= 0.2 && < 0.4

21− , conduit >= 0.4 && < 0.5

22− , network-conduit >= 0.4 && < 0.5

21+ , conduit >= 0.5 && < 0.6

22+ , network-conduit >= 0.5 && < 0.6

2323 , certificate >= 1.2 && < 1.3

2424 , pem >= 0.1 && < 0.2

2525 , cryptocipher >= 0.3 && < 0.4

warp/warp.cabal+2−2

@@ -1,5 +1,5 @@

11Name: warp

2−Version: 1.2.1.2

2+Version: 1.3.0

33Synopsis: A fast, light-weight web server for WAI applications.

44License: MIT

55License-file: LICENSE

@@ -19,7 +19,7 @@ flag network-bytestring

1919Library

2020 Build-Depends: base >= 3 && < 5

2121 , bytestring >= 0.9.1.4

22− , wai >= 1.2 && < 1.3

22+ , wai >= 1.3 && < 1.4

2323 , transformers >= 0.2.2 && < 0.4

2424 , conduit >= 0.5 && < 0.6

2525 , network-conduit >= 0.5 && < 0.6