524847c · typeable/wai

git.iko.soy/typeable/wai

Newer WAI 0.4 (no ascii)

commit524847cc55e5a1d01d72b191c734cbe59bc87349 authorMichael Snoyman <michael@snoyman.com> dateThu 24 Mar 2011, 13:20 (16 years ago) parent37c2cc6

10 files changed+36−43

compare with master

unifiedsplit

Network/Wai/Handler/CGI.hs+7−8 Network/Wai/Middleware/AcceptOverride.hs+5−5 Network/Wai/Middleware/Autohead.hs+1−1 Network/Wai/Middleware/CleanPath.hs+3−4 Network/Wai/Middleware/Debug.hs+2−3 Network/Wai/Middleware/Gzip.hs+2−2 Network/Wai/Middleware/Jsonp.hs+8−9 Network/Wai/Middleware/MethodOverride.hs+1−2 Network/Wai/Parse.hs+3−5 wai-extra.cabal+4−4

Network/Wai/Handler/CGI.hs+7−8

@@ -31,8 +31,7 @@ import Data.ByteString.Lazy.Internal (defaultChunkSize)

3131import System.IO (Handle)

3232import Network.HTTP.Types (Status (..))

3333import qualified Network.HTTP.Types as H

34−import Data.Ascii (ciToByteString)

35−import qualified Data.Ascii as A

34+import qualified Data.CaseInsensitive as CI

3635

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

3837safeRead d s =

@@ -98,14 +97,14 @@ run'' vars inputH outputH xsendfile app = do

9897 a:_ -> addrAddress a

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

10099 let env = Request

101− { requestMethod = A.unsafeFromByteString rmethod

100+ { requestMethod = rmethod

102101 , rawPathInfo = B.pack pinfo

103102 , pathInfo = H.decodePathSegments $ B.pack pinfo

104103 , rawQueryString = B.pack qstring

105104 , queryString = H.parseQuery $ B.pack qstring

106105 , serverName = B.pack servername

107106 , serverPort = serverport

108− , requestHeaders = map (cleanupVarName *** A.unsafeFromString) vars

107+ , requestHeaders = map (cleanupVarName *** B.pack) vars

109108 , isSecure = isSecure'

110109 , errorHandler = System.IO.hPutStr System.IO.stderr

111110 , remoteHost = addr

@@ -114,7 +113,7 @@ run'' vars inputH outputH xsendfile app = do

114113 -- FIXME worry about exception?

115114 res <- run_ $ inputH contentLength $$ app env

116115 case (xsendfile, res) of

117− (Just sf, ResponseFile s hs fp) ->

116+ (Just sf, ResponseFile s hs fp Nothing) ->

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

119118 _ -> responseEnumerator res $ \s hs ->

120119 joinI $ enumList 1 [headers s hs, fromChar '\n'] $$ builderIter

@@ -123,9 +122,9 @@ run'' vars inputH outputH xsendfile app = do

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

124123 [ fromString $ show i

125124 , fromChar ' '

126− , fromByteString $ A.toByteString m

125+ , fromByteString m

127126 ])

128− header' (x, y) = (fromByteString $ ciToByteString x, fromByteString $ A.toByteString y)

127+ header' (x, y) = (fromByteString $ CI.original x, fromByteString y)

129128 header (x, y) = mconcat

130129 [ x

131130 , fromByteString ": "

@@ -149,7 +148,7 @@ run'' vars inputH outputH xsendfile app = do

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

150149 Just _ -> h

151150

152−cleanupVarName :: String -> A.CIAscii

151+cleanupVarName :: String -> CI.CI B.ByteString

153152cleanupVarName ('H':'T':'T':'P':'_':a:as) =

154153 String.fromString $ a : helper' as

155154 where

Network/Wai/Middleware/AcceptOverride.hs+5−5

@@ -6,7 +6,7 @@ module Network.Wai.Middleware.AcceptOverride

77import Network.Wai

88import Control.Monad (join)

9−import qualified Data.Ascii as A

9+import Data.ByteString (ByteString)

1010

1111acceptOverride :: Middleware

1212acceptOverride app req =

@@ -15,12 +15,12 @@ acceptOverride app req =

1515 req' =

1616 case join $ lookup "_accept" $ queryString req of

1717 Nothing -> req

18− Just a -> req { requestHeaders = changeVal "Accept" (A.unsafeFromByteString a) $ requestHeaders req}

18+ Just a -> req { requestHeaders = changeVal "Accept" a $ requestHeaders req}

1919

2020changeVal :: Eq a

2121 => a

22− -> A.Ascii

23− -> [(a, A.Ascii)]

24− -> [(a, A.Ascii)]

22+ -> ByteString

23+ -> [(a, ByteString)]

24+ -> [(a, ByteString)]

2525changeVal key val old = (key, val)

2626 : filter (\(k, _) -> k /= key) old

Network/Wai/Middleware/Autohead.hs+1−1

@@ -12,7 +12,7 @@ autohead app req

1212 | requestMethod req == "HEAD" = do

1313 res <- app req { requestMethod = "GET" }

1414 case res of

15− ResponseFile s hs _ -> return $ ResponseBuilder s hs mempty

15+ ResponseFile s hs _ _ -> return $ ResponseBuilder s hs mempty

1616 ResponseBuilder s hs _ -> return $ ResponseBuilder s hs mempty

1717 ResponseEnumerator e -> do

1818 let helper f =

Network/Wai/Middleware/CleanPath.hs+3−4

@@ -8,11 +8,10 @@ import qualified Data.ByteString.Char8 as B

88import qualified Data.ByteString.Lazy as L

99import Network.HTTP.Types (status301)

1010import Data.Text (Text)

11−import qualified Data.Ascii as A

1211import Data.Monoid (mconcat)

1312

14−cleanPath :: ([Text] -> Either A.Ascii [Text])

15− -> A.Ascii

13+cleanPath :: ([Text] -> Either B.ByteString [Text])

14+ -> B.ByteString

1615 -> ([Text] -> Application)

1716 -> Application

1817cleanPath splitter prefix app env =

@@ -20,7 +19,7 @@ cleanPath splitter prefix app env =

2019 Right pieces -> app pieces env

2120 Left p -> return

2221 $ responseLBS status301

23− [("Location", mconcat [prefix, p, A.unsafeFromByteString suffix])]

22+ [("Location", mconcat [prefix, p, suffix])]

2423 $ L.empty

2524 where

2625 -- include the query string if present

Network/Wai/Middleware/Debug.hs+2−3

@@ -5,18 +5,17 @@ import Network.Wai (Middleware, requestMethod, requestHeaders, rawPathInfo, rawQ

55import Data.ByteString.Char8 (unpack)

66import System.IO (hPutStrLn, stderr)

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

8−import qualified Data.Ascii as A

109-- | Prints a message to 'stderr' for each request.

1110debug :: Middleware

1211debug app req = do

1312 liftIO $ hPutStrLn stderr $ concat

14− [ A.toString $ requestMethod req

13+ [ unpack $ requestMethod req

1514 , " "

1615 , unpack $ rawPathInfo req

1716 , unpack $ rawQueryString req

1817 , "\n"

19− , (++) "Accept: " $ maybe "" A.toString $ lookup "Accept" $ requestHeaders req

18+ , (++) "Accept: " $ maybe "" unpack $ lookup "Accept" $ requestHeaders req

2019 , "\n"

2120 ]

2221 app req

Network/Wai/Middleware/Gzip.hs+2−2

@@ -20,7 +20,7 @@ import Network.Wai

2020import Network.Wai.Zlib

2121import Data.Maybe (fromMaybe)

2222import Data.Enumerator (($$), joinI)

23−import qualified Data.Ascii as A

23+import qualified Data.ByteString.Char8 as S8

2424

2525-- | Use gzip to compress the body of the response.

2626--

@@ -43,7 +43,7 @@ gzip files app env = do

4343 then ResponseEnumerator $ compressE $ responseEnumerator res

4444 else res

4545 where

46− enc = fromMaybe [] $ (splitCommas . A.toString)

46+ enc = fromMaybe [] $ (splitCommas . S8.unpack)

4747 `fmap` lookup "Accept-Encoding" (requestHeaders env)

4848

4949compressE :: (forall a. ResponseEnumerator a)

Network/Wai/Middleware/Jsonp.hs+8−9

@@ -16,13 +16,14 @@

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

1717

1818import Network.Wai

19+import Data.ByteString (ByteString)

1920import qualified Data.ByteString.Char8 as B8

2021import Data.Enumerator (($$), enumList, Step (..), Enumerator, Iteratee, Enumeratee, joinI, checkDone, continue, Stream (..), (>>==))

2122import Blaze.ByteString.Builder (copyByteString, Builder)

2223import Blaze.ByteString.Builder.Char8 (fromChar)

2324import Data.Monoid (mappend)

24−import qualified Data.Ascii as A

2525import Control.Monad (join)

26+import Data.Maybe (fromMaybe)

2627

2728-- | Wrap json responses in a jsonp callback.

2829--

@@ -33,7 +34,7 @@ import Control.Monad (join)

3334-- callback function.

3435jsonp :: Middleware

3536jsonp app env = do

36− let accept = maybe B8.empty A.toByteString $ lookup "Accept" $ requestHeaders env

37+ let accept = fromMaybe B8.empty $ lookup "Accept" $ requestHeaders env

3738 let callback :: Maybe B8.ByteString

3839 callback =

3940 if B8.pack "text/javascript" `B8.isInfixOf` accept

@@ -52,7 +53,7 @@ jsonp app env = do

5253 Nothing -> return res

5354 Just c -> go c res

5455 where

55− go c r@(ResponseFile _ hs _) = go' c r hs

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

5657 go c r@(ResponseBuilder s hs b) =

5758 case checkJSON hs of

5859 Nothing -> return r

@@ -62,14 +63,12 @@ jsonp app env = do

6263 `mappend` b

6364 `mappend` fromChar ')'

6465 go c (ResponseEnumerator e) = addCallback c e

65− go' :: B8.ByteString -> Response -> [(A.CIAscii, A.Ascii)] -> Iteratee B8.ByteString IO Response

6666 go' c r hs =

6767 case checkJSON hs of

6868 Just _ -> addCallback c $ responseEnumerator r

6969 Nothing -> return r

70− checkJSON :: [(A.CIAscii, A.Ascii)] -> Maybe [(A.CIAscii, A.Ascii)]

7170 checkJSON hs =

72− case fmap A.toString $ lookup "Content-Type" hs of

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

7372 Just "application/json" -> Just $ fixHeaders hs

7473 _ -> Nothing

7574 fixHeaders = changeVal "Content-Type" "text/javascript"

@@ -98,8 +97,8 @@ jsonp app env = do

9897

9998changeVal :: Eq a

10099 => a

101− -> A.Ascii

102− -> [(a, A.Ascii)]

103− -> [(a, A.Ascii)]

100+ -> ByteString

101+ -> [(a, ByteString)]

102+ -> [(a, ByteString)]

104103changeVal key val old = (key, val)

105104 : filter (\(k, _) -> k /= key) old

Network/Wai/Middleware/MethodOverride.hs+1−2

@@ -5,7 +5,6 @@ module Network.Wai.Middleware.MethodOverride

66import Network.Wai

77import Control.Monad (join)

8−import Data.Ascii (unsafeFromByteString)

109methodOverride :: Middleware

1110methodOverride app req =

@@ -14,4 +13,4 @@ methodOverride app req =

1413 req' =

1514 case join $ lookup "_method" $ queryString req of

1615 Nothing -> req

17− Just m -> req { requestMethod = unsafeFromByteString m }

16+ Just m -> req { requestMethod = m }

Network/Wai/Parse.hs+3−5

@@ -34,7 +34,6 @@ import Data.Enumerator (Iteratee, yield)

3434import qualified Data.Enumerator as E

3535import qualified Data.Enumerator.List as EL

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

37−import qualified Data.Ascii as A

3837import qualified Network.HTTP.Types as H

3938

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

@@ -70,12 +69,11 @@ qsDecode z = fst $ S.unfoldrN (S.length z) go z

7069 combine a b = shiftL a 4 .|. b

7170

7271-- | Parse the HTTP accept string to determine supported content types.

73−parseHttpAccept :: A.Ascii -> [A.Ascii]

74−parseHttpAccept = map (A.unsafeFromByteString . fst)

72+parseHttpAccept :: S.ByteString -> [S.ByteString]

73+parseHttpAccept = map fst

7574 . sortBy (rcompare `on` snd)

7675 . map grabQ

7776 . S.split 44 -- comma

78− . A.toByteString

7977 where

8078 rcompare :: Double -> Double -> Ordering

8179 rcompare = flip compare

@@ -155,7 +153,7 @@ parseRequestBody sink req = do

155153 else Nothing

156154 else Nothing

157155 ctype = do

158− ctype' <- fmap A.toByteString $ lookup "Content-Type" $ requestHeaders req

156+ ctype' <- lookup "Content-Type" $ requestHeaders req

159157 if urlenc `S.isPrefixOf` ctype'

160158 then Just Nothing

161159 else case boundary ctype' of

wai-extra.cabal+4−4

@@ -24,10 +24,10 @@ Library

2424 blaze-builder-enumerator >= 0.2 && < 0.3,

2525 transformers >= 0.2 && < 0.3,

2626 enumerator >= 0.4.7 && < 0.5,

27− blaze-builder >= 0.2.1.3 && < 0.3,

28− ascii >= 0.0.2 && < 0.1,

29− http-types >= 0.5 && < 0.6,

30− text >= 0.5 && < 1.0

27+ blaze-builder >= 0.2.1.3 && < 0.4,

28+ http-types >= 0.6 && < 0.7,

29+ text >= 0.5 && < 1.0,

30+ case-insensitive >= 0.2 && < 0.3

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

3232 Network.Wai.Middleware.AcceptOverride

3333 Network.Wai.Middleware.Autohead