git.iko.soy/typeable/attoparsec
on master help sign in
Introduce a Buffer type for ByteString parsing

This type supports fast, asymptotically well behaved appends, which becomes important when we're asking for more input if a parse doesn't succeed. The previous "append to a ByteString" scheme degraded to O(n^2) performance if fed a byte at a time, and so acted as a conveniently obscure DoS vector. This approach gets us to O(n log n). --HG-- extra : rebase_source : 170f7d61e782a3c3fd21820d8bb8725129e2d35f extra : histedit_source : 702bc956782b3233ed656508dd89eb55dcc53d6a

commit12edcc69f0d30a54acc1396c51074ffc527eee6b authorBryan O'Sullivan <bos@serpentine.com> dateMon 19 May 2014, 20:28 (12 years ago) parentb500eee
3 files changed+136−26
compare with master
unifiedsplit
Data/Attoparsec/ByteString/Buffer.hs+107 Data/Attoparsec/ByteString/Internal.hs+27−25 attoparsec.cabal+2−1
Data/Attoparsec/ByteString/Buffer.hsnew file+107
@@ -0,0 +1,107 @@
1+-- |
2+-- Module : Data.Attoparsec.ByteString.Buffer
3+-- Copyright : Bryan O'Sullivan 2007-2014
4+-- License : BSD3
5+--
6+-- Maintainer : bos@serpentine.com
7+-- Stability : experimental
8+-- Portability : GHC
9+--
10+-- An immutable buffer that supports cheap appends.
11+
12+-- A Buffer is divided into an immutable read-only zone, followed by a
13+-- mutable area that we've preallocated, but not yet written to.
14+--
15+-- We overallocate at the end of a Buffer so that we can cheaply
16+-- append. Since a user of an existing Buffer cannot see past the end
17+-- of its immutable zone into the data that will change during an
18+-- append, this is safe.
19+--
20+-- Once we run out of space at the end of a Buffer, we do the usual
21+-- doubling of the buffer size.
22+
23+module Data.Attoparsec.ByteString.Buffer
24+ (
25+ Buffer
26+ , buffer
27+ , unbuffer
28+ , length
29+ , unsafeIndex
30+ , substring
31+ , unsafeDrop
32+ ) where
33+
34+import Control.Exception (assert)
35+import Data.Attoparsec.ByteString.Fhthagn (inlinePerformIO)
36+import Data.ByteString.Internal (ByteString(..), memcpy, nullForeignPtr)
37+import Data.Monoid (Monoid(..))
38+import Data.Word (Word8)
39+import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
40+import Foreign.Ptr (plusPtr)
41+import Foreign.Storable (peekByteOff)
42+import GHC.ForeignPtr (mallocPlainForeignPtrBytes)
43+import Prelude hiding (length)
44+
45+data Buffer = Buf {
46+ _fp :: {-# UNPACK #-} !(ForeignPtr Word8)
47+ , _off :: {-# UNPACK #-} !Int
48+ , _len :: {-# UNPACK #-} !Int
49+ , _cap :: {-# UNPACK #-} !Int
50+ }
51+
52+instance Show Buffer where
53+ showsPrec p = showsPrec p . unbuffer
54+
55+-- | The initial 'Buffer' has no mutable zone, so we can avoid all
56+-- copies in the (hopefully) common case of no further input being fed
57+-- to us.
58+buffer :: ByteString -> Buffer
59+buffer (PS fp off len) = Buf fp off len len
60+
61+unbuffer :: Buffer -> ByteString
62+unbuffer (Buf fp off len _cap) = PS fp off len
63+
64+instance Monoid Buffer where
65+ mempty = Buf nullForeignPtr 0 0 0
66+
67+ mappend (Buf _ _ _ 0) b = b
68+ mappend a (Buf _ _ _ 0) = a
69+ mappend (Buf fp0 off0 len0 cap0) (Buf fp1 off1 len1 _cap1) =
70+ inlinePerformIO . withForeignPtr fp0 $ \ptr0 ->
71+ withForeignPtr fp1 $ \ptr1 -> do
72+ let newlen = len0 + len1
73+ if newlen <= cap0
74+ then do
75+ memcpy (ptr0 `plusPtr` (off0+len0))
76+ (ptr1 `plusPtr` off1)
77+ len1
78+ return (Buf fp0 off0 newlen cap0)
79+ else do
80+ let newcap = newlen * 2
81+ fp <- mallocPlainForeignPtrBytes newcap
82+ withForeignPtr fp $ \ptr -> do
83+ memcpy ptr (ptr0 `plusPtr` off0) len0
84+ memcpy (ptr `plusPtr` len0) (ptr1 `plusPtr` off1) len1
85+ return (Buf fp 0 newlen newcap)
86+
87+length :: Buffer -> Int
88+length (Buf _ _ len _) = len
89+{-# INLINE length #-}
90+
91+unsafeIndex :: Buffer -> Int -> Word8
92+unsafeIndex (Buf fp off len _cap) i = assert (i >= 0 && i < len) .
93+ inlinePerformIO . withForeignPtr fp $ flip peekByteOff (off+i)
94+{-# INLINE unsafeIndex #-}
95+
96+substring :: Int -> Int -> Buffer -> ByteString
97+substring s l (Buf fp off len _cap) =
98+ assert (s >= 0 && s <= len) .
99+ assert (l >= 0 && l <= len-s) $
100+ PS fp (off+s) l
101+{-# INLINE substring #-}
102+
103+unsafeDrop :: Int -> Buffer -> ByteString
104+unsafeDrop s (Buf fp off len _cap) =
105+ assert (s >= 0 && s <= len) $
106+ PS fp (off+s) (len-s)
107+{-# INLINE unsafeDrop #-}
Data/Attoparsec/ByteString/Internal.hs+27−25
@@ -67,16 +67,18 @@ module Data.Attoparsec.ByteString.Internal
6767
6868import Control.Applicative ((<|>), (<$>))
6969import Control.Monad (when)
70+import Data.Attoparsec.ByteString.Buffer (Buffer, buffer)
7071import Data.Attoparsec.ByteString.FastSet (charClass, memberWord8)
7172import Data.Attoparsec.ByteString.Fhthagn (inlinePerformIO)
7273import Data.Attoparsec.Combinator ((<?>))
7374import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success)
75+import Data.ByteString (ByteString)
7476import Data.Word (Word8)
7577import Foreign.ForeignPtr (withForeignPtr)
7678import Foreign.Ptr (castPtr, minusPtr, plusPtr)
7779import Foreign.Storable (Storable(peek, sizeOf))
7880import Prelude hiding (getChar, succ, take, takeWhile)
79−import Data.ByteString (ByteString)
81+import qualified Data.Attoparsec.ByteString.Buffer as Buf
8082import qualified Data.Attoparsec.Internal.Types as T
8183import qualified Data.ByteString as B8
8284import qualified Data.ByteString.Char8 as B
@@ -84,10 +86,10 @@ import qualified Data.ByteString.Internal as B
8486import qualified Data.ByteString.Lazy as L
8587import qualified Data.ByteString.Unsafe as B
8688
87−type Parser = T.Parser B.ByteString B.ByteString
88−type Result = IResult B.ByteString B.ByteString
89−type Failure r = T.Failure B.ByteString B.ByteString r
90−type Success a r = T.Success B.ByteString B.ByteString a r
89+type Parser = T.Parser B.ByteString Buffer
90+type Result = IResult B.ByteString Buffer
91+type Failure r = T.Failure B.ByteString Buffer r
92+type Success a r = T.Success B.ByteString Buffer a r
9193
9294-- | The parser @satisfy p@ succeeds for any byte for which the
9395-- predicate @p@ returns 'True'. Returns the byte that is actually
@@ -373,13 +375,13 @@ notWord8 c = satisfy (/= c) <?> "not " ++ show c
373375peekWord8 :: Parser (Maybe Word8)
374376peekWord8 = T.Parser $ \t pos@(Pos pos_) more _lose succ ->
375377 case () of
376− _| pos_ < B.length t ->
377− let !w = B.unsafeIndex t pos_
378+ _| pos_ < Buf.length t ->
379+ let !w = Buf.unsafeIndex t pos_
378380 in succ t pos more (Just w)
379381 | more == Complete ->
380382 succ t pos more Nothing
381383 | otherwise ->
382− let succ' t' pos' more' = let !w = B.unsafeIndex t pos_
384+ let succ' t' pos' more' = let !w = Buf.unsafeIndex t pos_
383385 in succ t' pos' more' (Just w)
384386 lose' t' pos' more' = succ t' pos' more' Nothing
385387 in prompt t pos more lose' succ'
@@ -390,7 +392,7 @@ peekWord8 = T.Parser $ \t pos@(Pos pos_) more _lose succ ->
390392peekWord8' :: Parser Word8
391393peekWord8' = T.Parser $ \t pos more lose succ ->
392394 if lengthAtLeast pos 1 t
393− then succ t pos more (B.unsafeIndex t (fromPos pos))
395+ then succ t pos more (Buf.unsafeIndex t (fromPos pos))
394396 else let succ' t' pos' more' bs' = succ t' pos' more' $! B.unsafeHead bs'
395397 in ensureSuspended 1 t pos more lose succ'
396398{-# INLINE peekWord8' #-}
@@ -402,22 +404,22 @@ endOfLine = (word8 10 >> return ()) <|> (string "\r\n" >> return ())
402404
403405-- | Terminal failure continuation.
404406failK :: Failure a
405−failK t (Pos pos) _more stack msg = Fail (B.unsafeDrop pos t) stack msg
407+failK t (Pos pos) _more stack msg = Fail (Buf.unsafeDrop pos t) stack msg
406408{-# INLINE failK #-}
407409
408410-- | Terminal success continuation.
409411successK :: Success a a
410−successK t (Pos pos) _more a = Done (B.unsafeDrop pos t) a
412+successK t (Pos pos) _more a = Done (Buf.unsafeDrop pos t) a
411413{-# INLINE successK #-}
412414
413415-- | Run a parser.
414416parse :: Parser a -> B.ByteString -> Result a
415−parse m s = T.runParser m s (Pos 0) Incomplete failK successK
417+parse m s = T.runParser m (buffer s) (Pos 0) Incomplete failK successK
416418{-# INLINE parse #-}
417419
418420-- | Run a parser that cannot be resupplied via a 'Partial' result.
419421parseOnly :: Parser a -> B.ByteString -> Either String a
420−parseOnly m s = case T.runParser m s (Pos 0) Complete failK successK of
422+parseOnly m s = case T.runParser m (buffer s) (Pos 0) Complete failK successK of
421423 Fail _ _ err -> Left err
422424 Done _ a -> Right a
423425 _ -> error "parseOnly: impossible error!"
@@ -425,12 +427,12 @@ parseOnly m s = case T.runParser m s (Pos 0) Complete failK successK of
425427
426428get :: Parser ByteString
427429get = T.Parser $ \t pos more _lose succ ->
428− succ t pos more (B.unsafeDrop (fromPos pos) t)
430+ succ t pos more (Buf.unsafeDrop (fromPos pos) t)
429431{-# INLINE get #-}
430432
431433endOfChunk :: Parser Bool
432434endOfChunk = T.Parser $ \t pos more _lose succ ->
433− succ t pos more (fromPos pos == B.length t)
435+ succ t pos more (fromPos pos == Buf.length t)
434436{-# INLINE endOfChunk #-}
435437
436438advance :: Int -> Parser ()
@@ -438,7 +440,7 @@ advance n = T.Parser $ \t pos more _lose succ ->
438440 succ t (pos + Pos n) more ()
439441{-# INLINE advance #-}
440442
441−ensureSuspended :: Int -> ByteString -> Pos -> More
443+ensureSuspended :: Int -> Buffer -> Pos -> More
442444 -> Failure r
443445 -> Success ByteString r
444446 -> Result r
@@ -462,14 +464,14 @@ ensure n = T.Parser $ \t pos more lose succ ->
462464
463465-- | Ask for input. If we receive any, pass it to a success
464466-- continuation, otherwise to a failure continuation.
465−prompt :: ByteString -> Pos -> More
466− -> (ByteString -> Pos -> More -> IResult ByteString ByteString r)
467− -> (ByteString -> Pos -> More -> IResult ByteString ByteString r)
468− -> IResult ByteString ByteString r
467+prompt :: Buffer -> Pos -> More
468+ -> (Buffer -> Pos -> More -> IResult ByteString Buffer r)
469+ -> (Buffer -> Pos -> More -> IResult ByteString Buffer r)
470+ -> IResult ByteString Buffer r
469471prompt t pos _more lose succ = Partial $ \s ->
470472 if B.null s
471473 then lose t pos Complete
472− else succ (t <> s) pos Incomplete
474+ else succ (t <> buffer s) pos Incomplete
473475
474476-- | Immediately demand more input via a 'Partial' continuation
475477-- result.
@@ -519,10 +521,10 @@ atEnd :: Parser Bool
519521atEnd = not <$> wantInput
520522{-# INLINE atEnd #-}
521523
522−lengthAtLeast :: Pos -> Int -> ByteString -> Bool
523−lengthAtLeast (Pos pos) n bs = B.length bs >= pos + n
524+lengthAtLeast :: Pos -> Int -> Buffer -> Bool
525+lengthAtLeast (Pos pos) n bs = Buf.length bs >= pos + n
524526{-# INLINE lengthAtLeast #-}
525527
526−substring :: Pos -> Pos -> ByteString -> ByteString
527−substring (Pos pos) (Pos n) bs = B.unsafeTake n (B.unsafeDrop pos bs)
528+substring :: Pos -> Pos -> Buffer -> ByteString
529+substring (Pos pos) (Pos n) = Buf.substring pos n
528530{-# INLINE substring #-}
attoparsec.cabal+2−1
@@ -62,7 +62,8 @@ library
6262 Data.Attoparsec.Text.Lazy
6363 Data.Attoparsec.Types
6464 Data.Attoparsec.Zepto
65− other-modules: Data.Attoparsec.ByteString.FastSet
65+ other-modules: Data.Attoparsec.ByteString.Buffer
66+ Data.Attoparsec.ByteString.FastSet
6667 Data.Attoparsec.ByteString.Fhthagn
6768 Data.Attoparsec.ByteString.Internal
6869 Data.Attoparsec.Internal