fixed a bug in readLoop that would cause the server hang while reading the request
This commit is contained in:
parent
7b8a887b3c
commit
7126838eb0
|
@ -97,8 +97,9 @@ strFromConn maxLen conn = do
|
||||||
Right s -> Just s
|
Right s -> Just s
|
||||||
stripCRLF $ T.unpack txt
|
stripCRLF $ T.unpack txt
|
||||||
|
|
||||||
-- | Reads from a connection up to a maximum number of bytes,
|
-- | Reads from a connection up to a maximum number of bytes or a
|
||||||
-- returning 'Nothing' if the limit is exceeded
|
-- newline character is encountered, returning 'Nothing' if the limit
|
||||||
|
-- is exceeded
|
||||||
readMax
|
readMax
|
||||||
:: Int
|
:: Int
|
||||||
-- ^ the maximum number of bytes
|
-- ^ the maximum number of bytes
|
||||||
|
@ -117,13 +118,16 @@ stripCRLF :: String -> Maybe String
|
||||||
stripCRLF = undefined
|
stripCRLF = undefined
|
||||||
|
|
||||||
readLoop :: Int -> S.InputStream BS.ByteString -> MaybeT IO Builder
|
readLoop :: Int -> S.InputStream BS.ByteString -> MaybeT IO Builder
|
||||||
readLoop maxLen src =
|
readLoop maxLen src = lift (S.read src) >>= \case
|
||||||
lift (S.read src) >>= \case
|
Nothing -> return mempty
|
||||||
Nothing -> return mempty
|
Just bs -> do
|
||||||
Just bs -> do
|
let
|
||||||
let len = BS.length bs
|
len = BS.length bs
|
||||||
when (len > maxLen) $
|
b = byteString bs
|
||||||
fail "maximum length exceeded"
|
when (len > maxLen) $
|
||||||
(byteString bs <>) <$> readLoop (maxLen - len) src
|
fail "maximum length exceeded"
|
||||||
|
if BS.any (== 0xa) bs
|
||||||
|
then return b
|
||||||
|
else (b <>) <$> readLoop (maxLen - len) src
|
||||||
|
|
||||||
--jl
|
--jl
|
||||||
|
|
Loading…
Reference in New Issue
Block a user