fixed a bug in readLoop that would cause the server hang while reading the request

This commit is contained in:
Jonathan Lamothe 2021-11-23 11:10:34 -05:00
parent 7b8a887b3c
commit 7126838eb0

View File

@ -97,8 +97,9 @@ strFromConn maxLen conn = do
Right s -> Just s
stripCRLF $ T.unpack txt
-- | Reads from a connection up to a maximum number of bytes,
-- returning 'Nothing' if the limit is exceeded
-- | Reads from a connection up to a maximum number of bytes or a
-- newline character is encountered, returning 'Nothing' if the limit
-- is exceeded
readMax
:: Int
-- ^ the maximum number of bytes
@ -117,13 +118,16 @@ stripCRLF :: String -> Maybe String
stripCRLF = undefined
readLoop :: Int -> S.InputStream BS.ByteString -> MaybeT IO Builder
readLoop maxLen src =
lift (S.read src) >>= \case
Nothing -> return mempty
Just bs -> do
let len = BS.length bs
when (len > maxLen) $
fail "maximum length exceeded"
(byteString bs <>) <$> readLoop (maxLen - len) src
readLoop maxLen src = lift (S.read src) >>= \case
Nothing -> return mempty
Just bs -> do
let
len = BS.length bs
b = byteString bs
when (len > maxLen) $
fail "maximum length exceeded"
if BS.any (== 0xa) bs
then return b
else (b <>) <$> readLoop (maxLen - len) src
--jl