This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "snap-server".
The branch, master has been updated
via 04aab67f9c9a723d913d0c46174e48629bd55dda (commit)
via 033d48c24bd20f4c8a99c447d1be4d2d342b033f (commit)
from 85cc0463ab63a861176afda2e5bfdca2fe2d1930 (commit)
Summary of changes:
src/Snap/Internal/Http/Server.hs | 69 ++++++++++++++++++--------------------
1 files changed, 33 insertions(+), 36 deletions(-)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 04aab67f9c9a723d913d0c46174e48629bd55dda
Merge: 85cc046 033d48c
Author: Gregory Collins <[email protected]>
Date: Thu Oct 28 01:16:36 2010 +0200
Merge branch '0.2-stable'
commit 033d48c24bd20f4c8a99c447d1be4d2d342b033f
Author: Gregory Collins <[email protected]>
Date: Thu Oct 28 01:16:01 2010 +0200
Revert "Back out last change to .Server; it isn't faster"
Turns out -- it is faster, quite a bit -- we were accidentally benching the
wrong backend.
This reverts commit 148f2d54cfdca0667cebf7f32d5e3e3421e0bbc7.
diff --git a/src/Snap/Internal/Http/Server.hs b/src/Snap/Internal/Http/Server.hs
index c73d367..2683a97 100644
--- a/src/Snap/Internal/Http/Server.hs
+++ b/src/Snap/Internal/Http/Server.hs
@@ -13,6 +13,7 @@ import Control.Concurrent.MVar
import Control.Exception
import Data.Char
import Data.CIByteString
+import Data.Binary.Put
import Data.ByteString (ByteString)
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as SC
@@ -41,7 +42,7 @@ import Snap.Internal.Http.Types hiding (Enumerator)
import Snap.Internal.Http.Parser
import Snap.Internal.Http.Server.Date
import Snap.Internal.Iteratee.Debug
-import Snap.Iteratee hiding (foldl', head, take, FileOffset)
+import Snap.Iteratee hiding (foldl', head, take, mapM_, FileOffset)
import qualified Snap.Iteratee as I
#ifdef LIBEV
@@ -420,12 +421,13 @@ checkExpect100Continue req writeEnd = do
where
go = do
let (major,minor) = rqVersion req
- let hl = [ "HTTP/"
- , bsshow major
- , "."
- , bsshow minor
- , " 100 Continue\r\n\r\n" ]
- iter <- liftIO $ enumBS (S.concat hl) writeEnd
+ let hl = runPut $ do
+ putByteString "HTTP/"
+ showp major
+ putAscii '.'
+ showp minor
+ putByteString " 100 Continue\r\n\r\n"
+ iter <- liftIO $ enumLBS hl writeEnd
liftIO $ run iter
@@ -660,15 +662,17 @@ sendResponse req rsp' writeEnd onSendFile = do
--------------------------------------------------------------------------
- fmtHdrs hdrs =
- {-# SCC "fmtHdrs" #-}
- concat xs
+ putHdrs hdrs =
+ {-# SCC "putHdrs" #-}
+ mapM_ putHeader $ Map.toList hdrs
where
- xs = map f $ Map.toList hdrs
+ putHeader (k, ys) = mapM_ (putOne k) ys
- f (k, ys) = map (g k) ys
-
- g k y = S.concat [ unCI k, ": ", y, "\r\n" ]
+ putOne k y = do
+ putByteString $ unCI k
+ putByteString ": "
+ putByteString y
+ putByteString "\r\n"
--------------------------------------------------------------------------
@@ -759,24 +763,22 @@ sendResponse req rsp' writeEnd onSendFile = do
--------------------------------------------------------------------------
mkHeaderString :: Response -> ByteString
- mkHeaderString r =
- {-# SCC "mkHeaderString" #-}
- S.concat $ concat [hl, hdr, eol]
+ mkHeaderString r = out
where
- hl = [ "HTTP/"
- , bsshow major
- , "."
- , bsshow minor
- , " "
- , bsshow $ rspStatus r
- , " "
- , rspStatusReason r
- , "\r\n" ]
-
- hdr = fmtHdrs $ headers r
-
- eol = ["\r\n"]
-
+ !out = {-# SCC "mkHeaderString" #-}
+ S.concat $ L.toChunks $ runPut $ do
+ putByteString "HTTP/"
+ showp major
+ putAscii '.'
+ showp minor
+ putAscii ' '
+ showp $ rspStatus r
+ putAscii ' '
+ putByteString $ rspStatusReason r
+ putByteString "\r\n"
+ putHdrs $ headers r
+ putByteString "\r\n"
+
------------------------------------------------------------------------------
checkConnectionClose :: (Int, Int) -> Headers -> ServerMonad ()
@@ -818,8 +820,3 @@ toBS :: String -> ByteString
toBS = S.pack . map c2w
---------------------------------------------------------------------------
-bsshow :: (Show a) => a -> ByteString
-bsshow = l2s . show
-
-
-----------------------------------------------------------------------
hooks/post-receive
--
snap-server
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
