diff --git a/changelog.md b/changelog.md index 64099404..1237086f 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 19ff77c4..31f05f33 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 1c0bfd11..4b5c3a61 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 97ad5683..9be4f5e7 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 b373feb1..08c480cb 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 0a9bd3d3..bea05b1c 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 00000000..bea05b1c --- /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 31605094..b2e72d68 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 } |]