canonical-json 0.5.0.1 → 0.6.0.0

raw patch · 9 files changed

+287/−55 lines, 9 filesdep +criteriondep +deepseqdep ~basedep ~bytestringdep ~containersPVP ok

version bump matches the API change (PVP)

Dependencies added: criterion, deepseq

Dependency ranges changed: base, bytestring, containers

API changes (from Hackage documentation)

Files

• ChangeLog.md +10/−0
• README.md +45/−0
• Text/JSON/Canonical.hs +3/−0
• Text/JSON/Canonical/Class.hs +43/−21
• Text/JSON/Canonical/Parse.hs +22/−20
• Text/JSON/Canonical/Types.hs +59/−2
• benchmark/Parse.hs +15/−0
• canonical-json.cabal +22/−5
• tests/TestSuite.hs +68/−7

@@ -1,5 +1,15 @@ # Revision history for canonical-json +## 0.6.0.0 2019-07-31++* Introduced JSString type rather than using String, for improved memory use.++* Improved parser performance++* Reduce stack space usage and introduce stack use tests++* Added benchmarks+ ## 0.5.0.1 2018-10-26  * ghc-8.4 compatibility.

@@ -0,0 +1,45 @@+An implementation of [Canonical JSON].++The "canonical JSON" format is designed to provide repeatable hashes of+JSON values. It is designed for applications that need to hash, sign+or authenitcate JSON data structures., including embedded signatures.++Canonical JSON is parsable with any full JSON parser, and it allows white+space for pretty-printed human readable presentation, but it can be put into+a canonical form which then has a stable serialised representation and thus a+stable hash.++The basic concept is that a file in the canonical JSON format can be read+using `parseCanonicalJSON`. Note that this input file does *not* itself need+to be in canonical form, it just needs to be in the canonical JSON format.+Then the `renderCanonicalJSON` function is used to render into the canonical+form. This is then the form that can be hashed or signed etc.++The `prettyCanonicalJSON` is for convenience to render in a human readable+style, since the canoncal form eliminates unnecessary white space which+makes the output hard to read. This style is again suitable to read using+'parseCanonicalJSON'. So this is suitable to use for producing output that+has to be later hashed or otherwise checked.++See the [API docs] on Hackage.++This package has been extracted from the [hackage-security] package where+canonical JSON is used for all the signed TUF files, such as the+[root keys file], etc. As you can see from that, canoncal JSON allows keeping+JSON files in a human readable pretty-printed form, and still allows verifying+signatures. In particular this demonstrates the use of embedded signatures,+where the `root.json` both contains a body value and multiple signatures of+that body all within the same file. This is because canoncal JSON is about+hashes for *JSON values, not serialised JSON text*.++[Canonical JSON]: http://wiki.laptop.org/go/Canonical_JSON+[API docs]: https://hackage.haskell.org/package/canonical-json+[hackage-security]: https://hackage.haskell.org/package/hackage-security+[root keys file]: https://hackage.haskell.org/root.json+++Known bugs limitations+-----------------------++ * Decoding/encoding Unicode code-points beyond `U+00ff` is currently broken+

@@ -39,6 +39,7 @@     -- * Types     JSValue(..)   , Int54+  , JSString     -- * Parsing and printing   , parseCanonicalJSON   , renderCanonicalJSON@@ -53,6 +54,8 @@   , Got   , expectedButGotValue     -- * Utility+  , toJSString+  , fromJSString   , fromJSObject   , fromJSField   , fromJSOptField

@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -33,7 +34,7 @@  import Text.JSON.Canonical.Types -import Control.Monad (liftM)+import Control.Monad (foldM, liftM) import Data.Maybe (catMaybes) import Data.Map (Map) import qualified Data.Map as Map@@ -59,11 +60,11 @@  -- | Used in the 'ToJSON' instance for 'Map' class ToObjectKey m a where-  toObjectKey :: a -> m String+  toObjectKey :: a -> m JSString  -- | Used in the 'FromJSON' instance for 'Map' class FromObjectKey m a where-  fromObjectKey :: String -> m (Maybe a)+  fromObjectKey :: JSString -> m (Maybe a)  -- | Monads in which we can report schema errors class (Applicative m, Monad m) => ReportSchemaErrors m where@@ -83,19 +84,25 @@     describeValue (JSArray  _) = "array"     describeValue (JSObject _) = "object" -unknownField :: ReportSchemaErrors m => String -> m a+unknownField :: ReportSchemaErrors m => JSString -> m a unknownField field = expected ("field " ++ show field) Nothing  {-------------------------------------------------------------------------------   ToObjectKey and FromObjectKey instances -------------------------------------------------------------------------------} -instance Monad m => ToObjectKey m String where+instance Monad m => ToObjectKey m JSString where   toObjectKey = return -instance Monad m => FromObjectKey m String where+instance Monad m => FromObjectKey m JSString where   fromObjectKey = return . Just +instance Monad m => ToObjectKey m String where+  toObjectKey = return . toJSString++instance Monad m => FromObjectKey m String where+  fromObjectKey = return . Just . fromJSString+ {-------------------------------------------------------------------------------   ToJSON and FromJSON instances -------------------------------------------------------------------------------}@@ -106,13 +113,20 @@ instance Monad m => FromJSON m JSValue where   fromJSON = return -instance Monad m => ToJSON m String where+instance Monad m => ToJSON m JSString where   toJSON = return . JSString -instance ReportSchemaErrors m => FromJSON m String where+instance ReportSchemaErrors m => FromJSON m JSString where   fromJSON (JSString str) = return str   fromJSON val            = expectedButGotValue "string" val +instance Monad m => ToJSON m String where+  toJSON = return . JSString . toJSString++instance ReportSchemaErrors m => FromJSON m String where+  fromJSON (JSString str) = return (fromJSString str)+  fromJSON val            = expectedButGotValue "string" val+ instance Monad m => ToJSON m Int54 where   toJSON = return . JSNum @@ -125,14 +139,14 @@   {-# OVERLAPPABLE #-} #endif     (Monad m, ToJSON m a) => ToJSON m [a] where-  toJSON = liftM JSArray . mapM toJSON+  toJSON = liftM JSArray . mapM' toJSON  instance #if __GLASGOW_HASKELL__ >= 710   {-# OVERLAPPABLE #-} #endif     (ReportSchemaErrors m, FromJSON m a) => FromJSON m [a] where-  fromJSON (JSArray as) = mapM fromJSON as+  fromJSON (JSArray as) = mapM' fromJSON as   fromJSON val          = expectedButGotValue "array" val  @@ -140,10 +154,10 @@          , ToObjectKey m k          , ToJSON m a          ) => ToJSON m (Map k a) where-  toJSON = liftM JSObject . mapM aux . Map.toList+  toJSON = liftM JSObject . mapM' aux . Map.toList     where-      aux :: (k, a) -> m (String, JSValue)-      aux (k, a) = do k' <- toObjectKey k; a' <- toJSON a; return (k', a')+      aux :: (k, a) -> m (JSString, JSValue)+      aux (k, a) = (,) <$> toObjectKey k <*> toJSON a  instance ( ReportSchemaErrors m          , Ord k@@ -152,26 +166,25 @@          ) => FromJSON m (Map k a) where   fromJSON enc = do       obj <- fromJSObject enc-      Map.fromList . catMaybes <$> mapM aux obj+      Map.fromList . catMaybes <$> mapM_reverse aux obj     where-      aux :: (String, JSValue) -> m (Maybe (k, a))+      aux :: (JSString, JSValue) -> m (Maybe (k, a))       aux (k, a) = knownKeys <$> fromObjectKey k <*> fromJSON a       knownKeys :: Maybe k -> a -> Maybe (k, a)       knownKeys Nothing  _ = Nothing       knownKeys (Just k) a = Just (k, a) - {-------------------------------------------------------------------------------   Utility -------------------------------------------------------------------------------} -fromJSObject :: ReportSchemaErrors m => JSValue -> m [(String, JSValue)]+fromJSObject :: ReportSchemaErrors m => JSValue -> m [(JSString, JSValue)] fromJSObject (JSObject obj) = return obj fromJSObject val            = expectedButGotValue "object" val  -- | Extract a field from a JSON object fromJSField :: (ReportSchemaErrors m, FromJSON m a)-            => JSValue -> String -> m a+            => JSValue -> JSString -> m a fromJSField val nm = do     obj <- fromJSObject val     case lookup nm obj of@@ -179,18 +192,27 @@       Nothing  -> unknownField nm  fromJSOptField :: (ReportSchemaErrors m, FromJSON m a)-               => JSValue -> String -> m (Maybe a)+               => JSValue -> JSString -> m (Maybe a) fromJSOptField val nm = do     obj <- fromJSObject val     case lookup nm obj of       Just fld -> Just <$> fromJSON fld       Nothing  -> return Nothing -mkObject :: forall m. Monad m => [(String, m JSValue)] -> m JSValue+mkObject :: forall m. Monad m => [(JSString, m JSValue)] -> m JSValue mkObject = liftM JSObject . sequenceFields   where-    sequenceFields :: [(String, m JSValue)] -> m [(String, JSValue)]+    sequenceFields :: [(JSString, m JSValue)] -> m [(JSString, JSValue)]     sequenceFields []               = return []     sequenceFields ((fld,val):flds) = do val' <- val                                          flds' <- sequenceFields flds                                          return ((fld,val'):flds')++-- Avoid stack overflow on large lists+mapM' :: Monad m => (a -> m b) -> [a] -> m [b]+mapM' f = fmap reverse . mapM_reverse f++-- For when we don't care about order, can avoid the reverse+mapM_reverse :: Monad m => (a -> m b) -> [a] -> m [b]+mapM_reverse f = foldM (\xs a -> fmap (:xs) (f a)) []+

@@ -21,10 +21,12 @@  import Text.JSON.Canonical.Types -import Text.ParserCombinators.Parsec-         ( CharParser, (<|>), (<?>), many, between, sepBy+import Text.Parsec+         ( (<|>), (<?>), many, between, sepBy          , satisfy, char, string, digit, spaces          , parse )+import Text.Parsec.ByteString.Lazy+         ( Parser ) import Text.PrettyPrint hiding (char) import qualified Text.PrettyPrint as Doc #if !(MIN_VERSION_base(4,8,0))@@ -77,8 +79,8 @@ s_value (JSArray vs)   = s_array  vs s_value (JSObject fs)  = s_object (sortBy (compare `on` fst) fs) -s_string :: String -> ShowS-s_string s = showChar '"' . showl s+s_string :: JSString -> ShowS+s_string s = showChar '"' . showl (fromJSString s)   where showl []     = showChar '"'         showl (c:cs) = s_char c . showl cs @@ -92,7 +94,7 @@   where showl []     = showChar ']'         showl (v:vs) = showChar ',' . s_value v . showl vs -s_object :: [(String, JSValue)] -> ShowS+s_object :: [(JSString, JSValue)] -> ShowS s_object []               = showString "{}" s_object ((k0,v0):kvs0)   = showChar '{' . s_string k0                           . showChar ':' . s_value v0@@ -115,12 +117,11 @@ parseCanonicalJSON :: BS.ByteString -> Either String JSValue parseCanonicalJSON = either (Left . show) Right                    . parse p_value ""-                   . BS.unpack -p_value :: CharParser () JSValue+p_value :: Parser JSValue p_value = spaces *> p_jvalue -tok              :: CharParser () a -> CharParser () a+tok              :: Parser a -> Parser a tok p             = p <* spaces  {-@@ -133,7 +134,7 @@    false    null -}-p_jvalue         :: CharParser () JSValue+p_jvalue         :: Parser JSValue p_jvalue          =  (JSNull      <$  p_null)                  <|> (JSBool      <$> p_boolean)                  <|> (JSArray     <$> p_array)@@ -142,10 +143,10 @@                  <|> (JSNum       <$> p_number)                  <?> "JSON value" -p_null           :: CharParser () ()+p_null           :: Parser () p_null            = tok (string "null") >> return () -p_boolean        :: CharParser () Bool+p_boolean        :: Parser Bool p_boolean         = tok                       (  (True  <$ string "true")                      <|> (False <$ string "false")@@ -158,7 +159,7 @@    value    value , elements -}-p_array          :: CharParser () [JSValue]+p_array          :: Parser [JSValue] p_array           = between (tok (char '[')) (tok (char ']'))                   $ p_jvalue `sepBy` tok (char ',') @@ -174,8 +175,9 @@    \\    \" -}-p_string         :: CharParser () String-p_string          = between (char '"') (tok (char '"')) (many p_char)+p_string         :: Parser JSString+p_string          = between (char '"') (tok (char '"'))+                            (many p_char >>= \str -> return $! toJSString str)   where p_char    =  (char '\\' >> p_esc)                  <|> (satisfy (\x -> x /= '"' && x /= '\\')) @@ -192,7 +194,7 @@ pair:    string : value -}-p_object         :: CharParser () [(String,JSValue)]+p_object         :: Parser [(JSString, JSValue)] p_object          = between (tok (char '{')) (tok (char '}'))                   $ p_field `sepBy` tok (char ',')   where p_field   = (,) <$> (p_string <* tok (char ':')) <*> p_jvalue@@ -214,7 +216,7 @@ -- -- TODO: Currently this allows for a maximum of 15 digits (i.e. a maximum value -- of @999,999,999,999,999@) as a crude approximation of the 'Int54' range.-p_number         :: CharParser () Int54+p_number         :: Parser Int54 p_number          = tok                       (  (char '-' *> (negate <$> pnat))                      <|> pnat@@ -228,7 +230,7 @@ digitToInt54 :: Char -> Int54 digitToInt54 = fromIntegral . digitToInt -manyN :: Int -> CharParser () a -> CharParser () [a]+manyN :: Int -> Parser a -> Parser [a] manyN 0 _ =  pure [] manyN n p =  ((:) <$> p <*> manyN (n-1) p)          <|> pure []@@ -256,8 +258,8 @@ jvalue (JSArray vs)   = jarray  vs jvalue (JSObject fs)  = jobject fs -jstring :: String -> Doc-jstring = doubleQuotes . hcat . map jchar+jstring :: JSString -> Doc+jstring = doubleQuotes . hcat . map jchar . fromJSString  jchar :: Char -> Doc jchar '"'   = Doc.char '\\' <> Doc.char '"'@@ -268,7 +270,7 @@ jarray = sep . punctuate' lbrack comma rbrack        . map jvalue -jobject :: [(String, JSValue)] -> Doc+jobject :: [(JSString, JSValue)] -> Doc jobject = sep . punctuate' lbrace comma rbrace         . map (\(k,v) -> sep [jstring k <> colon, nest 2 (jvalue v)]) 

@@ -9,9 +9,13 @@ module Text.JSON.Canonical.Types   ( JSValue(..)   , Int54(..)+  , JSString+  , toJSString+  , fromJSString   ) where  import Control.Arrow (first)+import Control.DeepSeq (NFData(..)) import Data.Bits (Bits) #if MIN_VERSION_base(4,7,0) import Data.Bits (FiniteBits)@@ -19,19 +23,72 @@ import Data.Data (Data) import Data.Int (Int64) import Data.Ix (Ix)+#if !MIN_VERSION_base(4,8,0)+import Data.Monoid (Monoid)+#endif+#if MIN_VERSION_base(4,9,0)+import Data.Semigroup (Semigroup)+#endif import Data.Typeable (Typeable) import Foreign.Storable (Storable)+#if MIN_VERSION_base(4,7,0)+import Text.Printf (PrintfArg(..))+import qualified Text.Printf as Printf+#else import Text.Printf (PrintfArg)+#endif+import Data.String (IsString)+import Data.ByteString.Short (ShortByteString)+import qualified Data.ByteString.Short as BS   data JSValue     = JSNull     | JSBool     !Bool     | JSNum      !Int54-    | JSString   String+    | JSString   !JSString     | JSArray    [JSValue]-    | JSObject   [(String, JSValue)]+    | JSObject   [(JSString, JSValue)]     deriving (Show, Read, Eq, Ord)++instance NFData JSValue where+  rnf JSNull        = ()+  rnf JSBool{}      = ()+  rnf JSNum{}       = ()+  rnf JSString{}    = ()+  rnf (JSArray  vs) = rnf vs+  rnf (JSObject vs) = rnf vs++-- | Canonical JSON strings are in fact just bytes.+--+newtype JSString = JStr ShortByteString+    deriving (Eq, Ord, IsString,+#if MIN_VERSION_base(4,9,0)+              Semigroup,+#endif+              Monoid)++instance NFData JSString where+  rnf JStr{} = ()++instance Show JSString where+  showsPrec n (JStr bs) = showsPrec n bs++instance Read JSString where+  readsPrec p = map (first JStr) . readsPrec p++#if MIN_VERSION_base(4,7,0)+instance PrintfArg JSString where+    formatArg = Printf.formatString . fromJSString+#endif++toJSString :: String -> JSString+toJSString str+  | all (<= '\255') str = JStr . BS.pack . map (fromIntegral . fromEnum) $ str+  | otherwise           = error "toJSString: cannot use non-ASCII chars"++fromJSString :: JSString -> String+fromJSString = map (toEnum . fromIntegral) . BS.unpack . (\(JStr bs) -> bs)  -- | 54-bit integer values --

@@ -0,0 +1,15 @@++import Text.JSON.Canonical.Parse++import qualified Data.ByteString.Lazy as BS++import Criterion.Main++main :: IO ()+main = defaultMain [+  env loadData $ \jsondata ->+  bench "parse" $ nf parseCanonicalJSON jsondata+  ]++loadData :: IO BS.ByteString+loadData = BS.readFile "benchmark/cardano-genesis.json"

@@ -1,5 +1,5 @@ name:                canonical-json-version:             0.5.0.1+version:             0.6.0.0 synopsis:            Canonical JSON for signing and hashing JSON values description:         An implementation of Canonical JSON.                      .@@ -19,13 +19,15 @@ license-file:        LICENSE author:              Duncan Coutts, Edsko de Vries maintainer:          duncan@well-typed.com, edsko@well-typed.com-copyright:           Copyright 2015-2017 Well-Typed LLP+copyright:           Copyright 2015-2018 Well-Typed LLP homepage:            https://github.com/well-typed/canonical-json category:            Text, JSON build-type:          Simple extra-source-files:  ChangeLog.md cabal-version:       >=1.10 +extra-source-files:  README.md+ source-repository head   type:     git   location: https://github.com/well-typed/canonical-json.git@@ -39,8 +41,9 @@                        MultiParamTypeClasses, FlexibleInstances,                        ScopedTypeVariables, OverlappingInstances   build-depends:       base              >= 4.5     && < 5,-                       bytestring        >= 0.9     && < 0.11,-                       containers        >= 0.4     && < 0.6,+                       bytestring        >= 0.10.4  && < 0.11,+                       containers        >= 0.4     && < 0.7,+                       deepseq           >= 1.2     && < 1.5,                        parsec            >= 3.1     && < 3.2,                        pretty            >= 1.0     && < 1.2   default-language:    Haskell2010@@ -53,6 +56,7 @@   build-depends:       base,                        bytestring,                        canonical-json,+                       containers,                        aeson             == 1.4.*,                        vector,                        unordered-containers,@@ -60,4 +64,17 @@                        tasty,                        tasty-quickcheck   default-language:    Haskell2010-  ghc-options:         -Wall+  -- -K100k to check for stack overflow:+  ghc-options:         -Wall -with-rtsopts=-K100k++benchmark parse-bench+  type:                exitcode-stdio-1.0+  main-is:             Parse.hs+  hs-source-dirs:      benchmark+  build-depends:       base,+                       bytestring,+                       canonical-json,+                       containers,+                       criterion >= 1.1+  default-language:    Haskell2010+  ghc-options:         -Wall -rtsopts

@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Main (main) where @@ -7,8 +9,13 @@ import qualified Data.ByteString.Lazy.Char8 as BS import           Text.JSON.Canonical +#if !(MIN_VERSION_base(4,8,0))+import Control.Applicative (Applicative(..), (<$>))+#endif+ import qualified Data.Aeson as Aeson (Value (..), eitherDecode)-import           Data.String (fromString)+import           Data.String (IsString, fromString)+import qualified Data.Map            as Map import qualified Data.Vector         as V  (fromList) import qualified Data.HashMap.Strict as HM (fromList) @@ -26,6 +33,16 @@         , testProperty "prop_roundtrip_pretty"    prop_roundtrip_pretty         , testProperty "prop_canonical_pretty"    prop_canonical_pretty         , testProperty "prop_aeson_canonical"     prop_aeson_canonical+        , testGroup "prop_toJSON_fromJSON" [+            testProperty "String" prop_toJSON_fromJSON_String+          , testProperty "Int54"  prop_toJSON_fromJSON_Int54+          , testProperty "[]"     prop_toJSON_fromJSON_List+          , testProperty "Map"    prop_toJSON_fromJSON_Map+          ]+        , testGroup "no stack overflow" [+            testProperty "[]"  unit_large_List+          , testProperty "Map" unit_large_Map+          ]         ]  @@ -48,6 +65,43 @@ prop_aeson_canonical jsval =     Aeson.eitherDecode (renderCanonicalJSON jsval) == Right (toAeson jsval) +prop_toJSON_fromJSON :: (Monad m, ToJSON m a, FromJSON m a, Eq a) => a -> m Bool+prop_toJSON_fromJSON x =+    toJSON x >>= fromJSON >>= \x' -> return (x' == x)++prop_toJSON_fromJSON_String :: JSString -> Property+prop_toJSON_fromJSON_String = runM . prop_toJSON_fromJSON++prop_toJSON_fromJSON_Int54 :: Int54 -> Property+prop_toJSON_fromJSON_Int54 = runM . prop_toJSON_fromJSON++prop_toJSON_fromJSON_List :: [JSString] -> Property+prop_toJSON_fromJSON_List = runM . prop_toJSON_fromJSON++prop_toJSON_fromJSON_Map :: Map.Map JSString JSString -> Property+prop_toJSON_fromJSON_Map = runM . prop_toJSON_fromJSON++unit_large_List :: Property+unit_large_List = runM (prop_toJSON_fromJSON large)+  where+    large = replicate 10000 (42 :: Int54)++unit_large_Map :: Property+unit_large_Map  = runM (prop_toJSON_fromJSON large)+  where+    large = Map.fromList [ (show n, 42 :: Int54) | n <- [0.. 10000 :: Int] ]+++newtype M a = M (Maybe a)+  deriving (Functor, Applicative, Monad)++runM :: Testable prop => M prop -> Property+runM (M Nothing)     = property False+runM (M (Just prop)) = property prop++instance ReportSchemaErrors M where+  expected _ _ = M Nothing+ canonicalise :: JSValue -> JSValue canonicalise v@JSNull        = v canonicalise v@(JSBool    _) = v@@ -61,11 +115,14 @@ toAeson JSNull        = Aeson.Null toAeson (JSBool b)    = Aeson.Bool b toAeson (JSNum n)     = Aeson.Number (fromIntegral n)-toAeson (JSString s)  = Aeson.String (fromString s)+toAeson (JSString s)  = Aeson.String (toAesonStr s) toAeson (JSArray xs)  = Aeson.Array  $ V.fromList  [ toAeson x | x <- xs ]-toAeson (JSObject xs) = Aeson.Object $ HM.fromList [ (fromString k, toAeson v)+toAeson (JSObject xs) = Aeson.Object $ HM.fromList [ (toAesonStr k, toAeson v)                                                    | (k, v) <- xs ] +toAesonStr :: IsString s => JSString -> s+toAesonStr = fromString . fromJSString+ instance Arbitrary JSValue where   arbitrary =     sized $ \sz ->@@ -73,13 +130,13 @@       [ (1, pure JSNull)       , (1, JSBool   <$> arbitrary)       , (2, JSNum    <$> arbitrary)-      , (2, JSString . getASCIIString <$> arbitrary)-      , (3, JSArray                <$> resize (sz `div` 2) arbitrary)-      , (3, JSObject . mapFirst getASCIIString .  noDupFields <$> resize (sz `div` 2) arbitrary)+      , (2, JSString <$> arbitrary)+      , (3, JSArray  <$> resize (sz `div` 2) arbitrary)+      , (3, JSObject . noDupFields+                     <$> resize (sz `div` 2) arbitrary)       ]     where       noDupFields = nubBy (\(x,_) (y,_) -> x==y)-      mapFirst f = map (\(x, y) -> (f x, y))    shrink JSNull        = []   shrink (JSBool    _) = []@@ -101,4 +158,8 @@       upperbound =   999999999999999  -- 15 decimal digits       lowerbound = (-999999999999999)   shrink = shrinkIntegral++instance Arbitrary JSString where+  arbitrary = toJSString . getASCIIString <$> arbitrary+  shrink  s = [ toJSString s' | s' <- shrink (fromJSString s) ]