@@ -21,8 +21,8 @@ import Network.Wai
2121import Network.Wai.Handler.Helper
2222import qualified System.IO
2323
24−import qualified Data.ByteString as BS
25−import qualified Data.ByteString.Char8 as B8
24+import Data.ByteString (ByteString)
25+import qualified Data.ByteString.Char8 as B
2626import Network
2727 ( listenOn, accept, sClose, PortID(PortNumber), Socket
2828 , withSocketsDo)
@@ -75,10 +75,10 @@ serveConnection port app conn remoteHost' =
7575 return $ shouldConnectionClose env res
7676
7777reqConnectionHeader :: RequestHeader
78−reqConnectionHeader = RequestHeader $ B8.pack "Connection"
78+reqConnectionHeader = RequestHeader $ B.pack "Connection"
7979
8080resConnectionHeader :: ResponseHeader
81−resConnectionHeader = ResponseHeader $ B8.pack "Connection"
81+resConnectionHeader = ResponseHeader $ B.pack "Connection"
8282
8383shouldConnectionClose :: Request -> Response -> Bool
8484shouldConnectionClose req res = (isClose req_conn)
@@ -86,7 +86,7 @@ shouldConnectionClose req res = (isClose req_conn)
8686
8787 where
8888 isClose v = case v of
89− Just x -> (B8.unpack x) == "close"
89+ Just x -> (B.unpack x) == "close"
9090 Nothing -> False
9191
9292 req_conn = lookup reqConnectionHeader $ requestHeaders req
@@ -98,18 +98,18 @@ hParseRequest port conn remoteHost' = do
9898 parseRequest port headers' conn remoteHost'
9999
100100takeUntilBlank :: Handle
101− -> ([BS.ByteString] -> [BS.ByteString])
102− -> IO [BS.ByteString]
101+ -> ([ByteString] -> [ByteString])
102+ -> IO [ByteString]
103103takeUntilBlank h front = do
104− l <- stripCR `fmap` BS.hGetLine h
105− if BS.null l
104+ l <- stripCR `fmap` B.hGetLine h
105+ if B.null l
106106 then return $ front []
107107 else takeUntilBlank h $ front . (:) l
108108
109−stripCR :: BS.ByteString -> BS.ByteString
109+stripCR :: ByteString -> ByteString
110110stripCR bs
111− | BS.null bs = bs
112− | B8.last bs == '\r' = BS.init bs
111+ | B.null bs = bs
112+ | B.last bs == '\r' = B.init bs
113113 | otherwise = bs
114114
115115data InvalidRequest =
@@ -122,19 +122,19 @@ instance Exception InvalidRequest
122122
123123-- | Parse a set of header lines and body into a 'Request'.
124124parseRequest :: Port
125− -> [BS.ByteString]
125+ -> [ByteString]
126126 -> Handle
127127 -> String
128128 -> IO Request
129129parseRequest port lines' handle remoteHost' = do
130130 case lines' of
131131 (_:_:_) -> return ()
132− _ -> failure $ NotEnoughLines $ map SL.unpack lines'
132+ _ -> failure $ NotEnoughLines $ map B.unpack lines'
133133 (method', rpath', gets, httpversion) <- parseFirst $ head lines'
134134 let method = methodFromBS method'
135− let rpath = '/' : case SL.unpack rpath' of
135+ let rpath = '/' : case B.unpack rpath' of
136136 ('/':x) -> x
137− _ -> SL.unpack rpath'
137+ _ -> B.unpack rpath'
138138 let heads = map (first requestHeaderFromBS . parseHeaderNoAttr)
139139 $ tail lines'
140140 let host' = lookup Host heads
@@ -142,13 +142,13 @@ parseRequest port lines' handle remoteHost' = do
142142 let host = fromJust host'
143143 let len = fromMaybe 0 $ do
144144 bs <- lookup ReqContentLength heads
145− let str = SL.unpack bs
145+ let str = B.unpack bs
146146 Safe.readMay str
147− let (serverName', _) = SL.breakChar ':' host
147+ let (serverName', _) = B.break (== ':') host
148148 return $ Request
149149 { requestMethod = method
150150 , httpVersion = httpversion
151− , pathInfo = SL.pack rpath
151+ , pathInfo = B.pack rpath
152152 , queryString = gets
153153 , serverName = serverName'
154154 , serverPort = port
@@ -156,50 +156,46 @@ parseRequest port lines' handle remoteHost' = do
156156 , urlScheme = HTTP
157157 , requestBody = requestBodyHandle handle len
158158 , errorHandler = System.IO.hPutStr System.IO.stderr
159− , remoteHost = B8.pack remoteHost'
159+ , remoteHost = B.pack remoteHost'
160160 }
161161
162−parseFirst :: BS.ByteString
163− -> IO (BS.ByteString, BS.ByteString, BS.ByteString, HttpVersion)
162+parseFirst :: ByteString
163+ -> IO (ByteString, ByteString, ByteString, HttpVersion)
164164parseFirst s = do
165165 let pieces = SL.split ' ' s
166166 (method, query, http') <-
167167 case pieces of
168168 [x, y, z] -> return (x, y, z)
169− _ -> failure $ BadFirstLine $ SL.unpack s
170− print ("http", http')
171− let (hfirst, hsecond) = BS.splitAt 5 http'
172− print (hfirst, hsecond)
173− unless (hfirst == B8.pack "HTTP/") $ failure NonHttp
174− let (rpath, qstring) = SL.breakChar '?' query
175− print (httpVersionFromBS hsecond)
169+ _ -> failure $ BadFirstLine $ B.unpack s
170+ let (hfirst, hsecond) = B.splitAt 5 http'
171+ unless (hfirst == B.pack "HTTP/") $ failure NonHttp
172+ let (rpath, qstring) = B.break (== '?') query
176173 return (method, rpath, qstring, httpVersionFromBS hsecond)
177174
178175sendResponse :: HttpVersion -> Handle -> Response -> IO ()
179176sendResponse httpversion h res = do
180− BS.hPut h $ B8.pack "HTTP/"
181− print $ httpVersionToBS httpversion
182− BS.hPut h $ httpVersionToBS httpversion
183− BS.hPut h $ B8.pack " "
184− BS.hPut h $ B8.pack $ show $ statusCode $ status res
185− BS.hPut h $ statusMessage $ status res
186− BS.hPut h $ B8.pack "\r\n"
177+ B.hPut h $ B.pack "HTTP/"
178+ B.hPut h $ httpVersionToBS httpversion
179+ B.hPut h $ B.pack " "
180+ B.hPut h $ B.pack $ show $ statusCode $ status res
181+ B.hPut h $ statusMessage $ status res
182+ B.hPut h $ B.pack "\r\n"
187183 mapM_ putHeader $ responseHeaders res
188− BS.hPut h $ B8.pack "\r\n"
184+ B.hPut h $ B.pack "\r\n"
189185 case responseBody res of
190186 Left fp -> unsafeSendFile h fp
191187 Right (Enumerator enum) -> enum myPut h >> return ()
192188 where
193189 myPut _ bs = do
194− BS.hPut h bs
190+ B.hPut h bs
195191 return (Right h)
196192 putHeader (x, y) = do
197− BS.hPut h $ responseHeaderToBS x
198− BS.hPut h $ SL.pack ": "
199− BS.hPut h y
200− BS.hPut h $ SL.pack "\r\n"
193+ B.hPut h $ responseHeaderToBS x
194+ B.hPut h $ B.pack ": "
195+ B.hPut h y
196+ B.hPut h $ B.pack "\r\n"
201197
202−parseHeaderNoAttr :: BS.ByteString -> (BS.ByteString, BS.ByteString)
198+parseHeaderNoAttr :: ByteString -> (ByteString, ByteString)
203199parseHeaderNoAttr s =
204− let (k, rest) = B8.span (/= ':') s
205− in (k, SL.dropPrefix' (B8.pack ": ") rest)
200+ let (k, rest) = B.span (/= ':') s
201+ in (k, SL.dropPrefix' (B.pack ": ") rest)