1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
module Network.HTTP.Server.Mini.Parser where
import Control.Monad.Trans.Maybe
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Network.HTTP.Server.Mini.Types
readRequest :: Monad m => Int -> (Int -> m ByteString) -> m (Maybe Request)
readRequest maxsize recv = runMaybeT $ do
bs <- MaybeT $ readUntilTerminator maxsize recv []
hoistMaybe (parseRequest bs)
parseRequest :: ByteString -> Maybe Request
parseRequest = _
readUntilTerminator :: Monad m => Int -> (Int -> m ByteString) -> [ByteString] -> m (Maybe ByteString)
readUntilTerminator 0 _ _ = return Nothing
readUntilTerminator maxsize recv toprevprefix = do
text <- recv maxsize
if BS.length text == 0
then return Nothing
else goFind toprevprefix text
where
goFind revprefix text =
case findTerminator text of
NoTerm -> readUntilTerminator (maxsize - BS.length text) recv (text : revprefix)
IncompleteTerm haveCR
| maxsize == BS.length text -> return Nothing
| otherwise -> do
text2 <- recv (maxsize - BS.length text)
text2' <- case BS.length text2 of
1 -> (text2 <>) <$> recv (maxsize - BS.length text - 1) -- premature concat but rare
_ -> return text2 -- also for length 0 (i.e. EOF)!
-- now text2' has length at least 2 if available before EOF
case (haveCR, BS.length text2') of
(_, 0) -> return Nothing
(False, _) | text2' `BS.index` 0 == 10 -> return (Just (BS.concat (reverse revprefix)))
(False, n) | n >= 2, text2' `BS.index` 0 == 13, text2' `BS.index` 0 == 10 ->
return (Just (BS.concat (reverse revprefix)))
(True, _) | text2' `BS.index` 0 == 10 -> return (Just (BS.init (BS.concat (reverse revprefix))))
(_, 1) -> return Nothing -- second recv returned EOF and no terminator found before that
_ -> goFind (text : revprefix) text2'
FoundTerm i -> return (Just (BS.concat (reverse (BS.take i text : revprefix))))
data FoundTerminator
= NoTerm
| IncompleteTerm {-# UNPACK #-} !Bool
-- ^ Bool indicates "have CR".
-- If False, then LF at end of segment, requires LF or CRLF at start of next.
-- If True, then LF CR at end of segment, requires LF at start of next.
| FoundTerm Int -- ^ Index right after the first [CR]LF sequence in the terminator
deriving (Show)
findTerminator :: ByteString -> FoundTerminator
findTerminator bs =
-- We're looking for [CR] LF [CR] LF. Look for the first LF, and see if it's
-- followed by CRLF or LF.
go (BS.elemIndices 10 bs)
where
len = BS.length bs
go [] = NoTerm
go (i:is)
| i == len - 1 = IncompleteTerm False
| i == len - 2 =
case bs `BS.index` (i+1) of
10 -> FoundTerm (i+1)
13 -> IncompleteTerm True
_ -> NoTerm
-- now certainly two bytes after this LF
| otherwise =
case bs `BS.index` (i+1) of
10 -> FoundTerm (i+1)
-- [i+2] is read twice if this check fails, but LF CR (!=LF) will be very rare so it's fine
13 | bs `BS.index` (i+2) == 10 -> FoundTerm (i+1)
_ -> go is
|
