32bc348 · typeable/wai

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

compare with master

unifiedsplit

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

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

29

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

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

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

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

33 -> Application

34 -> IO ()

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

51 , queryString = B.pack qstring

52 , serverName = B.pack servername

53 , serverPort = serverport

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

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

55 , urlScheme = urlScheme'

56 , requestBody = requestBodyHandle inputH mContentLength

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

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

59 , httpVersion = HttpVersion B.empty

60 }

61 res <- app env

62− let h = headers res

62+ let h = responseHeaders res

63 let h' = case lookup ContentType h of

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

65 : h

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

70 hPut $ B.singleton '\n'

71 mapM_ (printHeader hPut) h'

72 hPut $ B.singleton '\n'

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

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

74 return ()

75

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

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

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

68

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

70hParseRequest port conn remoteHost' = do

71− headers' <- takeUntilBlank conn id

71+ responseHeaders' <- takeUntilBlank conn id

72− parseRequest port headers' conn remoteHost'

72+ parseRequest port responseHeaders' conn remoteHost'

73

74takeUntilBlank :: Handle

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

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

94 deriving (Show, Typeable)

95instance Exception InvalidRequest

96

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

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

98parseRequest :: Port

99 -> [BS.ByteString]

100 -> Handle

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

127 , queryString = gets

128 , serverName = serverName'

129 , serverPort = port

130− , httpHeaders = heads

130+ , requestHeaders = heads

131 , urlScheme = HTTP

132 , requestBody = requestBodyHandle handle mlen

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

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

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

166 BS.hPut h $ statusMessage $ status res

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

168− mapM_ putHeader $ headers res

168+ mapM_ putHeader $ responseHeaders res

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

170− case body res of

170+ case responseBody res of

171 Left fp -> unsafeSendFile h fp

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

173 where

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

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

51 -> Request

52 -> IO Response

53clientsession cnames key minutesToLive app env = do

54− let hs = httpHeaders env

54+ let hs = requestHeaders env

55 initCookiesRaw :: B.ByteString

56 initCookiesRaw = fromMaybe B.empty $ lookup Cookie hs

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

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

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

69 convertedCookies =

70 mapMaybe (decodeCookie key now remoteHost') interceptCookies

71− let env' = env { httpHeaders =

71+ let env' = env { requestHeaders =

72 (Cookie, cookiesRaw)

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

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

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

75 ++ nonCookies

76 }

77 res <- app convertedCookies env'

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

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

79− (interceptHeaders, headers') =

79+ (interceptHeaders, responseHeaders') =

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

81− $ headers res

81+ $ responseHeaders res

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

83 interceptHeaders' = map (first responseHeaderToBS) interceptHeaders

84 let timeToLive :: Int

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

91 convertedCookies

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

93 oldCookies ++ interceptHeaders'

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

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

95 return res'

96

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

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

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

39gzip :: Middleware

40gzip app env = do

41 res <- app env

42− case body res of

42+ case responseBody res of

43 Left _ -> return res

44 Right _ -> do

45 let enc = fromMaybe []

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

47 `fmap` lookup AcceptEncoding

48− (httpHeaders env)

48+ (requestHeaders env)

49 if "gzip" `elem` enc

50 then return res

51− { body = compressE $ body res

51+ { responseBody = compressE $ responseBody res

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

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

53− : headers res

53+ : responseHeaders res

54 }

55 else return res

56

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

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

28-- callback function.

29jsonp :: Middleware

30jsonp app env = do

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

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

32 let gets = decodeUrlPairs $ queryString env

33 let callback :: Maybe B8.ByteString

34 callback =

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

39 case callback of

40 Nothing -> env

41 Just _ -> env

42− { httpHeaders = changeVal Accept

42+ { requestHeaders = changeVal Accept

43 "application/json"

44− $ httpHeaders env

44+ $ requestHeaders env

45 }

46 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

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

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

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

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

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

51 }

52 _ -> return res

53

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

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

29

30methodOverride :: Middleware

31methodOverride app env = do

32− let mo1 = lookup moHeader $ httpHeaders env

32+ let mo1 = lookup moHeader $ requestHeaders env

33 gets = decodeUrlPairs $ queryString env

34 mo2 = lookup moParam gets

35 app $

wai-extra.cabal+1−1

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

17 bytestring >= 0.9 && < 0.10,

18 wai >= 0.0.0 && < 0.1,

19 split >= 0.1.2 && < 0.2,

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

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

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

22 time >= 1.1.4 && < 1.2,

23 clientsession >= 0.2.0 && < 0.3,