diff --git a/Data/JsonStream/CLexer.hs b/Data/JsonStream/CLexer.hs --- a/Data/JsonStream/CLexer.hs +++ b/Data/JsonStream/CLexer.hs @@ -7,7 +7,6 @@ module Data.JsonStream.CLexer ( tokenParser , unescapeText - , mapLeft ) where import Control.Applicative ((<$>)) @@ -15,20 +14,17 @@ import qualified Data.Aeson as AE import qualified Data.ByteString as BSW import qualified Data.ByteString.Char8 as BS -import qualified Data.ByteString.Internal as BS import Data.ByteString.Unsafe (unsafeUseAsCString) -import qualified Data.ByteString.Unsafe as BS import Data.Scientific (Scientific, scientific) import Data.Text.Encoding (decodeUtf8') import Data.Text.Internal.Unsafe (inlinePerformIO) import Foreign -import Foreign.C.String import Foreign.C.Types -import System.IO.Unsafe (unsafeDupablePerformIO, - unsafePerformIO) +import System.IO.Unsafe (unsafeDupablePerformIO) import Data.JsonStream.CLexType import Data.JsonStream.TokenParser (Element (..), TokenResult (..)) +import Data.JsonStream.Unescape -- | Limit for maximum size of a number; fail if larger number is found -- this is needed to make this constant-space, otherwise we would eat @@ -120,29 +116,6 @@ , tmpNumbers :: [BS.ByteString] } -foreign import ccall unsafe "bs_json_unescape" bs_json_unescape :: CULong -> Ptr CInt -> CString -> CString -> IO () - -unescapeText :: BS.ByteString -> Either String BS.ByteString -unescapeText bs = - unsafePerformIO $ - do let len = BS.length bs - outBsPtr <- BS.mallocByteString len - (outBs, errCode) <- - withForeignPtr outBsPtr $ \ptr -> - alloca $ \errCode -> - BS.unsafeUseAsCString bs $ \inBs -> - do bs_json_unescape (fromIntegral len) errCode inBs ptr - code <- peek errCode - bs' <- BS.unsafePackCString ptr - return (bs', code) - return $ if errCode /= 0 - then Left ("Invalid escape sequence. ErrNo=" ++ show errCode) - else Right outBs - -mapLeft :: (a -> b) -> Either a c -> Either b c -mapLeft _ (Right v) = Right v -mapLeft f (Left v) = Left (f v) - -- | Parse number from bytestring to Scientific using JSON syntax rules parseNumber :: BS.ByteString -> Maybe Scientific parseNumber tnumber = do @@ -239,9 +212,9 @@ Right ctext -> PartialResult (JValue (AE.String ctext)) next Left _ -> TokFailed | resAddData == 0 -> -- One-part string with escaped characters - case unescapeText textSection >>= (mapLeft show . decodeUtf8') of + case unescapeText textSection of Right ctext -> PartialResult (JValue (AE.String ctext)) next - Left _ -> TokFailed + _ -> TokFailed | otherwise -> PartialResult (StringContent textSection) -- Final part of partial strings (PartialResult StringEnd next) | resType == resStringPartial -> @@ -267,4 +240,4 @@ tokenParser :: BS.ByteString -> TokenResult tokenParser dta = getNextResult (TempData dta newhdr False []) where - newhdr = defHeader{hdrLength=fromIntegral (BS.length dta), hdrResultLimit=(estResultLimit dta)} + newhdr = defHeader{hdrLength=fromIntegral (BS.length dta), hdrResultLimit=estResultLimit dta} diff --git a/Data/JsonStream/Parser.hs b/Data/JsonStream/Parser.hs --- a/Data/JsonStream/Parser.hs +++ b/Data/JsonStream/Parser.hs @@ -81,13 +81,11 @@ import Data.Scientific (Scientific, isInteger, toBoundedInteger, toRealFloat) import qualified Data.Text as T -import Data.Text.Encoding (decodeUtf8') import qualified Data.Vector as Vec import Data.JsonStream.CLexer import Data.JsonStream.TokenParser - -- | Limit for the size of an object key objectKeyStringLimit :: Int objectKeyStringLimit = 65536 @@ -291,7 +289,7 @@ getLongKey acc !len _ el ntok = case el of StringEnd - | Right key <- unescapeText (BS.concat $ reverse acc) >>= (mapLeft show . decodeUtf8') -> + | Right key <- unescapeText (BS.concat $ reverse acc) -> callParse (valparse key) ntok | otherwise -> Failed "Error decoding UTF8" StringContent str @@ -360,7 +358,7 @@ -- | Match a possibly bounded string roughly limited by a limit longString :: Maybe Int -> Parser T.Text -longString mbounds = Parser $ moreData (handle [] 0) +longString mbounds = Parser $ moreData (handle (BS.empty :) 0) where handle acc !len tok el ntok = case el of @@ -368,9 +366,9 @@ StringContent str | (Just bounds) <- mbounds, len > bounds -- If the string exceeds bounds, discard it -> callParse (ignoreStrRestThen (Parser $ Done "")) ntok - | otherwise -> moreData (handle (str:acc) (len + BS.length str)) ntok + | otherwise -> moreData (handle (acc . (str:)) (len + BS.length str)) ntok StringEnd - | Right val <- unescapeText (BS.concat $ reverse acc) >>= (mapLeft show . decodeUtf8') + | Right val <- unescapeText (BS.concat (acc [])) -> Yield val (Done "" ntok) | otherwise -> Failed "Error decoding UTF8" _ -> callParse ignoreVal tok diff --git a/Data/JsonStream/Unescape.hs b/Data/JsonStream/Unescape.hs new file mode 100644 --- /dev/null +++ b/Data/JsonStream/Unescape.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnliftedFFITypes #-} + +module Data.JsonStream.Unescape ( + unescapeText +) where + +import Control.Exception (evaluate, throw, try) +import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO) +import Data.ByteString as B +import Data.ByteString.Internal as B hiding (c2w) +import qualified Data.Text.Array as A +import Data.Text.Encoding.Error (UnicodeException (..)) +import Data.Text.Internal (Text (..)) +import Data.Text.Internal.Private (runText) +import Data.Text.Unsafe (unsafeDupablePerformIO) +import Data.Word (Word8) +import Foreign.C.Types (CInt (..), CSize (..)) +import Foreign.ForeignPtr (withForeignPtr) +import Foreign.Marshal.Utils (with) +import Foreign.Ptr (Ptr, plusPtr) +import Foreign.Storable (peek) +import GHC.Base (MutableByteArray#) + +foreign import ccall unsafe "_js_decode_string" c_js_decode + :: MutableByteArray# s -> Ptr CSize + -> Ptr Word8 -> Ptr Word8 -> IO CInt + +unescapeText' :: ByteString -> Text +unescapeText' (PS fp off len) = runText $ \done -> do + let go dest = withForeignPtr fp $ \ptr -> + with (0::CSize) $ \destOffPtr -> do + let end = ptr `plusPtr` (off + len) + loop curPtr = do + res <- c_js_decode (A.maBA dest) destOffPtr curPtr end + case res of + 0 -> do + n <- peek destOffPtr + unsafeSTToIO (done dest (fromIntegral n)) + _ -> + throw (DecodeError desc Nothing) + loop (ptr `plusPtr` off) + (unsafeIOToST . go) =<< A.new len + where + desc = "Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream" +{-# INLINE unescapeText' #-} + +unescapeText :: ByteString -> Either UnicodeException Text +unescapeText = unsafeDupablePerformIO . try . evaluate . unescapeText' +{-# INLINE unescapeText #-} diff --git a/c_lib/unescape_string.c b/c_lib/unescape_string.c --- a/c_lib/unescape_string.c +++ b/c_lib/unescape_string.c @@ -1,132 +1,169 @@ -/** - * Copied from https://github.com/agrafix/highjson project. - */ +#include +#include +#include -#include -void bs_json_unescape(const unsigned long length, int *error, char *bsIn, char *bsOut); +#define UTF8_ACCEPT 0 +#define UTF8_REJECT 12 -inline void private_parse_hex(const char a, const char b, const char c, const char d, int *number, short *error) { - const char hex[5] = { a, b, c, d, '\0' }; - char *internalError; - *number = (int)strtol(hex, &internalError, 16); - if (*internalError != '\0') { - *error = 1; - } else { - *error = 0; - } +static const uint8_t utf8d[] = { + // The first part of the table maps bytes to character classes that + // to reduce the size of the transition table and create bitmasks. + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9, + 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, + 8,8,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, + 10,3,3,3,3,3,3,3,3,3,3,3,3,4,3,3, 11,6,6,6,5,8,8,8,8,8,8,8,8,8,8,8, + + // The second part is a transition table that maps a combination + // of a state of the automaton and a character class to a state. + 0,12,24,36,60,96,84,12,12,12,48,72, 12,12,12,12,12,12,12,12,12,12,12,12, + 12, 0,12,12,12,12,12, 0,12, 0,12,12, 12,24,12,12,12,12,12,24,12,24,12,12, + 12,12,12,12,12,12,12,24,12,12,12,12, 12,24,12,12,12,12,12,12,12,24,12,12, + 12,12,12,12,12,12,12,36,12,36,12,12, 12,36,12,12,12,12,12,36,12,36,12,12, + 12,36,12,12,12,12,12,12,12,12,12,12, +}; + +static uint32_t inline decode(uint32_t* state, uint32_t* codep, uint32_t byte) { + uint32_t type = utf8d[byte]; + + *codep = (*state != UTF8_ACCEPT) ? + (byte & 0x3fu) | (*codep << 6) : + (0xff >> type) & (byte); + + *state = utf8d[256 + *state + type]; + return *state; } -#define UTF8_CHAR(N, OUT) \ - if (N < 0x80) { \ - OUT = (char)N; \ - } else if (N < 0x800) { \ - OUT = (char)((N >> 6) | 0xc0); \ - OUT = (char)((N & 0x3F) | 0x80); \ - } else if (N < 0xffff) { \ - OUT = (char)((N >> 12) | 0xe0); \ - OUT = (char)(((N >> 6) & 0x3f) | 0x80); \ - OUT = (char)((N & 0x3f) | 0x80); \ - } else { \ - OUT = (char)((N >> 18) | 0xF0); \ - OUT = (char)(((N >> 12) & 0x3F) | 0x80); \ - OUT = (char)(((N >> 6) & 0x3F) | 0x80); \ - OUT = (char)((N & 0x3f) | 0x80); \ - } +static int inline ishexnum(uint32_t c) +{ + return (c >= '0' && c <= '9') || (c >= 'a' && c <= 'f') || (c >= 'A' && c <= 'F'); +} -void bs_json_unescape(const unsigned long length, int *error, char *bsIn, char *bsOut) +static uint32_t inline decode_hex(uint32_t c) { - register unsigned long ptr = 0; - while (ptr < length) { - const char ch = *bsIn++; - ptr++; - if (ch == '\\') { - if (ptr >= length) { - *error = 1; - return; - } - const char nextCh = *bsIn++; - ptr++; - switch (nextCh) { - case '\\': - *bsOut++ = '\\'; - break; - case '"': - *bsOut++ = '"'; - break; - case '/': - *bsOut++ = '/'; - break; - case 'b': - *bsOut++ = '\b'; - break; - case 'f': - *bsOut++ = '\f'; - break; - case 'n': - *bsOut++ = '\n'; - break; - case 'r': - *bsOut++ = '\r'; - break; - case 't': - *bsOut++ = '\t'; - break; - case 'u': - if (ptr+3 >= length) { - *error = 3; - return; - } - ptr += 4; - int number = 0; - short hexError = 0; - const char a = *bsIn++; const char b = *bsIn++; const char c = *bsIn++; const char d = *bsIn++; - private_parse_hex(a, b, c, d, &number, &hexError); - if (hexError == 1) { - *error = 4; - return; - } - if (number < 0xd800 || number > 0xdfff) { - UTF8_CHAR(number, *bsOut++); - } else if (number <= 0xdbff) { - if (ptr+5 >= length) { - *error = 5; - return; - } - ptr += 6; - if (*bsIn++ != '\\') { - *error = 6; - return; - } - if (*bsIn++ != 'u') { - *error = 7; - return; - } - int numberB = 0; - short hexErrorB = 0; - const char ai = *bsIn++; const char bi = *bsIn++; const char ci = *bsIn++; const char di = *bsIn++; - private_parse_hex(ai, bi, ci, di, &numberB, &hexErrorB); - if (hexErrorB == 1) { - *error = 8; - return; - } - if (numberB >= 0xdc00 && numberB <= 0xdfff) { - const int r = ((number - 0xdc00) << 10) + (numberB - 0xdc00) + 0x10000; - UTF8_CHAR(r, *bsOut++); - } else { - *error = 9; - return; - } - } - break; - default: - *error = 2; - return; - } - } else { - *bsOut++ = ch; + if (c >= '0' && c <= '9') + return c - '0'; + else if (c >= 'a' && c <= 'f') + return c - 'a' + 10; + else if (c >= 'A' && c <= 'F') + return c - 'A' + 10; + return 0; // Should not happen +} + +static int inline isLowSurrogate(uint16_t c) +{ + return c >= 0xDC00 && c <= 0xDFFF; +} + +static int inline isHighSurrogate(uint16_t c) +{ + return c >= 0xD800 && c <= 0xDBFF; +} + +// Decode, return non-zero value on error +int +_js_decode_string(uint16_t *const dest, size_t *destoff, + const uint8_t *s, const uint8_t *const srcend) +{ + uint16_t *d = dest + *destoff; + uint32_t state = 0; + uint32_t codepoint; + + int surrogate = 0; + uint16_t unidata; + + // Optimized version of dispatch when just an ASCII char is expected + #define DISPATCH_ASCII(label) {\ + if (s >= srcend) {\ + return -1;\ + }\ + codepoint = *s++;\ + goto label;\ + } + + standard: + // Test end of stream + while (s < srcend) { + if (*s <= 127) + codepoint = *s++; + else if (decode(&state, &codepoint, *s++) != UTF8_ACCEPT) { + if (state == UTF8_REJECT) + return -1; + continue; } + + if (codepoint == '\\') + DISPATCH_ASCII(backslash) + else if (codepoint <= 0xffff) + *d++ = (uint16_t) codepoint; + else { + *d++ = (uint16_t) (0xD7C0 + (codepoint >> 10)); + *d++ = (uint16_t) (0xDC00 + (codepoint & 0x3FF)); + } } - *bsOut = '\0'; - *error = 0; + *destoff = d - dest; + // Exit point + return (state != UTF8_ACCEPT); + backslash: + switch (codepoint) { + case '"': + case '\\': + case '/': + *d++ = (uint16_t) codepoint; + goto standard; + break; + case 'b': *d++ = '\b';goto standard; + case 'f': *d++ = '\f';goto standard; + case 'n': *d++ = '\n';goto standard; + case 'r': *d++ = '\r';goto standard; + case 't': *d++ = '\t';goto standard; + case 'u': DISPATCH_ASCII(unicode1);;break; + default: + return -1; + } + unicode1: + if (!ishexnum(codepoint)) + return -1; + unidata = decode_hex(codepoint) << 12; + DISPATCH_ASCII(unicode2); + unicode2: + if (!ishexnum(codepoint)) + return -1; + unidata |= decode_hex(codepoint) << 8; + DISPATCH_ASCII(unicode3); + unicode3: + if (!ishexnum(codepoint)) + return -1; + unidata |= decode_hex(codepoint) << 4; + DISPATCH_ASCII(unicode4); + unicode4: + if (!ishexnum(codepoint)) + return -1; + unidata |= decode_hex(codepoint); + *d++ = (uint16_t) unidata; + + if (surrogate) { + if (!isLowSurrogate(unidata)) + return -1; + surrogate = 0; + } else { + if (isHighSurrogate(unidata)) { + surrogate = 1; + DISPATCH_ASCII(surrogate1); + } else if (isLowSurrogate(unidata)) + return -1; + } + goto standard; + surrogate1: + if (codepoint != '\\') + return -1; + DISPATCH_ASCII(surrogate2) + surrogate2: + if (codepoint != 'u') + return -1; + DISPATCH_ASCII(unicode1) } diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,6 @@ +# 0.3.2.3 +- Completely rewritten text unescapes based on text decodeUtf8; fixes some surprising crashes, speed improvements. + # 0.3.2.0 - Changed string parsing; parsing of escaped strings is now very fast - Removed bytestring parser diff --git a/json-stream.cabal b/json-stream.cabal --- a/json-stream.cabal +++ b/json-stream.cabal @@ -1,5 +1,5 @@ name: json-stream -version: 0.3.2.2 +version: 0.3.2.3 synopsis: Incremental applicative JSON parser description: Easy to use JSON parser fully supporting incremental parsing. Parsing grammar in applicative form. @@ -29,7 +29,8 @@ library exposed-modules: Data.JsonStream.Parser - other-modules: Data.JsonStream.TokenParser, Data.JsonStream.CLexType, Data.JsonStream.CLexer + other-modules: Data.JsonStream.TokenParser, Data.JsonStream.CLexType, Data.JsonStream.CLexer, + Data.JsonStream.Unescape c-sources: c_lib/lexer.c, c_lib/unescape_string.c includes: c_lib/lexer.h include-dirs: c_lib @@ -40,12 +41,15 @@ , vector , unordered-containers , scientific + default-language: Haskell2010 test-suite spec main-is: Spec.hs - other-modules: Data.JsonStream.CLexType, ParserSpec + other-modules: Data.JsonStream.CLexType + , Data.JsonStream.Unescape + , ParserSpec c-sources: c_lib/lexer.c, c_lib/unescape_string.c include-dirs: c_lib includes: c_lib/lexer.h @@ -62,7 +66,8 @@ , hspec , scientific , directory - + , QuickCheck + , quickcheck-unicode -- executable spdtest -- main-is: spdtest.hs