Reject large exponents when parsing scientific notation

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`)

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"

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"

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"

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"

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"

tests/JSONTestSuite/results/i_number_huge_exp.ttok

@@ -0,0 +1,3 @@
+TkArrayOpen
+TkItem
+TkErr "Scientific notation with exponent too large"

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 } |]