fa17ef4 · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

Slimmed down dependencies

fa17ef4Michael Snoyman16 years ago

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

compare with master

unifiedsplit

@@ -26,18 +26,16 @@ import qualified Data.ByteString.Char8 as B

26import Network

27 ( listenOn, accept, sClose, PortID(PortNumber), Socket

28 , withSocketsDo)

29−import Control.Exception (bracket, finally, Exception)

29+import Control.Exception (bracket, finally, Exception, throwIO)

30import System.IO (Handle, hClose)

31import Control.Concurrent (forkIO)

32import Control.Monad (unless)

33import Data.Maybe (isJust, fromJust, fromMaybe)

35−import Control.Failure

36import Data.Typeable (Typeable)

35import Data.Typeable (Typeable)

38import qualified Web.Encodings.StringLike as SL

37import qualified Web.Encodings.StringLike as SL

40−import qualified Safe

41import Network.Socket.SendFile

39import Network.Socket.SendFile

42import Control.Arrow (first)

40import Control.Arrow (first)

@@ -103,7 +101,7 @@ parseRequest :: Port

103parseRequest port lines' handle remoteHost' = do

101parseRequest port lines' handle remoteHost' = do

104 case lines' of

102 case lines' of

105 (_:_:_) -> return ()

103 (_:_:_) -> return ()

106− _ -> failure $ NotEnoughLines $ map B.unpack lines'

104+ _ -> throwIO $ NotEnoughLines $ map B.unpack lines'

107 (method', rpath', gets, httpversion) <- parseFirst $ head lines'

105 (method', rpath', gets, httpversion) <- parseFirst $ head lines'

108 let method = methodFromBS method'

106 let method = methodFromBS method'

109 let rpath = '/' : case B.unpack rpath' of

107 let rpath = '/' : case B.unpack rpath' of

@@ -112,12 +110,14 @@ parseRequest port lines' handle remoteHost' = do

112 let heads = map (first requestHeaderFromBS . parseHeaderNoAttr)

110 let heads = map (first requestHeaderFromBS . parseHeaderNoAttr)

113 $ tail lines'

111 $ tail lines'

114 let host' = lookup Host heads

112 let host' = lookup Host heads

115− unless (isJust host') $ failure HostNotIncluded

113+ unless (isJust host') $ throwIO HostNotIncluded

116 let host = fromJust host'

114 let host = fromJust host'

117 let len = fromMaybe 0 $ do

115 let len = fromMaybe 0 $ do

118 bs <- lookup ReqContentLength heads

116 bs <- lookup ReqContentLength heads

119 let str = B.unpack bs

117 let str = B.unpack bs

120− Safe.readMay str

118+ case reads str of

119+ (x, _):_ -> Just x

120+ _ -> Nothing

121 let (serverName', _) = B.break (== ':') host

122 return $ Request

123 { requestMethod = method

@@ -140,9 +140,9 @@ parseFirst s = do

140 (method, query, http') <-

141 case pieces of

142 [x, y, z] -> return (x, y, z)

143− _ -> failure $ BadFirstLine $ B.unpack s

143+ _ -> throwIO $ BadFirstLine $ B.unpack s

144 let (hfirst, hsecond) = B.splitAt 5 http'

145− unless (hfirst == B.pack "HTTP/") $ failure NonHttp

145+ unless (hfirst == B.pack "HTTP/") $ throwIO NonHttp

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

147 return (method, rpath, qstring, httpVersionFromBS hsecond)

148

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

@@ -11,7 +11,6 @@ import Prelude hiding (exp)

11import Network.Wai

12import Web.Encodings

13import Data.List (partition)

14−import Data.Function.Predicate (is, isn't, equals)

15import Data.Maybe (fromMaybe, mapMaybe)

14import Data.Maybe (fromMaybe, mapMaybe)

16import Web.ClientSession

15import Web.ClientSession

17import Data.Time.Clock (getCurrentTime, UTCTime, addUTCTime)

16import Data.Time.Clock (getCurrentTime, UTCTime, addUTCTime)

@@ -55,15 +54,16 @@ clientsession cnames key minutesToLive app env = do

55 initCookiesRaw :: B.ByteString

54 initCookiesRaw :: B.ByteString

56 initCookiesRaw = fromMaybe B.empty $ lookup Cookie hs

55 initCookiesRaw = fromMaybe B.empty $ lookup Cookie hs

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

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

58− nonCookies = filter (fst `isn't` (== Cookie)) hs

57+ nonCookies = filter (\(x, _) -> x /= Cookie) hs

59 initCookies :: [(B.ByteString, B.ByteString)]

58 initCookies :: [(B.ByteString, B.ByteString)]

60 initCookies = parseCookies initCookiesRaw

59 initCookies = parseCookies initCookiesRaw

61 cookies, interceptCookies :: [(B.ByteString, B.ByteString)]

60 cookies, interceptCookies :: [(B.ByteString, B.ByteString)]

62− (interceptCookies, cookies) = partition (fst `is` (`elem` cnames))

61+ (interceptCookies, cookies) = partition (\(x, _) -> x `elem` cnames)

63 initCookies

62 initCookies

64 cookiesRaw, remoteHost' :: B.ByteString

63 cookiesRaw, remoteHost' :: B.ByteString

65 cookiesRaw = B.concat $ combineCookies cookies

64 cookiesRaw = B.concat $ combineCookies cookies

66 remoteHost' = remoteHost env

65 remoteHost' = remoteHost env

66+ print ("intercept", cnames, interceptCookies)

67 now <- getCurrentTime

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

69 convertedCookies =

@@ -71,13 +71,14 @@ clientsession cnames key minutesToLive app env = do

71 let env' = env { requestHeaders =

72 (Cookie, cookiesRaw)

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

74+ : filter (\(x, _) -> x == Cookie)

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

75+ (requestHeaders env)

75 ++ nonCookies

76 ++ nonCookies

76 }

77 }

77 res <- app convertedCookies env'

78 res <- app convertedCookies env'

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

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

79 (interceptHeaders, responseHeaders') =

80 (interceptHeaders, responseHeaders') =

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

81+ partition (\(x, _) -> responseHeaderToBS x `elem` cnames)

81 $ responseHeaders res

82 $ responseHeaders res

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

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

83 interceptHeaders' = map (first responseHeaderToBS) interceptHeaders

84 interceptHeaders' = map (first responseHeaderToBS) interceptHeaders

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

91 convertedCookies

92 convertedCookies

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

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

93 oldCookies ++ interceptHeaders'

94 oldCookies ++ interceptHeaders'

95+ print ("cookies", oldCookies, newCookies, cookiesRaw)

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

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

95 return res'

97 return res'

wai-extra.cabal+2−5

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

1Name: wai-extra

2−Version: 0.0.0.2

2+Version: 0.0.1

3Synopsis: Provides some basic WAI handlers and middleware.

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

5License: BSD3

@@ -17,15 +17,12 @@ Library

17 bytestring >= 0.9 && < 0.10,

18 wai >= 0.0.0 && < 0.3,

19 split >= 0.1.2 && < 0.2,

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

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

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

22 time >= 1.1.4 && < 1.2,

23 clientsession >= 0.2.0 && < 0.3,

24− predicates >= 0.1 && < 0.2,

25 zlib >= 0.5.2.0 && < 0.6,

24 zlib >= 0.5.2.0 && < 0.6,

26 sendfile >= 0.6.1 && < 0.7,

25 sendfile >= 0.6.1 && < 0.7,

27− safe >= 0.2 && < 0.3,

28− failure >= 0.0.0 && < 0.1,

29 network >= 2.2.1.5 && < 2.3

26 network >= 2.2.1.5 && < 2.3

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

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

31 Network.Wai.Handler.SimpleServer

28 Network.Wai.Handler.SimpleServer