Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion snap-server.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -111,7 +111,7 @@ Library
case-insensitive >= 0.3 && < 0.5,
containers >= 0.3 && < 0.5,
directory-tree >= 0.10 && < 0.11,
enumerator >= 0.4.13.1 && < 0.5,
enumerator >= 0.4.15 && < 0.5,
filepath >= 1.1 && < 1.4,
MonadCatchIO-transformers >= 0.2.1 && < 0.3,
mtl >= 2 && < 3,
Expand Down
12 changes: 9 additions & 3 deletions src/Snap/Internal/Http/Server.hs
Original file line number Diff line number Diff line change
Expand Up @@ -29,6 +29,7 @@ import qualified Data.ByteString.Char8 as SC
import qualified Data.ByteString.Lazy as L
import Data.ByteString.Internal (c2w, w2c)
import qualified Data.ByteString.Nums.Careless.Int as Cvt
import Data.Enumerator.Internal
import Data.Int
import Data.IORef
import Data.List (foldl')
Expand Down Expand Up @@ -238,7 +239,7 @@ logA' :: (ByteString -> IO ()) -> Request -> Response -> IO ()
logA' logger req rsp = do
let hdrs = rqHeaders req
let host = rqRemoteAddr req
let user = Nothing -- TODO we don't do authentication yet
let user = fst `fmap` rqBasicAuthentication req
let (v, v') = rqVersion req
let ver = S.concat [ "HTTP/", bshow v, ".", bshow v' ]
let method = toBS $ show (rqMethod req)
Expand Down Expand Up @@ -501,7 +502,8 @@ receiveRequest :: Iteratee ByteString IO () -> ServerMonad (Maybe Request)
receiveRequest writeEnd = do
debug "receiveRequest: entered"
mreq <- {-# SCC "receiveRequest/parseRequest" #-} lift $
iterateeDebugWrapper "parseRequest" parseRequest
iterateeDebugWrapper "parseRequest" $
joinI' $ takeNoMoreThan maxHeadersSize $$ parseRequest
debug "receiveRequest: parseRequest returned"

case mreq of
Expand All @@ -514,8 +516,12 @@ receiveRequest writeEnd = do

Nothing -> return Nothing


where
--------------------------------------------------------------------------
-- TODO(gdc): make this a policy decision (expose in
-- Snap.Http.Server.Config)
maxHeadersSize = 256 * 1024

--------------------------------------------------------------------------
-- check: did the client specify "transfer-encoding: chunked"? then we
-- have to honor that.
Expand Down
6 changes: 3 additions & 3 deletions test/snap-server-testsuite.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -35,7 +35,7 @@ Executable testsuite
containers,
directory,
directory-tree,
enumerator >= 0.4.13.1 && <0.5,
enumerator >= 0.4.15 && <0.5,
filepath,
http-enumerator >= 0.7.1.6 && <0.8,
HUnit >= 1.2 && < 2,
Expand Down Expand Up @@ -110,7 +110,7 @@ Executable pongserver
cereal >= 0.3 && < 0.4,
containers,
directory-tree,
enumerator >= 0.4.7 && <0.5,
enumerator >= 0.4.15 && <0.5,
filepath,
HUnit >= 1.2 && < 2,
mtl >= 2 && <3,
Expand Down Expand Up @@ -186,7 +186,7 @@ Executable testserver
case-insensitive >= 0.3 && < 0.5,
containers,
directory-tree,
enumerator >= 0.4.7 && <0.5,
enumerator >= 0.4.15 && <0.5,
filepath,
HUnit >= 1.2 && < 2,
MonadCatchIO-transformers >= 0.2.1 && < 0.3,
Expand Down