Fix parsing of fractional numbers with very negative exponents and years with many digits

aeson.cabal

@@ -1,6 +1,6 @@
 cabal-version:      2.2
 name:               aeson
-version:            2.2.5.0
+version:            2.3.0.0
 license:            BSD-3-Clause
 license-file:       LICENSE
 category:           Text, Web, JSON
@@ -130,7 +130,7 @@ library
     , semialign             ^>=1.3      || ^>=1.4
     , strict                ^>=0.5
     , tagged                ^>=0.8.7
-    , text-iso8601          ^>=0.1.1
+    , text-iso8601          >=0.1.1 && < 0.3
     , text-short            ^>=0.1.5
     , th-abstraction        ^>=0.5.0.0  || ^>=0.6.0.0 || ^>=0.7.0.0
     , these                 ^>=1.2

attoparsec-aeson/attoparsec-aeson.cabal

@@ -44,7 +44,7 @@ library
     Data.Aeson.Internal.Text
 
   build-depends:
-    , aeson               >=2.2.2.0  && <2.3
+    , aeson               >=2.2.2.0  && <2.4
     , attoparsec          >=0.14.2   && <0.15
     , base                >=4.12.0.0 && <5
     , bytestring          >=0.10.8.2 && <0.13

changelog.md

@@ -1,5 +1,16 @@
 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).
 
+### 2.3.0.0 - 2026-05-21
+
+* Fix parsing of fractional numbers to reject exponents smaller than -1024.
+  This breaking change affects `FromJSON` instances of `Fixed`, `DiffTime`, and `NominalDiffTime`,
+  rejecting more inputs. Error messages for `Ratio` and integral types are also slightly different
+  due to reusing the same bounding logic.
+* Fix typo in error message: "~~Unespected~~ Unexpected control character while parsing string literal".
+* Accept 24:00:00 time of day.
+* Support nothunks 0.3.
+* Unset executable permissions in some test files and remove a broken symlink.
+
 ### 2.2.5.0
 
 * Support `semialign-1.4`

src/Data/Aeson/Types/FromJSON.hs

@@ -796,11 +796,13 @@ withBoundedScientific' f v = withBoundedScientific_ id f v
 withBoundedScientific_ :: (Parser a -> Parser a) -> (Scientific -> Parser a) -> Value -> Parser a
 withBoundedScientific_ whenFail f (Number scientific) =
     if exp10 > 1024
-    then whenFail (fail msg)
+    then whenFail (fail (msg "greater than 1024"))
+    else if exp10 < -1024
+    then whenFail (fail (msg "less than -1024"))
     else f scientific
   where
     exp10 = base10Exponent scientific
-    msg = "found a number with exponent " ++ show exp10 ++ ", but it must not be greater than 1024"
+    msg req = "found a number with exponent " ++ show exp10 ++ ", but it must not be " ++ req
 withBoundedScientific_ whenFail _ v =
     whenFail (typeMismatch "Number" v)
 
@@ -1706,14 +1708,7 @@ instance FromJSONKey Float where
         _      -> Scientific.toRealFloat <$> parseScientificText t
 
 instance (FromJSON a, Integral a) => FromJSON (Ratio a) where
-    parseJSON (Number x)
-      | exp10 <= 1024
-      , exp10 >= -1024 = return $! realToFrac x
-      | otherwise      = prependContext "Ratio" $ fail msg
-      where
-        exp10 = base10Exponent x
-        msg = "found a number with exponent " ++ show exp10
-           ++ ", but it must not be greater than 1024 or less than -1024"
+    parseJSON n@(Number _) = withBoundedScientific "Ratio" (($!) pure . realToFrac) n
     parseJSON o = objParser o
       where
         objParser = withObject "Rational" $ \obj -> do

tests/UnitTests.hs

@@ -38,6 +38,7 @@ import Data.Aeson.Types
   , Value(..), camelTo, camelTo2
   , defaultOptions, formatPath, formatRelativePath, omitNothingFields, parse)
 import Data.Char (toUpper, GeneralCategory(Control,Surrogate), generalCategory)
+import Data.Fixed (Nano)
 import Data.HashMap.Strict (HashMap)
 import Data.Kind (Type)
 import Data.List (isSuffixOf)
@@ -459,17 +460,22 @@ rationalNumber =
     (eitherDecode "1.37" :: Either String Rational)
 
 bigRationalDecoding :: Assertion
-bigRationalDecoding =
-  assertEqual "Decoding an Integer with a large exponent should fail"
-    (Left "Error in $: parsing Ratio failed, found a number with exponent 2000, but it must not be greater than 1024 or less than -1024")
+bigRationalDecoding = do
+  assertEqual "Decoding a Rational with a large exponent should fail"
+    (Left "Error in $: parsing Ratio failed, found a number with exponent 2000, but it must not be greater than 1024")
     ((eitherDecode :: L.ByteString -> Either String Rational) "1e2000")
-
-smallRationalDecoding :: Assertion
-smallRationalDecoding =
-  assertEqual "Decoding an Integer with a large exponent should fail"
-    (Left "Error in $: parsing Ratio failed, found a number with exponent -2000, but it must not be greater than 1024 or less than -1024")
+  assertEqual "Decoding a Rational with a small exponent should fail"
+    (Left "Error in $: parsing Ratio failed, found a number with exponent -2000, but it must not be less than -1024")
     ((eitherDecode :: L.ByteString -> Either String Rational) "1e-2000")
 
+bigFixedDecoding :: Assertion
+bigFixedDecoding = do
+  assertEqual "Decoding a Fixed with a large exponent should fail"
+    (Left "Error in $: parsing Fixed failed, found a number with exponent 9999, but it must not be greater than 1024")
+    ((eitherDecode :: L.ByteString -> Either String Nano) "1e9999")
+  assertEqual "Decoding a Fixed with a small exponent should fail"
+    (Left "Error in $: parsing Fixed failed, found a number with exponent -9999, but it must not be less than -1024")
+    ((eitherDecode :: L.ByteString -> Either String Nano) "1e-9999")
 
 bigScientificExponent :: Assertion
 bigScientificExponent =
@@ -556,7 +562,7 @@ tests = testGroup "unit" [
   , testCase "Ratio with denominator 0" ratioDenominator0
   , testCase "Rational parses number"   rationalNumber
   , testCase "Big rational"             bigRationalDecoding
-  , testCase "Small rational"           smallRationalDecoding
+  , testCase "Big fixed"                bigFixedDecoding
   , testCase "Big scientific exponent" bigScientificExponent
   , testCase "Big integer decoding" bigIntegerDecoding
   , testCase "Big natural decoding" bigNaturalDecoding

text-iso8601/changelog.md

@@ -1,3 +1,7 @@
+# 0.2.0.0 - 2026-05-21
+
+- Fix parsers to reject years with more than 15 digits
+
 # 0.1.1
 
 - Support GHC-8.6.5...9.10.1

text-iso8601/src/Data/Time/FromText.hs

@@ -272,19 +272,24 @@ parseYear_ kontEOF kontC (Text arr offS lenS) = start offS lenS where
     start :: Int -> Int -> Either String r
     start !off !len = unconsAscii_ arr off len
         (unexpectedEOF "-, +, or a digit") $ \c off' len' -> case c of
-            '-' -> loop negate off' off' len'
-            '+' -> loop id     off' off' len'
+            -- year is capped to 15 digits and we try consuming one more before raising an error, hence max 16 digits
+            '-' -> loop negate off' off' (min len' 16)
+            '+' -> loop id     off' off' (min len' 16)
             _
-                | '0' <= c, c <= '9' -> loop id    off  off' len'
+                | '0' <= c, c <= '9' -> loop id off off' (min len' 15)  -- already consumed first digit, 15 left
                 | otherwise          -> Left $ "Unexpected '" ++ show c ++ ", expecting -, +, or a digit"
 
+    -- The caller must make sure not to consume too many digits, to avoid complexity blow up in conversion to Integer!
     loop :: (Integer -> Integer) -> Int -> Int -> Int -> Either String r
     loop !posNeg !off0 !off !len = unconsAscii_ arr off len (finishEOF posNeg off0 off) $ \c off' len' -> if
         | '0' <= c, c <= '9' -> loop posNeg off0 off' len'
-        | otherwise          -> finishC posNeg c off0 off off' len'
+        | otherwise          -> finishC posNeg c off0 off off' (lenS - (off' - offS)) -- restore the full remaining length
 
     finishEOF :: (Integer -> Integer) -> Int -> Int -> Either String r
     finishEOF !posNeg !off0 !off
+        | len0 >= 16
+        = Left "expected year with at most 15 digits"
+
         | len0 >= 4
         = year `seq` kontEOF year
 

text-iso8601/tests/text-iso8601-tests.hs

@@ -12,7 +12,7 @@ import           Test.QuickCheck            (Arbitrary, counterexample,
                                              property)
 import           Test.QuickCheck.Instances  ()
 import           Test.Tasty                 (TestTree, defaultMain, testGroup)
-import           Test.Tasty.HUnit           (assertFailure, testCase)
+import           Test.Tasty.HUnit           (assertEqual, assertFailure, testCase)
 import           Test.Tasty.QuickCheck      (testProperty)
 
 import qualified Data.Text                  as T
@@ -68,24 +68,27 @@ main = defaultMain $ testGroup "text-iso8601"
 
     , testGroup "rejected"
         -- https://github.com/haskell/aeson/issues/1033
-        [ rejects T.parseUTCTime "2023-06-09T02:35:33 Z"
+        [ rejects T.parseUTCTime "2023-06-09T02:35:33 Z" "Unexpected ' ', expecting timezone: Z, +HH:MM or -HH:MM"
 
         -- Y2K years
-        , rejects T.parseDay "99-12-12"
+        , rejects T.parseDay "99-12-12" "expected year with at least 4 digits"
 
         -- we don't accept lowercase T or Z
         -- RFC3339 says we MAY limit, i.e. requiring they should be uppercase.
-        , rejects T.parseUTCTime "2023-06-09T02:35:33z"
-        , rejects T.parseUTCTime "2023-06-09t02:35:33Z"
+        , rejects T.parseUTCTime "2023-06-09T02:35:33z" "Unexpected 'z', expecting timezone: Z, +HH:MM or -HH:MM"
+        , rejects T.parseUTCTime "2023-06-09t02:35:33Z" "Unexpected 't', expecting a day separator, T or space"
 
         -- accepts +23:59, but not 24 or 60
-        , rejects T.parseUTCTime "1937-01-01T12:00:00+24:59"
-        , rejects T.parseUTCTime "1937-01-01T12:00:00-23:60"
+        , rejects T.parseUTCTime "1937-01-01T12:00:00+24:59" "Invalid TimeZone:(24,59)"
+        , rejects T.parseUTCTime "1937-01-01T12:00:00-23:60" "Invalid TimeZone:(23,60)"
 
         -- rejects 24:xx:xx except 24:00:00
-        , rejects T.parseUTCTime "1990-12-31T24:00:01Z"
-        , rejects T.parseUTCTime "1990-12-31T24:00:60Z"
-        , rejects T.parseUTCTime "1990-12-31T24:01:00Z"
+        , rejects T.parseUTCTime "1990-12-31T24:00:01Z" "Invalid time of day:(24,0,1.000000000000)"
+        , rejects T.parseUTCTime "1990-12-31T24:00:60Z" "Invalid time of day:(24,0,60.000000000000)"
+        , rejects T.parseUTCTime "1990-12-31T24:01:00Z" "Invalid time of day:(24,1,0.000000000000)"
+
+        -- Reject long years
+        , rejects T.parseUTCTime "1234567890123456-01-01T01:01Z" "expected year with at most 15 digits"
         ]
     ]
 
@@ -106,10 +109,10 @@ roundtrip eq build parse = testProperty (show (typeRep (Proxy :: Proxy a))) $ \x
        counterexample (show y) $
        property (liftEq eq y (Right x))
 
-rejects :: forall a. (Typeable a, Show a) => (Text -> Either String a) -> String -> TestTree
-rejects parse inp = testCase (show (typeRep (Proxy :: Proxy a)) ++ " rejects " ++ show inp) $ do
+rejects :: forall a. (Typeable a, Show a) => (Text -> Either String a) -> String -> String -> TestTree
+rejects parse inp expected = testCase (show (typeRep (Proxy :: Proxy a)) ++ " rejects " ++ show inp) $ do
     case parse (T.pack inp) of
-        Left _  -> return ()
+        Left actual -> assertEqual "Error message mismatch" actual expected
         Right a -> assertFailure $ "Unexpectedly accepted: " ++ show a
 
 accepts :: forall a. (Typeable a, Show a) => (Text -> Either String a) -> String -> TestTree

text-iso8601/text-iso8601.cabal

@@ -1,6 +1,6 @@
 cabal-version:      1.12
 name:               text-iso8601
-version:            0.1.1.1
+version:            0.2.0.0
 synopsis:           Converting time to and from ISO 8601 text.
 description:
   Converting time to and from ISO 8601 text.