fa17ef4 · typeable/wai

git.iko.soy/typeable/wai

Slimmed down dependencies

commitfa17ef4b1af235bb98955b04a211eb07306e9be6 authorMichael Snoyman <michael@snoyman.com> dateThu 13 May 2010, 22:52 (16 years ago) parent6f405b7

3 files changed+17−18

compare with master

unifiedsplit

Network/Wai/Handler/SimpleServer.hs+8−8 Network/Wai/Middleware/ClientSession.hs+7−5 wai-extra.cabal+2−5

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

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

2626import Network

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

2828 , withSocketsDo)

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

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

3030import System.IO (Handle, hClose)

3131import Control.Concurrent (forkIO)

3232import Control.Monad (unless)

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

3434

35−import Control.Failure

3635import Data.Typeable (Typeable)

3736

3837import qualified Web.Encodings.StringLike as SL

3938

40−import qualified Safe

4139import Network.Socket.SendFile

4240import Control.Arrow (first)

4341

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

103101parseRequest port lines' handle remoteHost' = do

104102 case lines' of

105103 (_:_:_) -> return ()

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

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

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

108106 let method = methodFromBS method'

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

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

112110 let heads = map (first requestHeaderFromBS . parseHeaderNoAttr)

113111 $ tail lines'

114112 let host' = lookup Host heads

115− unless (isJust host') $ failure HostNotIncluded

113+ unless (isJust host') $ throwIO HostNotIncluded

116114 let host = fromJust host'

117115 let len = fromMaybe 0 $ do

118116 bs <- lookup ReqContentLength heads

119117 let str = B.unpack bs

120− Safe.readMay str

118+ case reads str of

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

120+ _ -> Nothing

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

122122 return $ Request

123123 { requestMethod = method

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

140140 (method, query, http') <-

141141 case pieces of

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

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

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

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

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

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

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

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

148148

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

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

1111import Network.Wai

1212import Web.Encodings

1313import Data.List (partition)

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

1514import Data.Maybe (fromMaybe, mapMaybe)

1615import Web.ClientSession

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

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

5554 initCookiesRaw :: B.ByteString

5655 initCookiesRaw = fromMaybe B.empty $ lookup Cookie hs

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

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

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

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

6059 initCookies = parseCookies initCookiesRaw

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

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

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

6362 initCookies

6463 cookiesRaw, remoteHost' :: B.ByteString

6564 cookiesRaw = B.concat $ combineCookies cookies

6665 remoteHost' = remoteHost env

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

6767 now <- getCurrentTime

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

6969 convertedCookies =

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

7171 let env' = env { requestHeaders =

7272 (Cookie, cookiesRaw)

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

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

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

75+ (requestHeaders env)

7576 ++ nonCookies

7677 }

7778 res <- app convertedCookies env'

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

7980 (interceptHeaders, responseHeaders') =

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

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

8182 $ responseHeaders res

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

8384 interceptHeaders' = map (first responseHeaderToBS) interceptHeaders

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

9192 convertedCookies

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

9394 oldCookies ++ interceptHeaders'

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

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

9597 return res'

9698

wai-extra.cabal+2−5

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

11Name: wai-extra

2−Version: 0.0.0.2

2+Version: 0.0.1

33Synopsis: Provides some basic WAI handlers and middleware.

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

55License: BSD3

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

1717 bytestring >= 0.9 && < 0.10,

1818 wai >= 0.0.0 && < 0.3,

1919 split >= 0.1.2 && < 0.2,

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

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

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

2222 time >= 1.1.4 && < 1.2,

2323 clientsession >= 0.2.0 && < 0.3,

24− predicates >= 0.1 && < 0.2,

2524 zlib >= 0.5.2.0 && < 0.6,

2625 sendfile >= 0.6.1 && < 0.7,

27− safe >= 0.2 && < 0.3,

28− failure >= 0.0.0 && < 0.1,

2926 network >= 2.2.1.5 && < 2.3

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

3128 Network.Wai.Handler.SimpleServer