3d93eb6 · typeable/wai

git.iko.soy/typeable/wai

Everything compiles, not everything rewritten

commit3d93eb69de2ca7a5f9046cdf93e6398d066180ad authorMichael Snoyman <michael@snoyman.com> dateTue 14 Dec 2010, 18:30 (16 years ago) parent1797b3e

11 files changed+167−217

compare with master

unifiedsplit

Network/Wai/Handler/CGI.hs+14−11 Network/Wai/Handler/Helper.hs+3−2 Network/Wai/Handler/SimpleServer.hs+25−16 Network/Wai/Middleware/CleanPath.hs+8−70 Network/Wai/Middleware/Gzip.hs+7−4 Network/Wai/Middleware/Jsonp.hs+22−7 Network/Wai/Parse.hs+51−73 Network/Wai/Zlib.hs+6−2 proxy.hs+24 wai-extra.cabal+7−4 xmltest.hs−28

Network/Wai/Handler/CGI.hs+14−11

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

11{-# LANGUAGE OverloadedStrings #-}

2+{-# LANGUAGE RankNTypes #-}

23module Network.Wai.Handler.CGI

34 ( run

45 , run'

@@ -7,7 +8,6 @@ module Network.Wai.Handler.CGI

78 ) where

910import Network.Wai

10−import Network.Wai.Enumerator (fromResponseBody)

1111import Network.Wai.Handler.Helper

1212import System.Environment (getEnvironment)

1313import Data.Maybe (fromMaybe)

@@ -16,6 +16,7 @@ import Control.Arrow ((***))

1616import Data.Char (toLower)

1717import qualified System.IO

1818import Data.String (fromString)

19+import Data.Enumerator (Enumerator)

1920

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

2122safeRead d s =

@@ -52,7 +53,7 @@ run' vars inputH outputH app = do

5253 run'' vars input output Nothing app

5354

5455run'' :: [(String, String)] -- ^ all variables

55− -> (Int -> Source) -- ^ responseBody of input

56+ -> (forall a. Int -> Enumerator B.ByteString IO a) -- ^ responseBody of input

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

5758 -> Maybe String -- ^ does the server support the X-Sendfile header?

5859 -> Application

@@ -89,15 +90,11 @@ run'' vars inputH outputH xsendfile app = do

8990 , httpVersion = "1.1" -- FIXME

9091 }

9192 res <- app env

92− let h = responseHeaders res

93− let h' = case lookup "Content-Type" h of

94− Nothing -> ("Content-Type", "text/html; charset=utf-8")

95− : h

96− Just _ -> h

97− let hPut = outputH

98− hPut $ B.pack $ "Status: " ++ (show $ statusCode $ status res) ++ " "

99− hPut $ statusMessage $ status res

100− hPut $ B.singleton '\n'

93+ error "FIXME"

94+ {-

95+ outputH $ B.pack $ "Status: " ++ (show $ statusCode $ status res) ++ " "

96+ outputH $ statusMessage $ status res

97+ outputH $ B.singleton '\n'

10198 mapM_ (printHeader hPut) h'

10299 case (xsendfile, responseBody res) of

103100 (Just sf, ResponseFile fp) ->

@@ -114,6 +111,12 @@ run'' vars inputH outputH xsendfile app = do

114111 _ <- runEnumerator (fromResponseBody (responseBody res))

115112 (myPut outputH) ()

116113 return ()

114+ -}

115+

116+fixHeaders h =

117+ case lookup "content-type" h of

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

119+ Just _ -> h

117120

118121myPut :: (B.ByteString -> IO ()) -> () -> B.ByteString -> IO (Either () ())

119122myPut output _ bs = output bs >> return (Right ())

Network/Wai/Handler/Helper.hs+3−2

@@ -1,3 +1,4 @@

1+{-# LANGUAGE RankNTypes #-}

12module Network.Wai.Handler.Helper

23 ( requestBodyHandle

34 , requestBodyFunc

@@ -10,7 +11,7 @@ import qualified Data.Enumerator as E

1011import Data.Enumerator ((>>==))

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

1213

13−requestBodyHandle :: Handle -> Int -> E.Enumerator B.ByteString IO a

14+requestBodyHandle :: Handle -> Int -> forall a. E.Enumerator B.ByteString IO a

1415requestBodyHandle h =

1516 requestBodyFunc go

1617 where

@@ -18,7 +19,7 @@ requestBodyHandle h =

1819

1920requestBodyFunc :: (Int -> IO (Maybe B.ByteString))

2021 -> Int

21− -> E.Enumerator B.ByteString IO a

22+ -> forall a. E.Enumerator B.ByteString IO a

2223requestBodyFunc _ 0 step = E.returnI step

2324requestBodyFunc h len (E.Continue k) = do

2425 mbs <- liftIO $ h len

Network/Wai/Handler/SimpleServer.hsmode 100644 → 100755+25−16

@@ -152,24 +152,39 @@ parseFirst s = do

152152 let (rpath, qstring) = B.break (== '?') query

153153 return (method, rpath, qstring, hsecond)

154154

155−sendResponse :: HttpVersion -> Handle -> Response -> IO ()

156−sendResponse httpversion h res = do

155+sendResponsePrelude :: Handle -> HttpVersion -> Status -> ResponseHeaders -> IO ()

156+sendResponsePrelude h httpversion status responseHeaders = do

157157 B.hPut h $ B.pack "HTTP/"

158158 B.hPut h $ httpversion

159159 B.hPut h $ B.pack " "

160− B.hPut h $ B.pack $ show $ statusCode $ status res

160+ B.hPut h $ B.pack $ show $ statusCode status

161161 B.hPut h $ B.pack " "

162− B.hPut h $ statusMessage $ status res

162+ B.hPut h $ statusMessage status

163163 B.hPut h $ B.pack "\r\n"

164− mapM_ putHeader $ responseHeaders res

164+ mapM_ putHeader responseHeaders

165165 B.hPut h $ B.pack "Transfer-Encoding: chunked\r\n\r\n"

166− case responseBody res of

167− ResponseFile fp -> E.run_ $ enumFile fp $$ myIter

168− ResponseEnumerator enum ->

169− enum $ E.joinI $ builderToByteString $$ myIter

170− ResponseLBS lbs -> mapM_ myPut $ L.toChunks lbs

166+ where

167+ putHeader (x, y) = do

168+ B.hPut h $ ciOriginal x

169+ B.hPut h $ B.pack ": "

170+ B.hPut h y

171+ B.hPut h $ B.pack "\r\n"

172+

173+sendResponse :: HttpVersion -> Handle -> Response -> IO ()

174+sendResponse httpversion h res = do

175+ case res of

176+ ResponseFile s hs fp -> do

177+ sendResponsePrelude h httpversion s hs

178+ E.run_ $ enumFile fp $$ myIter

179+ ResponseLBS s hs lbs -> do

180+ sendResponsePrelude h httpversion s hs

181+ mapM_ myPut $ L.toChunks lbs

182+ ResponseEnumerator enum -> enum myIter'

171183 B.hPut h $ B.pack "0\r\n\r\n"

172184 where

185+ myIter' s hs = do

186+ liftIO $ sendResponsePrelude h httpversion s hs

187+ E.joinI $ builderToByteString $$ myIter

173188 myIter = do

174189 mbs <- E.head

175190 case mbs of

@@ -179,12 +194,6 @@ sendResponse httpversion h res = do

179194 B.hPut h $ B.pack $ showHex (B.length bs) " \r\n"

180195 B.hPut h bs

181196 B.hPut h $ B.pack "\r\n"

182− return (Right h)

183− putHeader (x, y) = do

184− B.hPut h $ ciOriginal x

185− B.hPut h $ B.pack ": "

186− B.hPut h y

187− B.hPut h $ B.pack "\r\n"

188197

189198parseHeaderNoAttr :: ByteString -> (ByteString, ByteString)

190199parseHeaderNoAttr s =

Network/Wai/Middleware/CleanPath.hs+8−70

@@ -1,29 +1,24 @@

11{-# LANGUAGE OverloadedStrings #-}

22module Network.Wai.Middleware.CleanPath

33 ( cleanPath

4− , cleanPathRel

5− , cleanPathFunc

6− , splitPath

74 ) where

96import Network.Wai

107import qualified Data.ByteString.Char8 as B

118import qualified Data.ByteString.Lazy as L

12−import Network.URI (unEscapeString)

13−import qualified Data.ByteString.UTF8 as BSU

149

15−cleanPathFunc :: (B.ByteString -> Either B.ByteString [String])

16− -> B.ByteString

17− -> ([String] -> Request -> IO Response)

18− -> Request

19− -> IO Response

20−cleanPathFunc splitter prefix app env =

10+cleanPath :: (B.ByteString -> Either B.ByteString [String])

11+ -> B.ByteString

12+ -> ([String] -> Request -> IO Response)

13+ -> Request

14+ -> IO Response

15+cleanPath splitter prefix app env =

2116 case splitter $ pathInfo env of

2217 Right pieces -> app pieces env

2318 Left p -> return

24− . Response status301

19+ $ ResponseLBS status301

2520 [("Location", B.concat [prefix, p, suffix])]

26− $ ResponseLBS L.empty

21+ $ L.empty

2722 where

2823 -- include the query string if present

2924 suffix =

@@ -31,60 +26,3 @@ cleanPathFunc splitter prefix app env =

3126 Nothing -> B.empty

3227 Just ('?', _) -> queryString env

3328 _ -> B.cons '?' $ queryString env

34−

35−-- | Performs redirects as per 'splitPath'.

36−cleanPathRel :: B.ByteString -> ([String] -> Request -> IO Response)

37− -> Request -> IO Response

38−cleanPathRel = cleanPathFunc splitPath

39−

40−cleanPath :: ([String] -> Request -> IO Response) -> Request -> IO Response

41−cleanPath = cleanPathRel B.empty

42−

43−-- | Given a certain requested path, return either a corrected path

44−-- to redirect to or the tokenized path.

45−--

46−-- This code corrects for the following issues:

47−--

48−-- * It is missing a trailing slash, and there is no period after the

49−-- last slash.

50−--

51−-- * There are any doubled slashes.

52−splitPath :: B.ByteString -> Either B.ByteString [String]

53−splitPath s =

54− let corrected = B.pack $ rts $ ats $ rds $ B.unpack s

55− in if corrected == s

56− then Right $ map (BSU.toString . B.pack . unEscapeString . B.unpack)

57− $ filter (not . B.null)

58− $ B.split '/' s

59− else Left corrected

60−

61−-- | Remove double slashes

62−rds :: String -> String

63−rds [] = []

64−rds [x] = [x]

65−rds (a:b:c)

66− | a == '/' && b == '/' = rds (b:c)

67− | otherwise = a : rds (b:c)

68−

69−-- | Add a trailing slash if it is missing. Empty string is left alone.

70−ats :: String -> String

71−ats [] = []

72−ats s =

73− if last s == '/' || dbs (reverse s)

74− then s

75− else s ++ "/"

76−

77−-- | Remove a trailing slash if the last piece has a period.

78−rts :: String -> String

79−rts [] = []

80−rts s =

81− if last s == '/' && dbs (tail $ reverse s)

82− then init s

83− else s

84−

85−-- | Is there a period before a slash here?

86−dbs :: String -> Bool

87−dbs ('/':_) = False

88−dbs ('.':_) = True

89−dbs (_:x) = dbs x

90−dbs [] = False

Network/Wai/Middleware/Gzip.hs+7−4

@@ -17,7 +17,6 @@

1717module Network.Wai.Middleware.Gzip (gzip) where

1818

1919import Network.Wai

20−import Network.Wai.Enumerator (fromResponseBody)

2120import Network.Wai.Zlib

2221import Data.Maybe (fromMaybe)

2322import qualified Data.ByteString.Char8 as B

@@ -38,9 +37,10 @@ import qualified Data.ByteString.Char8 as B

3837gzip :: Middleware

3938gzip app env = do

4039 res <- app env

41− case responseBody res of

42− ResponseFile _ -> return res

43− _ -> do

40+ case res of

41+ ResponseFile{} -> return res

42+ _ -> error "FIXME"

43+ {-

4444 let enc = fromMaybe []

4545 $ (splitCommas . B.unpack)

4646 `fmap` lookup "Accept-Encoding"

@@ -52,9 +52,12 @@ gzip app env = do

5252 : responseHeaders res

5353 }

5454 else return res

55+ -}

5556

57+{-

5658compressE :: ResponseBody -> ResponseBody

5759compressE = ResponseEnumerator . compress . fromResponseBody

60+-}

5861

5962splitCommas :: String -> [String]

6063splitCommas [] = []

Network/Wai/Middleware/Jsonp.hs+22−7

@@ -15,7 +15,6 @@

1515module Network.Wai.Middleware.Jsonp (jsonp) where

1616

1717import Network.Wai

18−import Network.Wai.Enumerator (fromResponseBody)

1918import qualified Data.ByteString.Char8 as B8

2019import Data.Maybe (fromMaybe)

2120

@@ -58,13 +57,28 @@ jsonp app env = do

5857 $ requestHeaders env

5958 }

6059 res <- app env'

61− case (fmap B8.unpack $ lookup "Content-Type" $ responseHeaders res, callback) of

62− (Just "application/json", Just c) -> return $ res

63− { responseHeaders = changeVal "Content-Type" "text/javascript" $ responseHeaders res

64− , responseBody = ResponseEnumerator $ addCallback c $ fromResponseBody $ responseBody res

65− }

66− _ -> return res

60+ case callback of

61+ Nothing -> return res

62+ Just c -> go c res

63+ where

64+ go c r@(ResponseLBS _ hs _) = go' c r hs

65+ go c r@(ResponseFile _ hs _) = go' c r hs

66+ go c (ResponseEnumerator e) = go'' c e

67+ go' c r hs =

68+ case checkJSON hs of

69+ Just _ -> go'' c $ enumResponse r

70+ Nothing -> return r

71+ go'' e = undefined

72+ checkJSON hs =

73+ case fmap B8.unpack $ lookup "Content-Type" hs of

74+ Just "application/json" -> Just $ fixHeaders hs

75+ Nothing -> Nothing

76+ fixHeaders = changeVal "Content-Type" "text/javascript"

6777

78+enumResponse :: Response -> ResponseEnumerator a

79+enumResponse = undefined

80+

81+{-

6882addCallback :: B8.ByteString -> Enumerator -> Enumerator

6983addCallback cb (Enumerator e) = Enumerator $ \iter a -> do

7084 ea' <- iter a $ B8.snoc cb '('

@@ -75,6 +89,7 @@ addCallback cb (Enumerator e) = Enumerator $ \iter a -> do

7589 case ea'' of

7690 Left a'' -> return $ Left a''

7791 Right a'' -> iter a'' $ B8.singleton ')'

92+-}

7893

7994changeVal :: Eq a

8095 => a

Network/Wai/Parse.hs+51−73

@@ -29,6 +29,10 @@ import Data.Function (on)

2929import System.Directory (removeFile, getTemporaryDirectory)

3030import System.IO (hClose, openBinaryTempFile, Handle)

3131import Network.Wai

32+import Control.Applicative ((<$>))

33+import Data.Enumerator (($$), Iteratee)

34+import qualified Data.Enumerator as E

35+import Control.Monad.IO.Class (liftIO)

3236

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

3438uncons s

@@ -177,80 +181,54 @@ parseRequestBody sink req = do

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

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

179183 -- strict byte strings here.

180− bs <- sourceToBs $ requestBody req

181− return (parseQueryString bs, [])

184+ bs <- E.run_ $ requestBody req $$ E.consume

185+ return (parseQueryString $ S.concat bs, [])

182186 Just (Just bound) -> -- multi-part

183187 let bound' = S8.pack "--" `S.append` bound

184− in parsePieces sink bound' (S.empty, Just $ requestBody req)

188+ in error "FIXME" parsePieces sink bound' (S.empty, Just $ requestBody req)

185189 where

186190 urlenc = S8.pack "application/x-www-form-urlencoded"

187191 formBound = S8.pack "multipart/form-data; boundary="

188192

189−sourceToBs :: Source -> IO S.ByteString

190−sourceToBs = fmap S.concat . go id

191− where

192− go front (Source src) = do

193− res <- src

194− case res of

195− Nothing -> return $ front []

196− Just (bs, src') -> go (front . (:) bs) src'

197−

198−type Source' = (S.ByteString, Maybe Source)

199−

200−takeLine :: Source' -> IO (Maybe (S.ByteString, Source'))

201−takeLine (s, msrc)

202− | S.null s = case msrc of

203− Nothing -> return Nothing

204− Just (Source src) -> do

205− res <- src

206− case res of

207− Nothing -> return Nothing

208− Just (x, y) -> takeLine (x, Just y)

209−takeLine (s, msrc) =

210− let (x, y) = S.break (== 10) s -- newline

211− in if S.null y

212− then do

213− case msrc of

214− Nothing -> return $ Just (x, (y, msrc))

215− Just (Source src) -> do

216− res <- src

217− case res of

218− Nothing -> return $ Just (x, (y, Nothing))

219− Just (s', src') ->

220− takeLine (s `S.append` s', Just src')

221− else return $ Just (killCarriage x, (S.drop 1 y, msrc))

193+takeLine :: Iteratee S.ByteString IO (Maybe S.ByteString)

194+takeLine = do

195+ mbs <- E.head

196+ case mbs of

197+ Nothing -> return Nothing

198+ Just bs ->

199+ let (x, y) = S.break (== 10) bs -- LF

200+ in if S.null y

201+ then do

202+ x' <- takeLine

203+ case x' of

204+ Nothing -> return $ Just x

205+ Just x'' -> return $ Just $ S.append x x''

206+ else do

207+ E.yield () $ E.Chunks [S.drop 1 y]

208+ return $ Just $ killCarriage x

222209 where

223210 killCarriage bs

224211 | S.null bs = bs

225212 | S.last bs == 13 = S.init bs -- carriage return

226213 | otherwise = bs

227214

228−takeLines :: Source' -> IO (Maybe ([S.ByteString], Source'))

229−takeLines src = do

230− res <- takeLine src

215+takeLines :: Iteratee S.ByteString IO [S.ByteString]

216+takeLines = do

217+ res <- takeLine

231218 case res of

232− Nothing -> return Nothing

233− Just (l, src') ->

234− if S.null l

235− then return $ Just ([], src')

236− else do

237− res' <- takeLines src'

238− case res' of

239− Nothing -> return $ Just ([l], src')

240− Just (ls, src'') -> return $ Just (l : ls, src'')

219+ Nothing -> return []

220+ Just l -> do

221+ ls <- takeLines

222+ return $ l : ls

241223

242−parsePieces :: Sink x y -> S.ByteString -> Source'

243− -> IO ([Param], [File y])

244−parsePieces sink bound src = do

245− res <- takeLine src

246− src' <- case res of

247− Nothing -> return (S.empty, Nothing)

248− -- The _bs here should only contain boundary information

249− Just (_bs, src') -> return src'

250− res' <- takeLines src'

224+parsePieces :: Sink x y -> S.ByteString

225+ -> Iteratee S.ByteString IO ([Param], [File y])

226+parsePieces sink bound = do

227+ _boundLine <- takeLine

228+ res' <- takeLines

251229 case res' of

252− Nothing -> return ([], [])

253− Just (ls, src'') -> do

230+ [] -> return ([], [])

231+ ls -> do

254232 let ls' = map parsePair ls

255233 let x = do

256234 cd <- lookup contDisp ls'

@@ -263,37 +241,36 @@ parsePieces sink bound src = do

263241 case x of

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

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

266− seed <- sinkInit sink

267− (seed', wasFound, msrc''') <-

268− sinkTillBound bound src'' (sinkAppend sink) seed

269− y <- sinkClose sink seed'

244+ seed <- liftIO $ sinkInit sink

245+ (seed', wasFound) <-

246+ sinkTillBound bound (sinkAppend sink) seed

247+ y <- liftIO $ sinkClose sink seed'

270248 let fi = FileInfo filename ct y

271249 let y' = (name, fi)

272250 (xs, ys) <-

273251 if wasFound

274− then parsePieces sink bound msrc'''

252+ then parsePieces sink bound

275253 else return ([], [])

276254 return (xs, y' : ys)

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

278256 let seed = id

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

280− (front, wasFound, msrc''') <-

281− sinkTillBound bound src'' iter seed

258+ (front, wasFound) <-

259+ sinkTillBound bound iter seed

282260 let bs = S.concat $ front []

283261 let x' = (name, qsDecode bs)

284262 (xs, ys) <-

285263 if wasFound

286− then parsePieces sink bound msrc'''

264+ then parsePieces sink bound

287265 else return ([], [])

288266 return (x' : xs, ys)

289267 _ -> do

290268 -- ignore this part

291269 let seed = ()

292270 iter () _ = return ()

293− ((), wasFound, msrc''') <-

294− sinkTillBound bound src'' iter seed

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

295272 if wasFound

296− then parsePieces sink bound msrc'''

273+ then parsePieces sink bound

297274 else return ([], [])

298275 where

299276 contDisp = S8.pack "Content-Disposition"

@@ -325,11 +302,11 @@ findBound b bs = go [0..S.length bs - 1]

325302 | otherwise = True

326303

327304sinkTillBound :: S.ByteString

328− -> Source'

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

330306 -> x

331− -> IO (x, Bool, Source')

332−sinkTillBound bound (bs, msrc) iter seed = do

307+ -> Iteratee S.ByteString IO (x, Bool)

308+sinkTillBound bound iter seed = error "FIXME"

309+{-

333310 case findBound bound bs of

334311 NoBound -> do

335312 case msrc of

@@ -375,6 +352,7 @@ sinkTillBound bound (bs, msrc) iter seed = do

375352 Just (bs', src') -> do

376353 let bs'' = bs `S.append` bs'

377354 sinkTillBound bound (bs'', Just src') iter seed

355+-}

378356

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

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

Network/Wai/Zlib.hs+6−2

@@ -3,11 +3,14 @@ module Network.Wai.Zlib (compress) where

33import Prelude

44import Network.Wai

55import Data.ByteString (ByteString)

6+import Data.Enumerator (Enumeratee)

7+import Blaze.ByteString.Builder (Builder)

79import Codec.Zlib

810

9−compress :: Enumerator -> Enumerator

10−compress enum =

11+compress :: Enumeratee Builder Builder IO a

12+compress = undefined

13+ {-

1114 Enumerator $ \iter acc -> do

1215 def <- initDeflate 7 $ WindowBits 31

1316 compressInner iter acc enum def

@@ -49,3 +52,4 @@ drain iter acc pop = do

4952 case eacc' of

5053 Left acc' -> return $ Left acc'

5154 Right acc' -> drain iter acc' pop

55+ -}

proxy.hsnew file+24

@@ -0,0 +1,24 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+import qualified Network.HTTP.Enumerator as H

3+import qualified Network.Wai as W

4+import Network.Wai.Handler.SimpleServer (run)

5+import qualified Data.ByteString.Char8 as S8

6+import qualified Data.ByteString.Lazy.Char8 ()

7+import Data.Enumerator (($$), joinI, run_)

8+import Blaze.ByteString.Builder (fromByteString)

9+import qualified Data.Enumerator as E

10+

11+main :: IO ()

12+main = run 3000 app

13+

14+app :: W.Application

15+app W.Request { W.pathInfo = path } =

16+ case H.parseUrl $ "http://wiki.yesodweb.com" ++ S8.unpack path of

17+ Nothing -> return notFound

18+ Just hreq -> return $ W.ResponseEnumerator $ run_ . H.http hreq . go

19+ where

20+ go f s h = joinI $ E.map fromByteString $$ f s $ filter safe h

21+ safe (x, _) = not $ x `elem` ["Content-Encoding", "Transfer-Encoding"]

22+

23+notFound :: W.Response

24+notFound = W.ResponseLBS W.status404 [("Content-Type", "text/plain")] "Not found"

wai-extra.cabal+7−4

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

11Name: wai-extra

2−Version: 0.2.4.2

2+Version: 0.3.0

33Synopsis: Provides some basic WAI handlers and middleware.

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

55License: BSD3

@@ -15,13 +15,16 @@ Stability: Stable

1515Library

1616 Build-Depends: base >= 3 && < 5,

1717 bytestring >= 0.9 && < 0.10,

18− wai >= 0.2.0 && < 0.3,

18+ wai >= 0.3.0 && < 0.4,

1919 old-locale >= 1.0 && < 1.1,

2020 time >= 1.1.4 && < 1.3,

2121 network >= 2.2.1.5 && < 2.4,

2222 directory >= 1.0.1 && < 1.2,

23− utf8-string >= 0.3.4 && < 0.4,

24− zlib-bindings >= 0.0 && < 0.1

23+ zlib-bindings >= 0.0 && < 0.1,

24+ blaze-builder-enumerator >= 0.2 && < 0.3,

25+ transformers >= 0.2 && < 0.3,

26+ enumerator >= 0.4 && < 0.5,

27+ blaze-builder >= 0.2.1 && < 0.3

2528 Exposed-modules: Network.Wai.Handler.CGI

2629 Network.Wai.Handler.SimpleServer

2730 Network.Wai.Middleware.CleanPath

xmltest.hsdeleted−28

@@ -1,28 +0,0 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−import qualified Network.HTTP.Enumerator as H

3−import qualified Network.Wai as W

4−import Network.Wai.Handler.SimpleServer (run)

5−import Data.Maybe (fromJust)

6−import qualified Data.ByteString.Char8 as S8

7−import qualified Text.XML.Enumerator.Parse as X

8−import qualified Text.XML.Enumerator.Render as X

9−import Data.Enumerator (($$), joinI, run_)

10−

11−main :: IO ()

12−main = run 3000 app

13−

14−app :: W.Application

15−app wreq = do

16− return $ W.Response

17− { W.status = W.status200

18− , W.responseHeaders =

19− [ ("Content-Type", "text/xml")

20− ]

21− , W.responseBody = W.ResponseEnumerator

22− $ \step -> run_ $ H.apply2 (H.http hreq) $ const $ const

23− $ joinI $ X.detectUtf

24− $$ joinI $ X.parseBytes

25− $$ joinI $ X.renderBuilder $$ step

26− }

27− where

28− hreq = fromJust $ H.parseUrl $ S8.unpack $ S8.tail $ W.pathInfo wreq