From cf20049bb1653104ed00ed5f5878a9473b5e455e Mon Sep 17 00:00:00 2001 From: Li-yao Xia Date: Fri, 23 Oct 2026 22:19:38 +0200 Subject: [PATCH] Reject large exponents when parsing scientific notation --- changelog.md | 6 +++++ src/Data/Aeson/Decoding/ByteString.hs | 18 +++++++------- src/Data/Aeson/Decoding/ByteString/Lazy.hs | 18 +++++++------- src/Data/Aeson/Decoding/Text.hs | 18 +++++++------- tests/JSONTestSuite.hs | 1 - .../results/i_number_huge_exp.tok | 3 +-- .../results/i_number_huge_exp.ttok | 3 +++ tests/UnitTests.hs | 24 ++++++++++++++++++- 8 files changed, 63 insertions(+), 28 deletions(-) create mode 100644 tests/JSONTestSuite/results/i_number_huge_exp.ttok diff --git a/changelog.md b/changelog.md index 640994049..1237086fd 100644 --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,11 @@ For the latest version of this document, please see [https://github.com/haskell/aeson/blob/master/changelog.md](https://github.com/haskell/aeson/blob/master/changelog.md). +### Upcoming + +* Reject large exponents when parsing scientific notation. Previously, parsing + a JSON number into a `Value` would silently let the exponent overflow if it is + greater than `maxBound :: Int` or smaller than `minBound :: Int`. + ### 2.3.2.0 - 2026-09-12 * Remove unsound rewrite rule on `FromJSONKey` (`fmap coerce = coerce`) diff --git a/src/Data/Aeson/Decoding/ByteString.hs b/src/Data/Aeson/Decoding/ByteString.hs index 19ff77c46..31f05f334 100644 --- a/src/Data/Aeson/Decoding/ByteString.hs +++ b/src/Data/Aeson/Decoding/ByteString.hs @@ -251,23 +251,25 @@ scanNumberLiteral kont err bs0 = state_start bs0 where go_sci_pos :: Integer -> Int -> ByteString -> Int -> ByteString -> r go_sci_pos !coef !exp10 !bs2 !n !bs = case BS.uncons bs of - Nothing -> kont (NumScientific sci) bs Just (w8, bs') | W8.DIGIT_0 <= w8, w8 <= W8.DIGIT_9 -> go_sci_pos coef exp10 bs2 (n + 1) bs' - | otherwise -> kont (NumScientific sci) bs + -- Technically it would be more lenient to bound `toInteger exp10 + exp10'` + -- but the extra complexity is not worth it. + _ | exp10' <= toInteger (maxBound :: Int) -> kont (NumScientific sci) bs + _ -> err "Scientific notation with exponent too large" where - exp10' = fromInteger (byteStringToInteger (BS.Unsafe.unsafeTake n bs2)) - sci = Sci.scientific coef (exp10 + exp10') + exp10' = byteStringToInteger (BS.Unsafe.unsafeTake n bs2) + sci = Sci.scientific coef (exp10 + fromInteger exp10') go_sci_neg :: Integer -> Int -> ByteString -> Int -> ByteString -> r go_sci_neg !coef !exp10 !bs2 !n !bs = case BS.uncons bs of - Nothing -> kont (NumScientific sci) bs Just (w8, bs') | W8.DIGIT_0 <= w8, w8 <= W8.DIGIT_9 -> go_sci_neg coef exp10 bs2 (n + 1) bs' - | otherwise -> kont (NumScientific sci) bs + _ | exp10' <= - toInteger (minBound - exp10) -> kont (NumScientific sci) bs + _ -> err "Scientific notation with exponent too small" where - exp10' = fromInteger (byteStringToInteger (BS.Unsafe.unsafeTake n bs2)) - sci = Sci.scientific coef (exp10 - exp10') + exp10' = byteStringToInteger (BS.Unsafe.unsafeTake n bs2) + sci = Sci.scientific coef (exp10 - fromInteger exp10') errEnd = err "Unexpected end-of-input while parsing number literal" errUnx w8 = err $ "Unexpected " ++ show (chr (fromIntegral w8)) ++ " while parsing number literal" diff --git a/src/Data/Aeson/Decoding/ByteString/Lazy.hs b/src/Data/Aeson/Decoding/ByteString/Lazy.hs index 1c0bfd115..4b5c3a612 100644 --- a/src/Data/Aeson/Decoding/ByteString/Lazy.hs +++ b/src/Data/Aeson/Decoding/ByteString/Lazy.hs @@ -257,23 +257,25 @@ scanNumberLiteral kont err bs0 = state_start bs0 where go_sci_pos :: Integer -> Int -> ByteString -> Int -> ByteString -> r go_sci_pos !coef !exp10 !bs2 !n !bs = case LBS.uncons bs of - Nothing -> kont (NumScientific sci) bs Just (w8, bs') | W8.DIGIT_0 <= w8, w8 <= W8.DIGIT_9 -> go_sci_pos coef exp10 bs2 (n + 1) bs' - | otherwise -> kont (NumScientific sci) bs + -- Technically it would be more lenient to bound `toInteger exp10 + exp10'` + -- but the extra complexity is not worth it. + _ | exp10' <= toInteger (maxBound :: Int) -> kont (NumScientific sci) bs + _ -> err "Scientific notation with exponent too large" where - exp10' = fromInteger (byteStringToInteger (lbsTake n bs2)) - sci = Sci.scientific coef (exp10 + exp10') + exp10' = byteStringToInteger (lbsTake n bs2) + sci = Sci.scientific coef (exp10 + fromInteger exp10') go_sci_neg :: Integer -> Int -> ByteString -> Int -> ByteString -> r go_sci_neg !coef !exp10 !bs2 !n !bs = case LBS.uncons bs of - Nothing -> kont (NumScientific sci) bs Just (w8, bs') | W8.DIGIT_0 <= w8, w8 <= W8.DIGIT_9 -> go_sci_neg coef exp10 bs2 (n + 1) bs' - | otherwise -> kont (NumScientific sci) bs + _ | exp10' <= - toInteger (minBound - exp10) -> kont (NumScientific sci) bs + _ -> err "Scientific notation with exponent too small" where - exp10' = fromInteger (byteStringToInteger (lbsTake n bs2)) - sci = Sci.scientific coef (exp10 - exp10') + exp10' = byteStringToInteger (lbsTake n bs2) + sci = Sci.scientific coef (exp10 - fromInteger exp10') errEnd = err "Unexpected end-of-input while parsing number literal" errUnx w8 = err $ "Unexpected " ++ show (chr (fromIntegral w8)) ++ " while parsing number literal" diff --git a/src/Data/Aeson/Decoding/Text.hs b/src/Data/Aeson/Decoding/Text.hs index 97ad56839..9be4f5e74 100644 --- a/src/Data/Aeson/Decoding/Text.hs +++ b/src/Data/Aeson/Decoding/Text.hs @@ -261,23 +261,25 @@ scanNumberLiteral kont err bs0 = state_start bs0 where go_sci_pos :: Integer -> Int -> Text -> Int -> Text -> r go_sci_pos !coef !exp10 !bs2 !n !bs = case unconsPoint bs of - Nothing -> kont (NumScientific sci) bs Just (w8, bs') | W.DIGIT_0 <= w8, w8 <= W.DIGIT_9 -> go_sci_pos coef exp10 bs2 (n + 1) bs' - | otherwise -> kont (NumScientific sci) bs + -- Technically it would be more lenient to bound `toInteger exp10 + exp10'` + -- but the extra complexity is not worth it. + _ | exp10' <= toInteger (maxBound :: Int) -> kont (NumScientific sci) bs + _ -> err "Scientific notation with exponent too large" where - exp10' = fromInteger (textToInteger (unsafeTakePoints n bs2)) - sci = Sci.scientific coef (exp10 + exp10') + exp10' = textToInteger (unsafeTakePoints n bs2) + sci = Sci.scientific coef (exp10 + fromInteger exp10') go_sci_neg :: Integer -> Int -> Text -> Int -> Text -> r go_sci_neg !coef !exp10 !bs2 !n !bs = case unconsPoint bs of - Nothing -> kont (NumScientific sci) bs Just (w8, bs') | W.DIGIT_0 <= w8, w8 <= W.DIGIT_9 -> go_sci_neg coef exp10 bs2 (n + 1) bs' - | otherwise -> kont (NumScientific sci) bs + _ | exp10' <= - toInteger (minBound - exp10) -> kont (NumScientific sci) bs + _ -> err "Scientific notation with exponent too small" where - exp10' = fromInteger (textToInteger (unsafeTakePoints n bs2)) - sci = Sci.scientific coef (exp10 - exp10') + exp10' = textToInteger (unsafeTakePoints n bs2) + sci = Sci.scientific coef (exp10 - fromInteger exp10') errEnd = err "Unexpected end-of-input while parsing number literal" errUnx w8 = err $ "Unexpected " ++ show (chr (fromIntegral w8)) ++ " while parsing number literal" diff --git a/tests/JSONTestSuite.hs b/tests/JSONTestSuite.hs index b373feb10..08c480cbb 100644 --- a/tests/JSONTestSuite.hs +++ b/tests/JSONTestSuite.hs @@ -156,7 +156,6 @@ tests = do ignore_accepted :: HashSet.HashSet FilePath ignore_accepted = HashSet.fromList [ "i_number_double_huge_neg_exp.json" - , "i_number_huge_exp.json" , "i_number_neg_int_huge_exp.json" , "i_number_pos_double_huge_exp.json" , "i_number_real_neg_overflow.json" diff --git a/tests/JSONTestSuite/results/i_number_huge_exp.tok b/tests/JSONTestSuite/results/i_number_huge_exp.tok index 0a9bd3d3d..bea05b1ce 100644 --- a/tests/JSONTestSuite/results/i_number_huge_exp.tok +++ b/tests/JSONTestSuite/results/i_number_huge_exp.tok @@ -1,4 +1,3 @@ TkArrayOpen TkItem -TkNumber NumScientific 4.0e-30000000995 -TkArrayEnd +TkErr "Scientific notation with exponent too large" diff --git a/tests/JSONTestSuite/results/i_number_huge_exp.ttok b/tests/JSONTestSuite/results/i_number_huge_exp.ttok new file mode 100644 index 000000000..bea05b1ce --- /dev/null +++ b/tests/JSONTestSuite/results/i_number_huge_exp.ttok @@ -0,0 +1,3 @@ +TkArrayOpen +TkItem +TkErr "Scientific notation with exponent too large" diff --git a/tests/UnitTests.hs b/tests/UnitTests.hs index 31605094a..b2e72d686 100644 --- a/tests/UnitTests.hs +++ b/tests/UnitTests.hs @@ -28,7 +28,7 @@ module UnitTests import Prelude.Compat import Control.Monad (forM, forM_, when) -import Data.Aeson ((.=), (.:), (.:?), (.:!), FromJSON(..), ToJSON1(..), decode, eitherDecode, encode, fromJSON, genericParseJSON, genericToEncoding, genericToJSON, object, withObject, withEmbeddedJSON) +import Data.Aeson ((.=), (.:), (.:?), (.:!), FromJSON(..), ToJSON1(..), decode, eitherDecode, eitherDecodeStrict, encode, fromJSON, genericParseJSON, genericToEncoding, genericToJSON, object, withObject, withEmbeddedJSON, eitherDecodeStrictText) import Data.Aeson.Types (JSONPathElement(..), formatError) import Data.Aeson.QQ.Simple (aesonQQ) import Data.Aeson.TH (deriveJSON, deriveToJSON, deriveToJSON1) @@ -43,6 +43,7 @@ import Data.HashMap.Strict (HashMap) import Data.Kind (Type) import Data.List (isSuffixOf) import Data.Scientific (Scientific, scientific) +import Data.String (IsString, fromString) import GHC.Generics (Generic) #if __GLASGOW_HASKELL__ >= 806 import GHC.Generics.Generically (Generically (..)) @@ -513,6 +514,26 @@ type instance Fam757 = Maybe newtype Newtype757 a = MkNewtype757 (Fam757 a) deriveToJSON1 defaultOptions ''Newtype757 +veryBigExponent :: Assertion +veryBigExponent = do + let big, small :: IsString a => a + big = fromString $ "1e" ++ show (toInteger (maxBound :: Int) + 1) + small = fromString $ "1.1e" ++ show (toInteger (minBound :: Int)) + bigErr = Left "Scientific notation with exponent too large" :: Either String Value + smallErr = Left "Scientific notation with exponent too small" :: Either String Value + assertEqual "Reject very large exponent even in Value (Strict BS)" + bigErr (eitherDecodeStrict big) + assertEqual "Reject very negative exponent even in Value (Strict BS)" + smallErr (eitherDecodeStrict small) + assertEqual "Reject very large exponent even in Value (Lazy BS)" + bigErr (eitherDecode big) + assertEqual "Reject very negative exponent even in Value (Lazy BS)" + smallErr (eitherDecode small) + assertEqual "Reject very large exponent even in Value (Strict Text)" + bigErr (eitherDecodeStrictText big) + assertEqual "Reject very negative exponent even in Value (Strict Text)" + smallErr (eitherDecodeStrictText small) + ------------------------------------------------------------------------------- -- Tests trees ------------------------------------------------------------------------------- @@ -568,6 +589,7 @@ tests = testGroup "unit" [ , testCase "Big natural decoding" bigNaturalDecoding , testCase "Big integer key decoding" bigIntegerKeyDecoding , testCase "Big natural key decoding" bigNaturalKeyDecoding + , testCase "Very big exponent" veryBigExponent , testGroup "QQ.Simple" [ testCase "example" $ assertEqual "" (object ["foo" .= True]) [aesonQQ| {"foo": true } |]