diff --git a/aeson.cabal b/aeson.cabal --- a/aeson.cabal +++ b/aeson.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: aeson -version: 2.3.1.0 +version: 2.3.2.0 license: BSD-3-Clause license-file: LICENSE category: Text, Web, JSON diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,7 +1,12 @@ 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.1.0 +### 2.3.2.0 - 2026-09-12 +* Remove unsound rewrite rule on `FromJSONKey` (`fmap coerce = coerce`) +* Fix `listParser` to include list indices in error traces + +### 2.3.1.0 - 2026-07-05 + * Add `FromJSONKey` instance for `Data.Fixed`. * Add `ToJSON` and `FromJSON` instances for `Data.Complex`. * Export `isEmptyArray` from `Data.Aeson.Types` module. @@ -9,16 +14,23 @@ ### 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 DoS vulnerabilities caused by parsing large numbers (advisory [HSEC-2026-0007](https://haskell.github.io/security-advisories/advisory/HSEC-2026-0007.html)). Backported to 2.2.5.1, see below. * Fix typo in error message: "~~Unespected~~ Unexpected control character while parsing string literal". * Support nothunks 0.3. * Unset executable permissions in some test files and remove a broken symlink. * In `text-iso8601-0.2.0.0`: - - Reject years of more than 15 digits. - Accept 24:00:00 time of day. + +### 2.2.5.1 - 2026-08-29 + +Fix a DoS vulnerability caused by parsing large numbers (advisory [HSEC-2026-0007](https://haskell.github.io/security-advisories/advisory/HSEC-2026-0007.html)). Backported from 2.3.0.0 to ease migration. + +* (HSEC-2026-0007) Fix parsing of fractional numbers to reject exponents smaller than -1024. + This 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. +* In `text-iso8601-0.1.1.2` (backported from 0.2.0.0): + - (HSEC-2026-0007) Reject years of more than 15 digits. ### 2.2.5.0 diff --git a/src/Data/Aeson.hs b/src/Data/Aeson.hs --- a/src/Data/Aeson.hs +++ b/src/Data/Aeson.hs @@ -200,7 +200,10 @@ -- This function parses immediately, but defers conversion. See -- 'json' for details. -- --- Throws an 'Exception' when the file is missing. +-- Throws an exception when the file cannot be accessed +-- (e.g., it is missing or permissions are invalid). +-- This function uses 'Data.ByteString.readFile' without handling +-- any of its exceptions. decodeFileStrict :: (FromJSON a) => FilePath -> IO (Maybe a) decodeFileStrict = fmap decodeStrict . B.readFile @@ -228,7 +231,10 @@ -- If this fails due to incomplete or invalid input, 'Nothing' is -- returned. -- --- Throws an 'Exception' when the file is missing. +-- Throws an exception when the file cannot be accessed +-- (e.g., it is missing or permissions are invalid). +-- This function uses 'Data.ByteString.readFile' without handling +-- any of its exceptions. -- -- Since @2.2.0.0@ an alias for 'decodeFileStrict'. decodeFileStrict' :: (FromJSON a) => FilePath -> IO (Maybe a) @@ -236,7 +242,10 @@ -- | Like 'decodeFileStrict' but returns an error message when decoding fails. -- --- Throws an 'Exception' when the file is missing. +-- Throws an exception when the file cannot be accessed +-- (e.g., it is missing or permissions are invalid). +-- This function uses 'Data.ByteString.readFile' without handling +-- any of its exceptions. eitherDecodeFileStrict :: (FromJSON a) => FilePath -> IO (Either String a) eitherDecodeFileStrict = fmap eitherDecodeStrict . B.readFile @@ -258,7 +267,10 @@ -- | Like 'decodeFileStrict'' but returns an error message when decoding fails. -- --- Throws an 'Exception' when the file is missing. +-- Throws an exception when the file cannot be accessed +-- (e.g., it is missing or permissions are invalid). +-- This function uses 'Data.ByteString.readFile' without handling +-- any of its exceptions. -- -- Since @2.2.0.0@ an alias for 'eitherDecodeFileStrict'. eitherDecodeFileStrict' :: (FromJSON a) => FilePath -> IO (Either String a) @@ -374,7 +386,7 @@ -- -- \-- this encodes directly to a bytestring Builder -- 'toEncoding' (Person name age) = --- 'pairs' (\"name\" '.=' 'name' '<>' \"age\" '.=' age) +-- 'pairs' (\"name\" '.=' name '<>' \"age\" '.=' age) -- @ -- -- We can now encode a value like so: @@ -524,7 +536,7 @@ -- -- @ -- 'toEncoding' (Person name age) = --- 'pairs' (\"name\" '.=' 'name' '<>' \"age\" '.=' age) +-- 'pairs' (\"name\" '.=' name '<>' \"age\" '.=' age) -- @ -- -- Any container type that implements 'Foldable' can be encoded to a @@ -566,3 +578,6 @@ -- , -- and -- (where the relevant parsers are defined). + +-- $optionsFields +-- The functions here are in fact record fields of the 'Options' type. diff --git a/src/Data/Aeson/Key.hs b/src/Data/Aeson/Key.hs --- a/src/Data/Aeson/Key.hs +++ b/src/Data/Aeson/Key.hs @@ -55,12 +55,7 @@ toText :: Key -> Text toText = unKey --- | @'coercing r1 r2'@ will evaluate to @r1@ if 'Key' is 'Coercible' to 'Text', --- and to @r2@ otherwise. --- --- Using 'coercing' we can make more efficient implementations --- when 'Key' is backed up by 'Text' without exposing internals. --- +-- | Partially exposed coercion for forwards compatibility. coercionToText :: Maybe (Coercion Key Text) coercionToText = Just Coercion {-# INLINE coercionToText #-} diff --git a/src/Data/Aeson/KeyMap.hs b/src/Data/Aeson/KeyMap.hs --- a/src/Data/Aeson/KeyMap.hs +++ b/src/Data/Aeson/KeyMap.hs @@ -138,7 +138,7 @@ -- Map ------------------------------------------------------------------------------- --- | A map from JSON key type 'Key' to 'v'. +-- | A map from JSON key type 'Key' to @v@. newtype KeyMap v = KeyMap { unKeyMap :: Map Key v } deriving (Eq, Ord, Data, Functor) @@ -268,7 +268,7 @@ difference tm1 tm2 = KeyMap (M.difference (unKeyMap tm1) (unKeyMap tm2)) -- | The (left-biased) union of two maps. It prefers the first map when duplicate --- keys are encountered, i.e. ('union' == 'unionWith' 'const'). +-- keys are encountered, i.e. ('union' == 'unionWith' 'Prelude.const'). union :: KeyMap v -> KeyMap v -> KeyMap v union (KeyMap x) (KeyMap y) = KeyMap (M.union x y) @@ -352,7 +352,7 @@ import Data.Ord (comparing) import Prelude (fst) --- | A map from JSON key type 'Key' to 'v'. +-- | A map from JSON key type 'Key' to @v@. newtype KeyMap v = KeyMap { unKeyMap :: HashMap Key v } deriving (Eq, Ord, Data, Functor) @@ -477,7 +477,7 @@ difference tm1 tm2 = KeyMap (H.difference (unKeyMap tm1) (unKeyMap tm2)) -- | The (left-biased) union of two maps. It prefers the first map when duplicate --- keys are encountered, i.e. ('union' == 'unionWith' 'const'). +-- keys are encountered, i.e. ('union' == 'unionWith' 'Prelude.const'). union :: KeyMap v -> KeyMap v -> KeyMap v union (KeyMap x) (KeyMap y) = KeyMap (H.union x y) diff --git a/src/Data/Aeson/TH.hs b/src/Data/Aeson/TH.hs --- a/src/Data/Aeson/TH.hs +++ b/src/Data/Aeson/TH.hs @@ -591,7 +591,7 @@ deriveFromJSON2 :: Options -- ^ Encoding options. -> Name - -- ^ Name of the type for which to generate a 'FromJSON3' instance + -- ^ Name of the type for which to generate a 'FromJSON2' instance -- declaration. -> Q [Dec] deriveFromJSON2 = deriveFromJSONCommon fromJSON2Class diff --git a/src/Data/Aeson/Text.hs b/src/Data/Aeson/Text.hs --- a/src/Data/Aeson/Text.hs +++ b/src/Data/Aeson/Text.hs @@ -10,7 +10,7 @@ -- Portability: portable -- -- Most frequently, you'll probably want to encode straight to UTF-8 --- (the standard JSON encoding) using 'encode'. +-- (the standard JSON encoding) using 'Data.Aeson.encode'. -- -- You can use the conversions to 'Builder's when embedding JSON messages as -- parts of a protocol. @@ -47,8 +47,8 @@ -- embedded efficiently in a text-based protocol. -- -- If you are going to immediately encode straight to a --- 'L.ByteString', it is more efficient to use 'encode' (lazy ByteString) --- or @'fromEncoding' . 'toEncoding'@ (ByteString.Builder) instead. +-- 'Data.ByteString.Lazy.ByteString', it is more efficient to use 'Data.Aeson.encode' (lazy ByteString) +-- or @'Data.Aeson.fromEncoding' . 'toEncoding'@ ('Builder') instead. -- -- /Note:/ Uses 'toJSON' encodeToTextBuilder :: ToJSON a => a -> Builder diff --git a/src/Data/Aeson/Types/FromJSON.hs b/src/Data/Aeson/Types/FromJSON.hs --- a/src/Data/Aeson/Types/FromJSON.hs +++ b/src/Data/Aeson/Types/FromJSON.hs @@ -470,11 +470,10 @@ fmap h (FromJSONKeyValue f) = FromJSONKeyValue (fmap h . f) -- | Construct 'FromJSONKeyFunction' for types coercible from 'Text'. This --- conversion is still unsafe, as 'Hashable' and 'Eq' instances of @a@ should be +-- conversion is still unsafe, as 'Hashable', 'Eq', and 'Ord' instances of @a@ should be -- compatible with 'Text' i.e. hash values should be equal for wrapped values as well. --- This property will always be maintained if the 'Hashable' and 'Eq' instances +-- This property will always be maintained if the 'Hashable', 'Eq', and 'Ord' instances -- are derived with generalized newtype deriving. --- compatible with 'Text' i.e. hash values be equal for wrapped values as well. -- -- On pre GHC 7.8 this is unconstrained function. fromJSONKeyCoerce :: @@ -482,19 +481,16 @@ FromJSONKeyFunction a fromJSONKeyCoerce = FromJSONKeyCoerce --- | Semantically the same as @coerceFromJSONKeyFunction = fmap coerce = coerce@. +-- | Coerce the result of a 'FromJSONKeyFunction'. -- --- See note on 'fromJSONKeyCoerce'. +-- __Warning__: This function is unsafe when the argument is +-- 'fromJSONKeyCoerce'. It can break internal invariants of maps. +-- See also the note on 'fromJSONKeyCoerce'. coerceFromJSONKeyFunction :: Coercible a b => FromJSONKeyFunction a -> FromJSONKeyFunction b coerceFromJSONKeyFunction = coerce -{-# RULES - "FromJSONKeyCoerce: fmap coerce" forall x . - fmap coerce x = coerceFromJSONKeyFunction x - #-} - -- | Same as 'fmap'. Provided for the consistency with 'ToJSONKeyFunction'. mapFromJSONKeyFunction :: (a -> b) -> FromJSONKeyFunction a -> FromJSONKeyFunction b mapFromJSONKeyFunction = fmap @@ -690,7 +686,7 @@ -- | Helper function to use with 'liftParseJSON'. See 'Data.Aeson.ToJSON.listEncoding'. listParser :: (Value -> Parser a) -> Value -> Parser [a] -listParser f (Array xs) = fmap V.toList (V.mapM f xs) +listParser f (Array xs) = fmap V.toList (V.imapM (\i x -> f x Index i) xs) listParser _ v = typeMismatch "Array" v {-# INLINE listParser #-} @@ -1322,7 +1318,7 @@ -------------------------------------------------------------------------------- -- | Constructors need to be decoded differently depending on whether they're --- a record or not. This distinction is made by 'ConsParseJSON'. +-- a record or not. This distinction is made by 'ConsFromJSON'. class ConsFromJSON arity f where consParseJSON :: ConName :* TypeName :* Options :* FromArgs arity a @@ -2491,7 +2487,7 @@ instance FromJSONKey b => FromJSONKey (Tagged a b) where fromJSONKey = coerceFromJSONKeyFunction (fromJSONKey :: FromJSONKeyFunction b) - fromJSONKeyList = (fmap . fmap) Tagged fromJSONKeyList + fromJSONKeyList = coerce (fromJSONKeyList @b) ------------------------------------------------------------------------------- -- these diff --git a/src/Data/Aeson/Types/Internal.hs b/src/Data/Aeson/Types/Internal.hs --- a/src/Data/Aeson/Types/Internal.hs +++ b/src/Data/Aeson/Types/Internal.hs @@ -277,7 +277,7 @@ -- i.e. a parser to which the input has already been applied. newtype Parser a = Parser { runParser :: forall f r. - JSONPath + JSONPath -- Note: the path is accumulated in reverse: cons new elements, however `fail` (and other functions) will reverse the path before calling the failure continuation. -> Failure f r -> Success a f r -> f r @@ -488,7 +488,9 @@ -- The ordering is total, consistent with 'Eq' instance. -- However, nothing else about the ordering is specified, -- and it may change from environment to environment and version to version --- of either this package or its dependencies ('hashable' and 'unordered-containers'). +-- of either this package or its dependencies +-- ( and +-- ). -- -- @since 1.5.2.0 deriving instance Ord Value @@ -731,7 +733,7 @@ -- 'allowOmittedFieds' controls parsing behavior. , allowOmittedFields :: Bool -- ^ If 'True', missing fields of a record will be filled - -- with 'omittedField' values (if they are 'Just'). + -- with 'Data.Aeson.FromJSON.omittedField' values (if they are 'Just'). -- If 'False', all fields will required to present in the record object. , sumEncoding :: SumEncoding -- ^ Specifies how to encode constructors of a sum datatype. @@ -885,7 +887,7 @@ -- | Converts from CamelCase to another lower case, interspersing -- the character between all capital letters and their previous -- entries, except those capital letters that appear together, --- like 'API'. +-- like \"API\". -- -- For use by Aeson template haskell calls. -- diff --git a/src/Data/Aeson/Types/ToJSON.hs b/src/Data/Aeson/Types/ToJSON.hs --- a/src/Data/Aeson/Types/ToJSON.hs +++ b/src/Data/Aeson/Types/ToJSON.hs @@ -467,7 +467,7 @@ -- > deriving (Show,Read,Eq,Ord) -- -- It is possible to get the 'ToJSONKey' instance for free as we did --- with 'Foo'. However, in this case, we have a natural way to go to +-- with @Foo@. However, in this case, we have a natural way to go to -- and from 'Text' that does not require any escape sequences. So -- 'ToJSONKeyText' can be used instead of 'ToJSONKeyValue' to encode maps -- as objects instead of arrays of pairs. This instance may be diff --git a/tests/ErrorMessages.hs b/tests/ErrorMessages.hs --- a/tests/ErrorMessages.hs +++ b/tests/ErrorMessages.hs @@ -11,7 +11,7 @@ import Prelude.Compat import Data.Aeson (FromJSON(..), Value, eitherDecode) -import Data.Aeson.Types (Parser, parseEither) +import Data.Aeson.Types (Parser, listParser, parseEither) import Data.Algorithm.Diff (PolyDiff (..), getGroupedDiff) import Data.Proxy (Proxy(..)) @@ -75,6 +75,10 @@ -- issue #358 , testFor "Seq" (Proxy :: Proxy (Seq Int)) [ "[0,1,true]" + ] + + , testWith "listParser" (listParser parseJSON :: Value -> Parser [Int]) + [ "[true]" ] ] diff --git a/tests/UnitTests/FromJSONKey.hs b/tests/UnitTests/FromJSONKey.hs --- a/tests/UnitTests/FromJSONKey.hs +++ b/tests/UnitTests/FromJSONKey.hs @@ -1,8 +1,11 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DerivingVia, GADTs, GeneralizedNewtypeDeriving, OverloadedStrings #-} module UnitTests.FromJSONKey (fromJSONKeyTests) where import Test.Tasty (TestTree, testGroup) -import Test.Tasty.HUnit (testCase, Assertion, assertFailure) +import Test.Tasty.HUnit (testCase, Assertion, assertFailure, (@?=)) +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import Data.Ord (Down(..)) import Data.Text (Text) import Data.Tagged (Tagged) import Control.Applicative (Const) @@ -18,6 +21,15 @@ fromJSONKey = fmap MyText' fromJSONKey fromJSONKeyList = error "not used" +newtype DownText = DownText Text + deriving (Eq, Ord) via (Down Text) + deriving FromJSON via Text + +-- Regression test for #1169: don't rewrite fmap coerce to coerce +instance FromJSONKey DownText where + fromJSONKey = fmap w fromJSONKey + where w = DownText ; {-# NOINLINE w #-} + fromJSONKeyTests :: TestTree fromJSONKeyTests = testGroup "FromJSONKey" $ fmap (testCase "-") fromJSONKeyAssertions @@ -27,23 +39,22 @@ , assertIsCoerce "Tagged Int Text" (fromJSONKey :: FromJSONKeyFunction (Tagged Int Text)) , assertIsCoerce "MyText" (fromJSONKey :: FromJSONKeyFunction MyText) - , assertIsCoerce' "MyText'" (fromJSONKey :: FromJSONKeyFunction MyText') + , assertIsText "MyText'" (fromJSONKey :: FromJSONKeyFunction MyText') , assertIsCoerce "Const Text" (fromJSONKey :: FromJSONKeyFunction (Const Text ())) + + , assertDecodedMapIsValid ] where assertIsCoerce :: String -> FromJSONKeyFunction a -> Assertion assertIsCoerce _ FromJSONKeyCoerce = pure () assertIsCoerce n _ = assertFailure n - assertIsCoerce' :: String -> FromJSONKeyFunction a -> Assertion - assertIsCoerce' _ FromJSONKeyCoerce = pure () - assertIsCoerce' n _ = pickWithRules (assertFailure n) (pure ()) + assertIsText :: String -> FromJSONKeyFunction a -> Assertion + assertIsText _ (FromJSONKeyText _) = pure () + assertIsText n _ = assertFailure n --- | Pick the first when RULES are enabled, e.g. optimisations are on -pickWithRules - :: a -- ^ Pick this when RULES are on - -> a -- ^ use this otherwise - -> a -pickWithRules _ = id -{-# NOINLINE pickWithRules #-} -{-# RULES "pickWithRules/rule" [0] forall x. pickWithRules x = const x #-} +-- Regression test for #1169 (see FromJSONKey DownText) +assertDecodedMapIsValid :: Assertion +assertDecodedMapIsValid = fmap Map.valid decodedMap @?= Just True + where + decodedMap = decode "{\"a\":\"a\",\"b\":\"b\"}" :: Maybe (Map DownText Text) diff --git a/tests/golden/simple.expected b/tests/golden/simple.expected --- a/tests/golden/simple.expected +++ b/tests/golden/simple.expected @@ -20,3 +20,5 @@ Error in $[1].Left[1]: expected Bool, but encountered Number Seq Error in $[2]: parsing Int failed, expected Number, but encountered Boolean +listParser +Error in $[0]: parsing Int failed, expected Number, but encountered Boolean