@@ -85,7 +85,6 @@ import Data.Aeson.Internal.Functions (mapKey)
8585import Data.Aeson.Parser.Internal (eitherDecodeWith, jsonEOF)
8686import Data.Aeson.Types.Generic
8787import Data.Aeson.Types.Internal
88−import Data.Attoparsec.Number (Number(..))
8988import Data.Bits (unsafeShiftR)
9089import Data.Fixed (Fixed, HasResolution)
9190import Data.Functor.Compose (Compose(..))
@@ -99,7 +98,7 @@ import Data.Maybe (fromMaybe)
9998import Data.Semigroup ((<>))
10099import Data.Proxy (Proxy(..))
101100import Data.Ratio ((%), Ratio)
102−import Data.Scientific (Scientific)
101+import Data.Scientific (Scientific, base10Exponent)
103102import Data.Tagged (Tagged(..))
104103import Data.Text (Text, pack, unpack)
105104import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)
@@ -172,15 +171,6 @@ parseIndexedJSONPair keyParser valParser idx value = p value <?> Index idx
172171parseJSONElemAtIndex :: (Value -> Parser a) -> Int -> V.Vector Value -> Parser a
173172parseJSONElemAtIndex p idx ary = p (V.unsafeIndex ary idx) <?> Index idx
174173
175−scientificToNumber :: Scientific -> Number
176−scientificToNumber s
177− | e < 0 = D $ Scientific.toRealFloat s
178− | otherwise = I $ c * 10 ^ e
179− where
180− e = Scientific.base10Exponent s
181− c = Scientific.coefficient s
182−{-# INLINE scientificToNumber #-}
183−
184174parseRealFloat :: RealFloat a => String -> Value -> Parser a
185175parseRealFloat _ (Number s) = pure $ Scientific.toRealFloat s
186176parseRealFloat _ Null = pure (0/0)
@@ -196,7 +186,7 @@ parseIntegralFromScientific expected s =
196186
197187parseIntegral :: Integral a => String -> Value -> Parser a
198188parseIntegral expected =
199− withScientific expected $ parseIntegralFromScientific expected
189+ withBoundedScientific expected $ parseIntegralFromScientific expected
200190{-# INLINE parseIntegral #-}
201191
202192parseBoundedIntegralFromScientific :: (Bounded a, Integral a) => String -> Scientific -> Parser a
@@ -218,8 +208,13 @@ parseScientificText
218208 . T.encodeUtf8
219209
220210parseIntegralText :: Integral a => String -> Text -> Parser a
221−parseIntegralText expected t =
222− parseScientificText t >>= parseIntegralFromScientific expected
211+parseIntegralText expected t
212+ = parseScientificText t
213+ >>= rejectLargeExponent
214+ >>= parseIntegralFromScientific expected
215+ where
216+ rejectLargeExponent :: Scientific -> Parser Scientific
217+ rejectLargeExponent s = withBoundedScientific expected pure (Number s)
223218{-# INLINE parseIntegralText #-}
224219
225220parseBoundedIntegralText :: (Bounded a, Integral a) => String -> Text -> Parser a
@@ -648,11 +643,30 @@ withArray expected _ v = typeMismatch expected v
648643-- | @'withScientific' expected f value@ applies @f@ to the 'Scientific' number
649644-- when @value@ is a 'Number' and fails using @'typeMismatch' expected@
650645-- otherwise.
646+-- .
647+-- /Warning/: If you are converting from a scientific to an unbounded
648+-- type such as 'Integer' you may want to add a restriction on the
649+-- size of the exponent (see 'withBoundedScientific') to prevent
650+-- malicious input from filling up the memory of the target system.
651651withScientific :: String -> (Scientific -> Parser a) -> Value -> Parser a
652652withScientific _ f (Number scientific) = f scientific
653653withScientific expected _ v = typeMismatch expected v
654654{-# INLINE withScientific #-}
655655
656+-- | @'withBoundedScientific' expected f value@ applies @f@ to the 'Scientific' number
657+-- when @value@ is a 'Number' and fails using @'typeMismatch' expected@
658+-- otherwise.
659+--
660+-- The conversion will also fail wyth a @'typeMismatch' if the
661+-- 'Scientific' exponent is larger than 1024.
662+withBoundedScientific :: String -> (Scientific -> Parser a) -> Value -> Parser a
663+withBoundedScientific _ f v@(Number scientific) =
664+ if base10Exponent scientific > 1024
665+ then typeMismatch "a number with exponent <= 1024" v
666+ else f scientific
667+withBoundedScientific expected _ v = typeMismatch expected v
668+{-# INLINE withBoundedScientific #-}
669+
656670-- | @'withBool' expected f value@ applies @f@ to the 'Bool' when @value@ is a
657671-- 'Bool' and fails using @'typeMismatch' expected@ otherwise.
658672withBool :: String -> (Bool -> Parser a) -> Value -> Parser a
@@ -1232,12 +1246,6 @@ instance FromJSONKey Double where
12321246 "-Infinity" -> pure (negate 1/0)
12331247 _ -> Scientific.toRealFloat <$> parseScientificText t
12341248
1235−instance FromJSON Number where
1236− parseJSON (Number s) = pure $ scientificToNumber s
1237− parseJSON Null = pure (D (0/0))
1238− parseJSON v = typeMismatch "Number" v
1239− {-# INLINE parseJSON #-}
1240−
12411249instance FromJSON Float where
12421250 parseJSON = parseRealFloat "Float"
12431251 {-# INLINE parseJSON #-}
@@ -1258,12 +1266,12 @@ instance (FromJSON a, Integral a) => FromJSON (Ratio a) where
12581266 else pure $ numerator % denominator
12591267 {-# INLINE parseJSON #-}
12601268
1261−-- | /WARNING:/ Only parse fixed-precision numbers from trusted input
1262−-- since an attacker could easily fill up the memory of the target
1263−-- system by specifying a scientific number with a big exponent like
1264−-- @1e1000000000@.
1269+-- | This instance includes a bounds check to prevent maliciously
1270+-- large inputs to fill up the memory of the target system. You can
1271+-- newtype 'Scientific' and provide your own instance using
1272+-- 'withScientific' if you want to allow larger inputs.
12651273instance HasResolution a => FromJSON (Fixed a) where
1266− parseJSON = withScientific "Fixed" $ pure . realToFrac
1274+ parseJSON = withBoundedScientific "Fixed" $ pure . realToFrac
12671275 {-# INLINE parseJSON #-}
12681276
12691277instance FromJSON Int where
@@ -1273,10 +1281,10 @@ instance FromJSON Int where
12731281instance FromJSONKey Int where
12741282 fromJSONKey = FromJSONKeyTextParser $ parseBoundedIntegralText "Int"
12751283
1276−-- | /WARNING:/ Only parse Integers from trusted input since an
1277−-- attacker could easily fill up the memory of the target system by
1278−-- specifying a scientific number with a big exponent like
1279−-- @1e1000000000@.
1284+-- | This instance includes a bounds check to prevent maliciously
1285+-- large inputs to fill up the memory of the target system. You can
1286+-- newtype 'Scientific' and provide your own instance using
1287+-- 'withScientific' if you want to allow larger inputs.
12801288instance FromJSON Integer where
12811289 parseJSON = parseIntegral "Integer"
12821290 {-# INLINE parseJSON #-}
@@ -1715,21 +1723,21 @@ instance FromJSONKey UTCTime where
17151723 fromJSONKey = FromJSONKeyTextParser (Time.run Time.utcTime)
17161724
17171725
1718−-- | /WARNING:/ Only parse lengths of time from trusted input
1719−-- since an attacker could easily fill up the memory of the target
1720−-- system by specifying a scientific number with a big exponent like
1721−-- @1e1000000000@.
1726+-- | This instance includes a bounds check to prevent maliciously
1727+-- large inputs to fill up the memory of the target system. You can
1728+-- newtype 'Scientific' and provide your own instance using
1729+-- 'withScientific' if you want to allow larger inputs.
17221730instance FromJSON NominalDiffTime where
1723− parseJSON = withScientific "NominalDiffTime" $ pure . realToFrac
1731+ parseJSON = withBoundedScientific "NominalDiffTime" $ pure . realToFrac
17241732 {-# INLINE parseJSON #-}
17251733
17261734
1727−-- | /WARNING:/ Only parse lengths of time from trusted input
1728−-- since an attacker could easily fill up the memory of the target
1729−-- system by specifying a scientific number with a big exponent like
1730−-- @1e1000000000@.
1735+-- | This instance includes a bounds check to prevent maliciously
1736+-- large inputs to fill up the memory of the target system. You can
1737+-- newtype 'Scientific' and provide your own instance using
1738+-- 'withScientific' if you want to allow larger inputs.
17311739instance FromJSON DiffTime where
1732− parseJSON = withScientific "DiffTime" $ pure . realToFrac
1740+ parseJSON = withBoundedScientific "DiffTime" $ pure . realToFrac
17331741 {-# INLINE parseJSON #-}
17341742
17351743-------------------------------------------------------------------------------