d354445 · typeable/aeson

git.iko.soy/typeable/aeson

on master help sign in

Add bounds checks for unsafe conversions from Scientific

d354445Adam Bergmark8 years ago

Data/Aeson/Encoding/Builder.hs+1−1

compare with master

unifiedsplit

@@ -133,7 +133,7 @@ c2w c = fromIntegral (ord c)

133-- | Encode a JSON number.

134scientific :: Scientific -> Builder

135scientific s

136− | e < 0 = scientificBuilder s

136+ | e < 0 || e > 1024 = scientificBuilder s

137 | otherwise = B.integerDec (coefficient s * 10 ^ e)

138 where

139 e = base10Exponent s

Data/Aeson/Types/FromJSON.hs+47−39

@@ -85,7 +85,6 @@ import Data.Aeson.Internal.Functions (mapKey)

85import Data.Aeson.Parser.Internal (eitherDecodeWith, jsonEOF)

86import Data.Aeson.Types.Generic

87import Data.Aeson.Types.Internal

88−import Data.Attoparsec.Number (Number(..))

89import Data.Bits (unsafeShiftR)

88import Data.Bits (unsafeShiftR)

90import Data.Fixed (Fixed, HasResolution)

89import Data.Fixed (Fixed, HasResolution)

91import Data.Functor.Compose (Compose(..))

90import Data.Functor.Compose (Compose(..))

@@ -99,7 +98,7 @@ import Data.Maybe (fromMaybe)

99import Data.Semigroup ((<>))

98import Data.Semigroup ((<>))

100import Data.Proxy (Proxy(..))

99import Data.Proxy (Proxy(..))

101import Data.Ratio ((%), Ratio)

100import Data.Ratio ((%), Ratio)

102−import Data.Scientific (Scientific)

101+import Data.Scientific (Scientific, base10Exponent)

103import Data.Tagged (Tagged(..))

102import Data.Tagged (Tagged(..))

104import Data.Text (Text, pack, unpack)

103import Data.Text (Text, pack, unpack)

105import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)

104import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)

@@ -172,15 +171,6 @@ parseIndexedJSONPair keyParser valParser idx value = p value <?> Index idx

172parseJSONElemAtIndex :: (Value -> Parser a) -> Int -> V.Vector Value -> Parser a

171parseJSONElemAtIndex :: (Value -> Parser a) -> Int -> V.Vector Value -> Parser a

173parseJSONElemAtIndex p idx ary = p (V.unsafeIndex ary idx) <?> Index idx

172parseJSONElemAtIndex p idx ary = p (V.unsafeIndex ary idx) <?> Index idx

174

173

175−scientificToNumber :: Scientific -> Number

176−scientificToNumber s

177− | e < 0 = D $ Scientific.toRealFloat s

178− | otherwise = I $ c * 10 ^ e

179− where

180− e = Scientific.base10Exponent s

181− c = Scientific.coefficient s

182−{-# INLINE scientificToNumber #-}

183−

184parseRealFloat :: RealFloat a => String -> Value -> Parser a

174parseRealFloat :: RealFloat a => String -> Value -> Parser a

185parseRealFloat _ (Number s) = pure $ Scientific.toRealFloat s

175parseRealFloat _ (Number s) = pure $ Scientific.toRealFloat s

186parseRealFloat _ Null = pure (0/0)

176parseRealFloat _ Null = pure (0/0)

@@ -196,7 +186,7 @@ parseIntegralFromScientific expected s =

196

186

197parseIntegral :: Integral a => String -> Value -> Parser a

187parseIntegral :: Integral a => String -> Value -> Parser a

198parseIntegral expected =

188parseIntegral expected =

199− withScientific expected $ parseIntegralFromScientific expected

189+ withBoundedScientific expected $ parseIntegralFromScientific expected

200{-# INLINE parseIntegral #-}

190{-# INLINE parseIntegral #-}

201

191

202parseBoundedIntegralFromScientific :: (Bounded a, Integral a) => String -> Scientific -> Parser a

192parseBoundedIntegralFromScientific :: (Bounded a, Integral a) => String -> Scientific -> Parser a

@@ -218,8 +208,13 @@ parseScientificText

218 . T.encodeUtf8

208 . T.encodeUtf8

219

209

220parseIntegralText :: Integral a => String -> Text -> Parser a

210parseIntegralText :: Integral a => String -> Text -> Parser a

221−parseIntegralText expected t =

211+parseIntegralText expected t

212+ = parseScientificText t

213+ >>= rejectLargeExponent

222− parseScientificText t >>= parseIntegralFromScientific expected

214+ >>= parseIntegralFromScientific expected

215+ where

216+ rejectLargeExponent :: Scientific -> Parser Scientific

217+ rejectLargeExponent s = withBoundedScientific expected pure (Number s)

223{-# INLINE parseIntegralText #-}

218{-# INLINE parseIntegralText #-}

224

219

225parseBoundedIntegralText :: (Bounded a, Integral a) => String -> Text -> Parser a

220parseBoundedIntegralText :: (Bounded a, Integral a) => String -> Text -> Parser a

@@ -648,11 +643,30 @@ withArray expected _ v = typeMismatch expected v

648-- | @'withScientific' expected f value@ applies @f@ to the 'Scientific' number

643-- | @'withScientific' expected f value@ applies @f@ to the 'Scientific' number

649-- when @value@ is a 'Number' and fails using @'typeMismatch' expected@

644-- when @value@ is a 'Number' and fails using @'typeMismatch' expected@

650-- otherwise.

645-- otherwise.

646+-- .

647+-- /Warning/: If you are converting from a scientific to an unbounded

648+-- type such as 'Integer' you may want to add a restriction on the

649+-- size of the exponent (see 'withBoundedScientific') to prevent

650+-- malicious input from filling up the memory of the target system.

651withScientific :: String -> (Scientific -> Parser a) -> Value -> Parser a

652withScientific _ f (Number scientific) = f scientific

653withScientific expected _ v = typeMismatch expected v

654{-# INLINE withScientific #-}

655

656+-- | @'withBoundedScientific' expected f value@ applies @f@ to the 'Scientific' number

657+-- when @value@ is a 'Number' and fails using @'typeMismatch' expected@

658+-- otherwise.

659+--

660+-- The conversion will also fail wyth a @'typeMismatch' if the

661+-- 'Scientific' exponent is larger than 1024.

662+withBoundedScientific :: String -> (Scientific -> Parser a) -> Value -> Parser a

663+withBoundedScientific _ f v@(Number scientific) =

664+ if base10Exponent scientific > 1024

665+ then typeMismatch "a number with exponent <= 1024" v

666+ else f scientific

667+withBoundedScientific expected _ v = typeMismatch expected v

668+{-# INLINE withBoundedScientific #-}

669+

656-- | @'withBool' expected f value@ applies @f@ to the 'Bool' when @value@ is a

670-- | @'withBool' expected f value@ applies @f@ to the 'Bool' when @value@ is a

657-- 'Bool' and fails using @'typeMismatch' expected@ otherwise.

671-- 'Bool' and fails using @'typeMismatch' expected@ otherwise.

658withBool :: String -> (Bool -> Parser a) -> Value -> Parser a

672withBool :: String -> (Bool -> Parser a) -> Value -> Parser a

@@ -1232,12 +1246,6 @@ instance FromJSONKey Double where

1232 "-Infinity" -> pure (negate 1/0)

1246 "-Infinity" -> pure (negate 1/0)

1233 _ -> Scientific.toRealFloat <$> parseScientificText t

1247 _ -> Scientific.toRealFloat <$> parseScientificText t

1234

1248

1235−instance FromJSON Number where

1236− parseJSON (Number s) = pure $ scientificToNumber s

1237− parseJSON Null = pure (D (0/0))

1238− parseJSON v = typeMismatch "Number" v

1239− {-# INLINE parseJSON #-}

1240−

1241instance FromJSON Float where

1249instance FromJSON Float where

1242 parseJSON = parseRealFloat "Float"

1250 parseJSON = parseRealFloat "Float"

1243 {-# INLINE parseJSON #-}

1251 {-# INLINE parseJSON #-}

@@ -1258,12 +1266,12 @@ instance (FromJSON a, Integral a) => FromJSON (Ratio a) where

1258 else pure $ numerator % denominator

1266 else pure $ numerator % denominator

1259 {-# INLINE parseJSON #-}

1267 {-# INLINE parseJSON #-}

1260

1268

1261−-- | /WARNING:/ Only parse fixed-precision numbers from trusted input

1269+-- | This instance includes a bounds check to prevent maliciously

1262−-- since an attacker could easily fill up the memory of the target

1270+-- large inputs to fill up the memory of the target system. You can

1263−-- system by specifying a scientific number with a big exponent like

1271+-- newtype 'Scientific' and provide your own instance using

1264−-- @1e1000000000@.

1272+-- 'withScientific' if you want to allow larger inputs.

1265instance HasResolution a => FromJSON (Fixed a) where

1273instance HasResolution a => FromJSON (Fixed a) where

1266− parseJSON = withScientific "Fixed" $ pure . realToFrac

1274+ parseJSON = withBoundedScientific "Fixed" $ pure . realToFrac

1267 {-# INLINE parseJSON #-}

1275 {-# INLINE parseJSON #-}

1268

1276

1269instance FromJSON Int where

1277instance FromJSON Int where

@@ -1273,10 +1281,10 @@ instance FromJSON Int where

1273instance FromJSONKey Int where

1281instance FromJSONKey Int where

1274 fromJSONKey = FromJSONKeyTextParser $ parseBoundedIntegralText "Int"

1282 fromJSONKey = FromJSONKeyTextParser $ parseBoundedIntegralText "Int"

1275

1283

1276−-- | /WARNING:/ Only parse Integers from trusted input since an

1284+-- | This instance includes a bounds check to prevent maliciously

1277−-- attacker could easily fill up the memory of the target system by

1285+-- large inputs to fill up the memory of the target system. You can

1278−-- specifying a scientific number with a big exponent like

1286+-- newtype 'Scientific' and provide your own instance using

1279−-- @1e1000000000@.

1287+-- 'withScientific' if you want to allow larger inputs.

1280instance FromJSON Integer where

1288instance FromJSON Integer where

1281 parseJSON = parseIntegral "Integer"

1289 parseJSON = parseIntegral "Integer"

1282 {-# INLINE parseJSON #-}

1290 {-# INLINE parseJSON #-}

@@ -1715,21 +1723,21 @@ instance FromJSONKey UTCTime where

1715 fromJSONKey = FromJSONKeyTextParser (Time.run Time.utcTime)

1723 fromJSONKey = FromJSONKeyTextParser (Time.run Time.utcTime)

1716

1724

1717

1725

1718−-- | /WARNING:/ Only parse lengths of time from trusted input

1726+-- | This instance includes a bounds check to prevent maliciously

1719−-- since an attacker could easily fill up the memory of the target

1727+-- large inputs to fill up the memory of the target system. You can

1720−-- system by specifying a scientific number with a big exponent like

1728+-- newtype 'Scientific' and provide your own instance using

1721−-- @1e1000000000@.

1729+-- 'withScientific' if you want to allow larger inputs.

1722instance FromJSON NominalDiffTime where

1730instance FromJSON NominalDiffTime where

1723− parseJSON = withScientific "NominalDiffTime" $ pure . realToFrac

1731+ parseJSON = withBoundedScientific "NominalDiffTime" $ pure . realToFrac

1724 {-# INLINE parseJSON #-}

1732 {-# INLINE parseJSON #-}

1725

1733

1726

1734

1727−-- | /WARNING:/ Only parse lengths of time from trusted input

1735+-- | This instance includes a bounds check to prevent maliciously

1728−-- since an attacker could easily fill up the memory of the target

1736+-- large inputs to fill up the memory of the target system. You can

1729−-- system by specifying a scientific number with a big exponent like

1737+-- newtype 'Scientific' and provide your own instance using

1730−-- @1e1000000000@.

1738+-- 'withScientific' if you want to allow larger inputs.

1731instance FromJSON DiffTime where

1739instance FromJSON DiffTime where

1732− parseJSON = withScientific "DiffTime" $ pure . realToFrac

1740+ parseJSON = withBoundedScientific "DiffTime" $ pure . realToFrac

1733 {-# INLINE parseJSON #-}

1741 {-# INLINE parseJSON #-}

1734

1742

1735-------------------------------------------------------------------------------

1743-------------------------------------------------------------------------------

aeson.cabal+1−1

@@ -1,5 +1,5 @@

1name: aeson

2−version: 1.3.1.1

2+version: 1.4.0.0

3license: BSD3

4license-file: LICENSE

5category: Text, Web, JSON

changelog.md+16−1

@@ -1,9 +1,24 @@

1For the latest version of this document, please see [https://github.com/bos/aeson/blob/master/changelog.md](https://github.com/bos/aeson/blob/master/changelog.md).

3−### 1.4.0.0 (upcoming)

3+### 1.4.0.0

5+This release introduces bounds on the size of `Scientific` numbers when they are converted to other arbitrary precision types that do not represent them efficiently in memory.

7+This means that trying to decode a number such as `1e1000000000` into an `Integer` will now fail instead of using a lot of memory. If you need to represent large numbers you can add a newtype (preferably over `Scientific`) and providing a parser using `withScientific`.

9+The following instances are affected by this:

10+* `FromJSON Natural`

11+* `FromJSONKey Natural`

12+* `FromJSON Integer`

13+* `FromJSONKey Integer`

14+* `FromJSON NominalDiffTime`

15+

16+For the same reasons the following instances & functions have been removed:

17+* Remove `FromJSON Data.Attoparsec.Number` instance. Note that `Data.Attoparsec.Number` is deprecated.

5* Remove deprecated `withNumber`, use `withScientific` instead.

18* Remove deprecated `withNumber`, use `withScientific` instead.

20+Finally, encoding integral values with large exponents now uses scientific notation, this saves space for large numbers.

21+

7### 1.3.1.1

22### 1.3.1.1

9* Catch 0 denominators when parsing Ratio

24* Catch 0 denominators when parsing Ratio

tests/UnitTests.hs+37

@@ -31,9 +31,11 @@ import Data.Aeson.Types (Options(..), Result(Success), ToJSON(..), Value(Null),

31import Data.Char (toUpper)

32import Data.Either.Compat (isLeft, isRight)

33import Data.Hashable (hash)

34+import Data.HashMap.Strict (HashMap)

34import Data.List (sort)

35import Data.List (sort)

35import Data.Maybe (fromMaybe)

36import Data.Maybe (fromMaybe)

36import Data.Sequence (Seq)

37import Data.Sequence (Seq)

38+import Data.Scientific (Scientific, scientific)

37import Data.Tagged (Tagged(..))

39import Data.Tagged (Tagged(..))

38import Data.Text (Text)

40import Data.Text (Text)

39import Data.Time (UTCTime)

41import Data.Time (UTCTime)

@@ -41,6 +43,7 @@ import Data.Time.Format (parseTime)

41import Data.Time.Locale.Compat (defaultTimeLocale)

43import Data.Time.Locale.Compat (defaultTimeLocale)

42import GHC.Generics (Generic)

44import GHC.Generics (Generic)

43import Instances ()

45import Instances ()

46+import Numeric.Natural (Natural)

44import System.Directory (getDirectoryContents)

47import System.Directory (getDirectoryContents)

45import System.FilePath ((</>), takeExtension, takeFileName)

48import System.FilePath ((</>), takeExtension, takeFileName)

46import Test.Tasty (TestTree, testGroup)

49import Test.Tasty (TestTree, testGroup)

@@ -100,6 +103,10 @@ tests = testGroup "unit" [

100 , testCase "withEmbeddedJSON" withEmbeddedJSONTest

103 , testCase "withEmbeddedJSON" withEmbeddedJSONTest

101 , testCase "SingleFieldCon" singleFieldCon

104 , testCase "SingleFieldCon" singleFieldCon

102 , testCase "Ratio with denominator 0" ratioDenominator0

105 , testCase "Ratio with denominator 0" ratioDenominator0

106+ , testCase "Big scientific exponent" bigScientificExponent

107+ , testCase "Big integer decoding" bigIntegerDecoding

108+ , testCase "Big natural decading" bigNaturalDecoding

109+ , testCase "Big integer key decoding" bigIntegerKeyDecoding

103 ]

110 ]

104

111

105roundTripCamel :: String -> Assertion

112roundTripCamel :: String -> Assertion

@@ -552,6 +559,36 @@ ratioDenominator0 =

552 (Left "Error in $: Ratio denominator was 0")

559 (Left "Error in $: Ratio denominator was 0")

553 (eitherDecode "{ \"numerator\": 1, \"denominator\": 0 }" :: Either String Rational)

560 (eitherDecode "{ \"numerator\": 1, \"denominator\": 0 }" :: Either String Rational)

554

561

562+bigScientificExponent :: Assertion

563+bigScientificExponent =

564+ assertEqual "Encoding an integral scientific with a large exponent should normalize it"

565+ "1.0e2000"

566+ (encode (scientific 1 2000 :: Scientific))

567+

568+bigIntegerDecoding :: Assertion

569+bigIntegerDecoding =

570+ assertEqual "Decoding an Integer with a large exponent should fail"

571+ (Left "Error in $: expected a number with exponent <= 1024, encountered Number")

572+ ((eitherDecode :: L.ByteString -> Either String Integer) "1e2000")

573+

574+bigNaturalDecoding :: Assertion

575+bigNaturalDecoding =

576+ assertEqual "Decoding a Natural with a large exponent should fail"

577+ (Left "Error in $: expected a number with exponent <= 1024, encountered Number")

578+ ((eitherDecode :: L.ByteString -> Either String Integer) "1e2000")

579+

580+bigIntegerKeyDecoding :: Assertion

581+bigIntegerKeyDecoding =

582+ assertEqual "Decoding an Integer key with a large exponent should fail"

583+ (Left "Error in $['1e2000']: expected a number with exponent <= 1024, encountered Number")

584+ ((eitherDecode :: L.ByteString -> Either String (HashMap Integer Value)) "{ \"1e2000\": null }")

585+

586+bigNaturalKeyDecoding :: Assertion

587+bigNaturalKeyDecoding =

588+ assertEqual "Decoding an Integer key with a large exponent should fail"

589+ (Left "Error in $['1e2000']: expected a number with exponent <= 1024, encountered Number")

590+ ((eitherDecode :: L.ByteString -> Either String (HashMap Natural Value)) "{ \"1e2000\": null }")

591+

555deriveJSON defaultOptions{omitNothingFields=True} ''MyRecord

592deriveJSON defaultOptions{omitNothingFields=True} ''MyRecord

556

593

557deriveToJSON defaultOptions ''Foo

594deriveToJSON defaultOptions ''Foo