snap-server 0.2.15.1 → 0.2.16

raw patch · 4 files changed

+48/−43 lines, 4 filesdep +binarydep +vector-algorithmsdep ~snap-core

Dependencies added: binary, vector-algorithms

Dependency ranges changed: snap-core

Files

• snap-server.cabal +5/−3
• src/Snap/Internal/Http/Server.hs +33/−36
• test/pongserver/Main.hs +2/−1
• test/snap-server-testsuite.cabal +8/−3

@@ -1,5 +1,5 @@ name:           snap-server-version:        0.2.15.1+version:        0.2.16 synopsis:       A fast, iteratee-based, epoll-enabled web server for the Snap Framework description:   This is the first developer prerelease of the Snap framework.  Snap is a@@ -109,6 +109,7 @@     attoparsec >= 0.8.1 && < 0.9,     attoparsec-iteratee >= 0.1.1 && <0.2,     base >= 4 && < 5,+    binary >=0.5 && <0.6,     bytestring,     bytestring-nums,     bytestring-show >= 0.3.2 && < 0.4,@@ -122,12 +123,13 @@     murmur-hash >= 0.1 && < 0.2,     network == 2.2.1.*,     old-locale,-    snap-core == 0.2.15.1,+    snap-core == 0.2.16,     template-haskell,     time,     transformers,     unix-compat,-    vector >= 0.7 && <0.8+    vector >= 0.7 && <0.8,+    vector-algorithms >= 0.3.4 && <0.4    if flag(portable) || os(windows)     cpp-options: -DPORTABLE

@@ -13,6 +13,7 @@ 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.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 @@   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 @@       ---------------------------------------------------------------------------    fmtHdrs hdrs =-        {-# SCC "fmtHdrs" #-}-        concat xs+    putHdrs hdrs =+        {-# SCC "putHdrs" #-}+        mapM_ putHeader $ Map.toList hdrs       where-        xs = map f $ Map.toList hdrs--        f (k, ys) = map (g k) ys+        putHeader (k, ys) = mapM_ (putOne 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 @@      --------------------------------------------------------------------------     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 ()@@ -816,10 +818,5 @@ ------------------------------------------------------------------------------ toBS :: String -> ByteString toBS = S.pack . map c2w------------------------------------------------------------------------------bsshow :: (Show a) => a -> ByteString-bsshow = l2s . show  

@@ -26,5 +26,6 @@    where     go m = do-        httpServe "*" 3000 "localhost" Nothing Nothing pongServer +        httpServe "*" 3000 "localhost" (Just "foo.log") Nothing pongServer +        --httpServe "*" 3000 "localhost" Nothing Nothing pongServer          putMVar m ()

@@ -47,7 +47,8 @@      test-framework-quickcheck2 >= 0.2.6 && < 0.3,      time,      transformers,-     vector >= 0.7 && <0.8+     vector >= 0.7 && <0.8,+     vector-algorithms >= 0.3.4 && <0.4     if !os(windows)      build-depends: unix@@ -103,8 +104,10 @@      time,      transformers,      unix-compat,-     vector >= 0.7 && <0.8+     vector >= 0.7 && <0.8,+     vector-algorithms >= 0.3.4 && <0.4 +    if flag(portable) || os(windows)      cpp-options: -DPORTABLE    else@@ -182,7 +185,9 @@      test-framework-quickcheck2 >= 0.2.6 && < 0.3,      time,      transformers,-     vector >= 0.7 && <0.8+     vector >= 0.7 && <0.8,+     vector-algorithms >= 0.3.4 && <0.4+     if !os(windows)      build-depends: unix