@@ -27,7 +27,6 @@ import Network.Wai
2727import Network.Wai.Handler.Warp.Header
2828import Network.Wai.Handler.Warp.ReadInt
2929import qualified Network.Wai.Handler.Warp.ResponseHeader as RH
30−import Network.Wai.Handler.Warp.Settings
3130import qualified Network.Wai.Handler.Warp.Timeout as T
3231import Network.Wai.Handler.Warp.Types
3332import Network.Wai.Internal
@@ -37,8 +36,7 @@ import qualified System.PosixCompat.Files as P
3736----------------------------------------------------------------
3837----------------------------------------------------------------
3938
40−sendResponse :: Settings
41− -> InternalInfo -> Request -> Connection
39+sendResponse :: InternalInfo -> Request -> Connection
4240 -> (forall a. IO a -> IO a) -- ^ restore masking state
4341 -> IndexedHeader
4442 -> Response
@@ -46,7 +44,7 @@ sendResponse :: Settings
4644
4745----------------------------------------------------------------
4846
49−sendResponse settings ii req conn restore reqidxhdr (ResponseFile s0 hs0 path mpart0) =
47+sendResponse ii req conn restore reqidxhdr (ResponseFile s0 hs0 path mpart0) =
5048 restore $ headerAndLength >>= sendResponse'
5149 where
5250 hs = addAccept hs0
@@ -87,12 +85,12 @@ sendResponse settings ii req conn restore reqidxhdr (ResponseFile s0 hs0 path mp
8785
8886 sendResponse' (Right (s, lengthyHeaders, beg, len))
8987 | hasBody s req = liftIO $ do
90− lheader <- composeHeader settings version s lengthyHeaders
88+ lheader <- composeHeader version s lengthyHeaders
9189 connSendFile conn path beg len (T.tickle th) [lheader]
9290 T.tickle th
9391 return isPersist
9492 | otherwise = liftIO $ do
95− composeHeader settings version s hs >>= connSendAll conn
93+ composeHeader version s hs >>= connSendAll conn
9694 T.tickle th
9795 return isPersist -- FIXME isKeepAlive?
9896 where
@@ -100,15 +98,15 @@ sendResponse settings ii req conn restore reqidxhdr (ResponseFile s0 hs0 path mp
10098 (isPersist,_) = infoFromRequest req reqidxhdr
10199
102100 sendResponse' (Left (_ :: SomeException)) =
103− sendResponse settings ii req conn restore reqidxhdr notFound
101+ sendResponse ii req conn restore reqidxhdr notFound
104102 where
105103 notFound = responseLBS H.status404 [(H.hContentType, "text/plain")] "File not found"
106104
107105----------------------------------------------------------------
108106
109−sendResponse settings ii req conn restore reqidxhdr (ResponseBuilder s hs b)
107+sendResponse ii req conn restore reqidxhdr (ResponseBuilder s hs b)
110108 | hasBody s req = restore $ do
111− header <- composeHeaderBuilder settings version s hs needsChunked
109+ header <- composeHeaderBuilder version s hs needsChunked
112110 let body
113111 | needsChunked = header `mappend` chunkedTransferEncoding b
114112 `mappend` chunkedTransferTerminator
@@ -118,7 +116,7 @@ sendResponse settings ii req conn restore reqidxhdr (ResponseBuilder s hs b)
118116 T.tickle th
119117 return isKeepAlive
120118 | otherwise = restore $ do
121− composeHeader settings version s hs >>= connSendAll conn
119+ composeHeader version s hs >>= connSendAll conn
122120 T.tickle th
123121 return isPersist
124122 where
@@ -129,14 +127,14 @@ sendResponse settings ii req conn restore reqidxhdr (ResponseBuilder s hs b)
129127
130128----------------------------------------------------------------
131129
132−sendResponse settings ii req conn restore reqidxhdr (ResponseSource s hs withBodyFlush)
130+sendResponse ii req conn restore reqidxhdr (ResponseSource s hs withBodyFlush)
133131 | hasBody s req = withBodyFlush $ \bodyFlush -> restore $ do
134− header <- liftIO $ composeHeaderBuilder settings version s hs needsChunked
132+ header <- liftIO $ composeHeaderBuilder version s hs needsChunked
135133 let src = CL.sourceList [header] `mappend` cbody bodyFlush
136134 src $$ builderToByteString =$ connSink conn th
137135 return isKeepAlive
138136 | otherwise = withBodyFlush $ \_bodyFlush -> restore $ do -- make sure any cleanup is called
139− composeHeader settings version s hs >>= connSendAll conn
137+ composeHeader version s hs >>= connSendAll conn
140138 T.tickle th
141139 return isPersist
142140 where
@@ -231,27 +229,22 @@ addAccept hdrs = (hAcceptRanges, "bytes") : hdrs
231229addEncodingHeader :: H.ResponseHeaders -> H.ResponseHeaders
232230addEncodingHeader hdrs = (hTransferEncoding, "chunked") : hdrs
233231
234−addServerHeader :: Settings -> H.ResponseHeaders -> H.ResponseHeaders
235−addServerHeader settings hdrs = case lookup hServer hdrs of
236− Nothing -> warpVersionHeader settings : hdrs
232+addServerHeader :: H.ResponseHeaders -> H.ResponseHeaders
233+addServerHeader hdrs = case lookup hServer hdrs of
234+ Nothing -> (hServer, defaultServerValue) : hdrs
237235 Just _ -> hdrs
238236
239−warpVersionHeader :: Settings -> H.Header
240−warpVersionHeader settings = (hServer, settingsServerName settings)
241−
242237----------------------------------------------------------------
243238
244−composeHeader :: Settings
245− -> H.HttpVersion
239+composeHeader :: H.HttpVersion
246240 -> H.Status
247241 -> H.ResponseHeaders
248242 -> IO ByteString
249−composeHeader settings version s hs =
250− RH.composeHeader version s
251− $ addServerHeader settings hs
252−
253−composeHeaderBuilder :: Settings -> H.HttpVersion -> H.Status -> H.ResponseHeaders -> Bool -> IO Builder
254−composeHeaderBuilder settings ver s hs True =
255− fromByteString <$> composeHeader settings ver s (addEncodingHeader hs)
256−composeHeaderBuilder settings ver s hs False =
257− fromByteString <$> composeHeader settings ver s hs
243+composeHeader version s hs =
244+ RH.composeHeader version s $ addServerHeader hs
245+
246+composeHeaderBuilder :: H.HttpVersion -> H.Status -> H.ResponseHeaders -> Bool -> IO Builder
247+composeHeaderBuilder ver s hs True =
248+ fromByteString <$> composeHeader ver s (addEncodingHeader hs)
249+composeHeaderBuilder ver s hs False =
250+ fromByteString <$> composeHeader ver s hs