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
|
||||
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
|
||||
|
|
Loading…
Reference in New Issue
Block a user