@@ -16,9 +16,10 @@ module Data.Aeson.Parser
1616 ) where
1717
1818import Control.Applicative as A
19+import Control.Monad (when)
1920import Data.Aeson.Types (Value(..))
2021import Data.Attoparsec.Char8
21−import Data.Bits (shiftL)
22+import Data.Bits ((.|.), shiftL)
2223import Data.ByteString as B
2324import Data.Char (chr)
2425import Data.Map as Map
@@ -27,6 +28,7 @@ import Data.Text.Encoding (decodeUtf8, encodeUtf8)
2728import Data.Vector as Vector hiding ((++))
2829import Data.Word (Word8)
2930import qualified Data.Attoparsec as A
31+import qualified Data.ByteString.Unsafe as B
3032
3133-- | Parse a top-level JSON value. This must be either an object or
3234-- an array.
@@ -96,18 +98,42 @@ unescape = Prelude.reverse <$> go [] where
9698 let backslash = 92
9799 h <- A.takeWhile (/=backslash)
98100 let rest = do
99− w <- A.word8 backslash *> A.satisfy (`B.elem` "\"\\/ntbrfu")
100− case B.findIndex (==w) "\"\\/ntbrf" of
101− Just i -> go (B.singleton (B.index "\"\\/\n\t\b\r\f" i):h:acc)
102− Nothing -> do
103− a <- reparse hexadecimal =<< A.take 4
101+ start <- A.take 2
102+ let !slash = B.unsafeHead start
103+ !t = B.unsafeIndex start 1
104+ escape = case B.findIndex (==t) "\"\\/ntbrfu" of
105+ Just i -> i
106+ _ -> 255
107+ when (slash /= backslash || escape == 255) $
108+ fail "bad escape sequence"
109+ if t /= 117 -- 'u'
110+ then go (B.singleton (B.unsafeIndex mapping escape):h:acc)
111+ else do
112+ a <- hexQuad
104113 if a < 0xd800 || a > 0xdfff
105114 then go (encodeUtf8 (T.singleton . chr $ a):h:acc)
106115 else do
107− b <- string "\\u" *> (reparse hexadecimal =<< A.take 4)
116+ b <- string "\\u" *> hexQuad
108117 if a <= 0xdbff && b >= 0xdc00 && b <= 0xdfff
109− then let c = ((a - 0xd800) `shiftL` 10) + (b - 0xdc00) +
110− 0x10000
111− in go (encodeUtf8 (T.singleton . chr $ c):h:acc)
118+ then let !c = ((a - 0xd800) `shiftL` 10) + (b - 0xdc00) +
119+ 0x10000
120+ in go (encodeUtf8 (T.singleton (chr c)):h:acc)
112121 else fail "invalid UTF-16 surrogates"
113122 rest <|> return (h:acc)
123+ mapping = "\"\\/\n\t\b\r\f"
124+
125+hexQuad :: Parser Int
126+hexQuad = do
127+ s <- A.take 4
128+ let hex n | w >= 48 && w <= 57 = w - 48
129+ | w >= 97 && w <= 122 = w - 87
130+ | w >= 65 && w <= 90 = w - 55
131+ | otherwise = 255
132+ where w = fromIntegral $ B.unsafeIndex s n
133+ a = hex 0
134+ b = hex 1
135+ c = hex 2
136+ d = hex 3
137+ if (a .|. b .|. c .|. d) /= 255
138+ then return $! d .|. (c `shiftL` 4) .|. (b `shiftL` 8) .|. (a `shiftL` 12)
139+ else fail "invalid hex escape"