3ab9864 · typeable/wai

git.iko.soy/typeable/wai

Merge remote branch 'origin/master'

commit3ab9864757fc7d547ddbe9f00a4c3124dffabd4b authorMichael Snoyman <michael@snoyman.com> dateTue 16 Feb 2010, 21:34 (17 years ago) parentb3f1e24 32bc348

7 files changed+30−30

compare with master

unifiedsplit

Network/Wai/Handler/CGI.hs+4−4 Network/Wai/Handler/SimpleServer.hs+6−6 Network/Wai/Middleware/ClientSession.hs+7−7 Network/Wai/Middleware/Gzip.hs+5−5 Network/Wai/Middleware/Jsonp.hs+6−6 Network/Wai/Middleware/MethodOverride.hs+1−1 wai-extra.cabal+1−1

Network/Wai/Handler/CGI.hs+4−4

@@ -29,7 +29,7 @@ run app = do

2929 run' vars System.IO.stdin System.IO.stdout app

3030

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

32− -> System.IO.Handle -- ^ body of input

32+ -> System.IO.Handle -- ^ responseBody of input

3333 -> System.IO.Handle -- ^ destination for output

3434 -> Application

3535 -> IO ()

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

5252 , queryString = B.pack qstring

5353 , serverName = B.pack servername

5454 , serverPort = serverport

55− , httpHeaders = map (cleanupVarName *** B.pack) vars

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

5656 , urlScheme = urlScheme'

5757 , requestBody = requestBodyHandle inputH mContentLength

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

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

6060 , httpVersion = HttpVersion B.empty

6161 }

6262 res <- app env

63− let h = headers res

63+ let h = responseHeaders res

6464 let h' = case lookup ContentType h of

6565 Nothing -> (ContentType, B.pack "text/html; charset=utf-8")

6666 : h

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

7171 hPut $ B.singleton '\n'

7272 mapM_ (printHeader hPut) h'

7373 hPut $ B.singleton '\n'

74− _ <- fromEitherFile (body res) (myPut outputH) ()

74+ _ <- fromEitherFile (responseBody res) (myPut outputH) ()

7575 return ()

7676

7777myPut :: System.IO.Handle -> () -> B.ByteString -> IO (Either () ())

Network/Wai/Handler/SimpleServer.hs+6−6

@@ -69,8 +69,8 @@ serveConnection port app conn remoteHost' =

6969

7070hParseRequest :: Port -> Handle -> String -> IO Request

7171hParseRequest port conn remoteHost' = do

72− headers' <- takeUntilBlank conn id

73− parseRequest port headers' conn remoteHost'

72+ responseHeaders' <- takeUntilBlank conn id

73+ parseRequest port responseHeaders' conn remoteHost'

7474

7575takeUntilBlank :: Handle

7676 -> ([BS.ByteString] -> [BS.ByteString])

@@ -95,7 +95,7 @@ data InvalidRequest =

9595 deriving (Show, Typeable)

9696instance Exception InvalidRequest

9797

98−-- | Parse a set of header lines and body into a 'Request'.

98+-- | Parse a set of header lines and responseBody into a 'Request'.

9999parseRequest :: Port

100100 -> [BS.ByteString]

101101 -> Handle

@@ -128,7 +128,7 @@ parseRequest port lines' handle remoteHost' = do

128128 , queryString = gets

129129 , serverName = serverName'

130130 , serverPort = port

131− , httpHeaders = heads

131+ , requestHeaders = heads

132132 , urlScheme = HTTP

133133 , requestBody = requestBodyHandle handle mlen

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

@@ -165,9 +165,9 @@ sendResponse h res = do

165165 BS.hPut h $ SL.pack $ show $ statusCode $ status res

166166 BS.hPut h $ statusMessage $ status res

167167 BS.hPut h $ SL.pack "\r\n"

168− mapM_ putHeader $ headers res

168+ mapM_ putHeader $ responseHeaders res

169169 BS.hPut h $ SL.pack "\r\n"

170− case body res of

170+ case responseBody res of

171171 Left fp -> unsafeSendFile h fp

172172 Right enum -> enum myPut h >> return ()

173173 where

Network/Wai/Middleware/ClientSession.hs+7−7

@@ -51,7 +51,7 @@ clientsession :: [B.ByteString] -- ^ list of cookies to intercept

5151 -> Request

5252 -> IO Response

5353clientsession cnames key minutesToLive app env = do

54− let hs = httpHeaders env

54+ let hs = requestHeaders env

5555 initCookiesRaw :: B.ByteString

5656 initCookiesRaw = fromMaybe B.empty $ lookup Cookie hs

5757 nonCookies :: [(RequestHeader, B.ByteString)]

@@ -68,17 +68,17 @@ clientsession cnames key minutesToLive app env = do

6868 let convertedCookies :: [(B.ByteString, B.ByteString)]

6969 convertedCookies =

7070 mapMaybe (decodeCookie key now remoteHost') interceptCookies

71− let env' = env { httpHeaders =

71+ let env' = env { requestHeaders =

7272 (Cookie, cookiesRaw)

7373 -- FIXME not sure how I feel about the next line

74− : filter (fst `equals` Cookie) (httpHeaders env)

74+ : filter (fst `equals` Cookie) (requestHeaders env)

7575 ++ nonCookies

7676 }

7777 res <- app convertedCookies env'

78− let interceptHeaders, headers' :: [(ResponseHeader, B.ByteString)]

79− (interceptHeaders, headers') =

78+ let interceptHeaders, responseHeaders' :: [(ResponseHeader, B.ByteString)]

79+ (interceptHeaders, responseHeaders') =

8080 partition ((responseHeaderToBS . fst) `is` (`elem` cnames))

81− $ headers res

81+ $ responseHeaders res

8282 interceptHeaders' :: [(B.ByteString, B.ByteString)]

8383 interceptHeaders' = map (first responseHeaderToBS) interceptHeaders

8484 let timeToLive :: Int

@@ -91,7 +91,7 @@ clientsession cnames key minutesToLive app env = do

9191 convertedCookies

9292 let newCookies = map (setCookie key exp formattedExp remoteHost') $

9393 oldCookies ++ interceptHeaders'

94− let res' = res { headers = newCookies ++ headers' }

94+ let res' = res { responseHeaders = newCookies ++ responseHeaders' }

9595 return res'

9696

9797combineCookies :: [(B.ByteString, B.ByteString)] -> [B.ByteString]

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

@@ -39,18 +39,18 @@ import qualified Data.ByteString.Lazy as L

3939gzip :: Middleware

4040gzip app env = do

4141 res <- app env

42− case body res of

42+ case responseBody res of

4343 Left _ -> return res

4444 Right _ -> do

4545 let enc = fromMaybe []

4646 $ (splitOneOf "," . B.unpack)

4747 `fmap` lookup AcceptEncoding

48− (httpHeaders env)

48+ (requestHeaders env)

4949 if "gzip" `elem` enc

5050 then return res

51− { body = compressE $ body res

52− , headers = (ContentEncoding, B.pack "gzip")

53− : headers res

51+ { responseBody = compressE $ responseBody res

52+ , responseHeaders = (ContentEncoding, B.pack "gzip")

53+ : responseHeaders res

5454 }

5555 else return res

5656

Network/Wai/Middleware/Jsonp.hs+6−6

@@ -28,7 +28,7 @@ import Data.Maybe (fromMaybe)

2828-- callback function.

2929jsonp :: Middleware

3030jsonp app env = do

31− let accept = fromMaybe B8.empty $ lookup Accept $ httpHeaders env

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

3232 let gets = decodeUrlPairs $ queryString env

3333 let callback :: Maybe B8.ByteString

3434 callback =

@@ -39,15 +39,15 @@ jsonp app env = do

3939 case callback of

4040 Nothing -> env

4141 Just _ -> env

42− { httpHeaders = changeVal Accept

42+ { requestHeaders = changeVal Accept

4343 "application/json"

44− $ httpHeaders env

44+ $ requestHeaders env

4545 }

4646 res <- app env'

47− case (fmap B8.unpack $ lookup ContentType $ headers res, callback) of

47+ case (fmap B8.unpack $ lookup ContentType $ responseHeaders res, callback) of

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

49− { headers = changeVal ContentType "text/javascript" $ headers res

50− , body = Right $ addCallback c $ fromEitherFile $ body res

49+ { responseHeaders = changeVal ContentType "text/javascript" $ responseHeaders res

50+ , responseBody = Right $ addCallback c $ fromEitherFile $ responseBody res

5151 }

5252 _ -> return res

5353

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

@@ -29,7 +29,7 @@ moParam = B8.pack "_method_override"

2929

3030methodOverride :: Middleware

3131methodOverride app env = do

32− let mo1 = lookup moHeader $ httpHeaders env

32+ let mo1 = lookup moHeader $ requestHeaders env

3333 gets = decodeUrlPairs $ queryString env

3434 mo2 = lookup moParam gets

3535 app $

wai-extra.cabal+1−1

@@ -17,7 +17,7 @@ Library

1717 bytestring >= 0.9 && < 0.10,

1818 wai >= 0.0.0 && < 0.1,

1919 split >= 0.1.2 && < 0.2,

20− web-encodings >= 0.2.2 && < 0.3,

20+ web-encodings >= 0.2.3 && < 0.3,

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

2222 time >= 1.1.4 && < 1.2,

2323 clientsession >= 0.2.0 && < 0.3,