652a7a0 · typeable/wai

git.iko.soy/typeable/wai

setServerName

Pinging @kazu-yamamoto, any objection? This is more convenient (and I think more efficient) for Yesod's standard use case. I don't believe it should negatively impact performance for other cases.

commit652a7a02183458fc60c0404a79d6b6056ae4d9db authorMichael Snoyman <michael@snoyman.com> dateMon 29 Sep 2014, 08:13 (12 years ago) parentdce6b1c

5 files changed+31−9

compare with master

unifiedsplit

warp/Network/Wai/Handler/Warp.hs+8 warp/Network/Wai/Handler/Warp/Response.hs+7−6 warp/Network/Wai/Handler/Warp/Run.hs+6−2 warp/Network/Wai/Handler/Warp/Settings.hs+9 warp/warp.cabal+1−1

warp/Network/Wai/Handler/Warp.hs+8

@@ -40,6 +40,7 @@ module Network.Wai.Handler.Warp (

4040 , setBeforeMainLoop

4141 , setNoParsePath

4242 , setInstallShutdownHandler

43+ , setServerName

4344 -- ** Getters

4445 , getPort

4546 , getHost

@@ -99,6 +100,7 @@ import Control.Exception (SomeException)

99100import Network.Wai (Request, Response)

100101import Network.Socket (SockAddr)

101102import Data.Streaming.Network (HostPreference)

103+import Data.ByteString (ByteString)

102104

103105-- | Port to listen on. Default value: 3000

104106--

@@ -202,3 +204,9 @@ getHost = settingsHost

202204-- Since 3.0.1

203205setInstallShutdownHandler :: (IO () -> IO ()) -> Settings -> Settings

204206setInstallShutdownHandler x y = y { settingsInstallShutdownHandler = x }

207+

208+-- | Default server name if application does not set one.

209+--

210+-- Since 3.0.2

211+setServerName :: ByteString -> Settings -> Settings

212+setServerName x y = y { settingsServerName = x }

warp/Network/Wai/Handler/Warp/Response.hs+7−6

@@ -157,14 +157,15 @@ checkPartRange fileSize = checkPart

157157-- Typically, Transfer-Encoding: chunked is used.

158158-- If Content-Length is specified, Transfer-Encoding: chunked is not used.

159159

160−sendResponse :: Connection

160+sendResponse :: ByteString -- ^ default server value

161+ -> Connection

161162 -> InternalInfo

162163 -> Request -- ^ HTTP request.

163164 -> IndexedHeader -- ^ Indexed header of HTTP request.

164165 -> IO ByteString -- ^ source from client, for raw response

165166 -> Response -- ^ HTTP response including status code and response header.

166167 -> IO Bool -- ^ Returing True if the connection is persistent.

167−sendResponse conn ii req reqidxhdr src response = do

168+sendResponse defServer conn ii req reqidxhdr src response = do

168169 hs <- addServerAndDate hs0

169170 if hasBody s req then do

170171 sendRsp conn ver s hs rsp

@@ -181,7 +182,7 @@ sendResponse conn ii req reqidxhdr src response = do

181182 rspidxhdr = indexResponseHeader hs0

182183 th = threadHandle ii

183184 dc = dateCacher ii

184− addServerAndDate = addDate dc rspidxhdr . addServer rspidxhdr

185+ addServerAndDate = addDate dc rspidxhdr . addServer defServer rspidxhdr

185186 mRange = reqidxhdr ! idxRange

186187 reqinfo@(isPersist,_) = infoFromRequest req reqidxhdr

187188 (isKeepAlive, needsChunked) = infoFromResponse rspidxhdr reqinfo

@@ -389,9 +390,9 @@ warpVersion = showVersion Paths_warp.version

389390defaultServerValue :: HeaderValue

390391defaultServerValue = B.pack $ "Warp/" ++ warpVersion

391392

392−addServer :: IndexedHeader -> H.ResponseHeaders -> H.ResponseHeaders

393−addServer rspidxhdr hdrs = case rspidxhdr ! idxServer of

394− Nothing -> (hServer, defaultServerValue) : hdrs

393+addServer :: HeaderValue -> IndexedHeader -> H.ResponseHeaders -> H.ResponseHeaders

394+addServer defaultServerValue' rspidxhdr hdrs = case rspidxhdr ! idxServer of

395+ Nothing -> (hServer, defaultServerValue') : hdrs

395396 _ -> hdrs

396397

397398----------------------------------------------------------------

warp/Network/Wai/Handler/Warp/Run.hs+6−2

@@ -284,7 +284,9 @@ serveConnection conn ii addr isSecure' settings app = do

284284 sendErrorResponse istatus e = do

285285 status <- readIORef istatus

286286 when status $ void $

287− sendResponse conn ii dummyreq defaultIndexRequestHeader (return S.empty) (errorResponse e)

287+ sendResponse

288+ (settingsServerName settings)

289+ conn ii dummyreq defaultIndexRequestHeader (return S.empty) (errorResponse e)

288290

289291 dummyreq = defaultRequest { remoteHost = addr }

290292

@@ -306,7 +308,9 @@ serveConnection conn ii addr isSecure' settings app = do

306308 -- send more meaningful error messages to the user.

307309 -- However, it may affect performance.

308310 writeIORef istatus False

309− keepAlive <- sendResponse conn ii req idxhdr (readSource fromClient) res

311+ keepAlive <- sendResponse

312+ (settingsServerName settings)

313+ conn ii req idxhdr (readSource fromClient) res

310314 writeIORef keepAliveRef keepAlive

311315 return ResponseReceived

312316 keepAlive <- readIORef keepAliveRef

warp/Network/Wai/Handler/Warp/Settings.hs+9

@@ -18,6 +18,10 @@ import System.IO (stderr)

1818import System.IO.Error (ioeGetErrorType)

1919import qualified Data.Text.Lazy as TL

2020import qualified Data.Text.Lazy.Encoding as TLE

21+import Data.ByteString (ByteString)

22+import qualified Data.ByteString.Char8 as S8

23+import Data.Version (showVersion)

24+import qualified Paths_warp

2125

2226-- | Various Warp server settings. This is purposely kept as an abstract data

2327-- type so that new settings can be added without breaking backwards

@@ -57,6 +61,10 @@ data Settings = Settings

5761 --

5862 -- Since 2.0.3

5963 , settingsInstallShutdownHandler :: IO () -> IO ()

64+ , settingsServerName :: ByteString

65+ -- ^ Default server name if application does not set one.

66+ --

67+ -- Since 3.0.2

6068 }

6169

6270-- | The default settings for the Warp server. See the individual settings for

@@ -75,6 +83,7 @@ defaultSettings = Settings

7583 , settingsBeforeMainLoop = return ()

7684 , settingsNoParsePath = False

7785 , settingsInstallShutdownHandler = const $ return ()

86+ , settingsServerName = S8.pack $ "Warp/" ++ showVersion Paths_warp.version

7887 }

7988

8089-- | Apply the logic provided by 'defaultExceptionHandler' to determine if an

warp/warp.cabal+1−1

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

11Name: warp

2−Version: 3.0.1.1

2+Version: 3.0.2

33Synopsis: A fast, light-weight web server for WAI applications.

44License: MIT

55License-file: LICENSE