diff --git a/aeson.cabal b/aeson.cabal index f1595c8d..87877928 100644 --- a/aeson.cabal +++ b/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 diff --git a/attoparsec-aeson/attoparsec-aeson.cabal b/attoparsec-aeson/attoparsec-aeson.cabal index 9a3ffb97..67b51fba 100644 --- a/attoparsec-aeson/attoparsec-aeson.cabal +++ b/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 diff --git a/changelog.md b/changelog.md index f876fdb7..a21bd5e5 100644 --- a/changelog.md +++ b/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` diff --git a/src/Data/Aeson/Types/FromJSON.hs b/src/Data/Aeson/Types/FromJSON.hs index 7fbacaea..6629518c 100644 --- a/src/Data/Aeson/Types/FromJSON.hs +++ b/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 diff --git a/tests/UnitTests.hs b/tests/UnitTests.hs index 91bc0245..da2bc657 100644 --- a/tests/UnitTests.hs +++ b/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 diff --git a/text-iso8601/changelog.md b/text-iso8601/changelog.md index 09aeb731..2345070b 100644 --- a/text-iso8601/changelog.md +++ b/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 diff --git a/text-iso8601/src/Data/Time/FromText.hs b/text-iso8601/src/Data/Time/FromText.hs index 4b1c4b8c..4722f4bf 100644 --- a/text-iso8601/src/Data/Time/FromText.hs +++ b/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 diff --git a/text-iso8601/tests/text-iso8601-tests.hs b/text-iso8601/tests/text-iso8601-tests.hs index 62282735..3cfcc9ff 100644 --- a/text-iso8601/tests/text-iso8601-tests.hs +++ b/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 diff --git a/text-iso8601/text-iso8601.cabal b/text-iso8601/text-iso8601.cabal index 8b5d006d..3eac54be 100644 --- a/text-iso8601/text-iso8601.cabal +++ b/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.