@@ -52,7 +52,6 @@ module Data.Aeson.Types.FromJSON
5252 , withObject
5353 , withText
5454 , withArray
55− , withNumber
5655 , withScientific
5756 , withBool
5857 , withEmbeddedJSON
@@ -86,7 +85,6 @@ import Data.Aeson.Internal.Functions (mapKey)
8685import Data.Aeson.Parser.Internal (eitherDecodeWith, jsonEOF)
8786import Data.Aeson.Types.Generic
8887import Data.Aeson.Types.Internal
89−import Data.Attoparsec.Number (Number(..))
9088import Data.Bits (unsafeShiftR)
9189import Data.Fixed (Fixed, HasResolution)
9290import Data.Functor.Compose (Compose(..))
@@ -100,7 +98,7 @@ import Data.Maybe (fromMaybe)
10098import Data.Semigroup ((<>))
10199import Data.Proxy (Proxy(..))
102100import Data.Ratio ((%), Ratio)
103−import Data.Scientific (Scientific)
101+import Data.Scientific (Scientific, base10Exponent)
104102import Data.Tagged (Tagged(..))
105103import Data.Text (Text, pack, unpack)
106104import Data.Time (Day, DiffTime, LocalTime, NominalDiffTime, TimeOfDay, UTCTime, ZonedTime)
@@ -173,15 +171,6 @@ parseIndexedJSONPair keyParser valParser idx value = p value <?> Index idx
173171parseJSONElemAtIndex :: (Value -> Parser a) -> Int -> V.Vector Value -> Parser a
174172parseJSONElemAtIndex p idx ary = p (V.unsafeIndex ary idx) <?> Index idx
175173
176−scientificToNumber :: Scientific -> Number
177−scientificToNumber s
178− | e < 0 = D $ Scientific.toRealFloat s
179− | otherwise = I $ c * 10 ^ e
180− where
181− e = Scientific.base10Exponent s
182− c = Scientific.coefficient s
183−{-# INLINE scientificToNumber #-}
184−
185174parseRealFloat :: RealFloat a => String -> Value -> Parser a
186175parseRealFloat _ (Number s) = pure $ Scientific.toRealFloat s
187176parseRealFloat _ Null = pure (0/0)
@@ -197,7 +186,7 @@ parseIntegralFromScientific expected s =
197186
198187parseIntegral :: Integral a => String -> Value -> Parser a
199188parseIntegral expected =
200− withScientific expected $ parseIntegralFromScientific expected
189+ withBoundedScientific expected $ parseIntegralFromScientific expected
201190{-# INLINE parseIntegral #-}
202191
203192parseBoundedIntegralFromScientific :: (Bounded a, Integral a) => String -> Scientific -> Parser a
@@ -219,8 +208,13 @@ parseScientificText
219208 . T.encodeUtf8
220209
221210parseIntegralText :: Integral a => String -> Text -> Parser a
222−parseIntegralText expected t =
223− 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)
224218{-# INLINE parseIntegralText #-}
225219
226220parseBoundedIntegralText :: (Bounded a, Integral a) => String -> Text -> Parser a
@@ -646,21 +640,33 @@ withArray _ f (Array arr) = f arr
646640withArray expected _ v = typeMismatch expected v
647641{-# INLINE withArray #-}
648642
649−-- | @'withNumber' expected f value@ applies @f@ to the 'Number' when @value@
650−-- is a 'Number' and fails using @'typeMismatch' expected@ otherwise.
651−withNumber :: String -> (Number -> Parser a) -> Value -> Parser a
652−withNumber expected f = withScientific expected (f . scientificToNumber)
653−{-# INLINE withNumber #-}
654−{-# DEPRECATED withNumber "Use withScientific instead" #-}
655−
656643-- | @'withScientific' expected f value@ applies @f@ to the 'Scientific' number
657644-- when @value@ is a 'Number' and fails using @'typeMismatch' expected@
658645-- 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.
659651withScientific :: String -> (Scientific -> Parser a) -> Value -> Parser a
660652withScientific _ f (Number scientific) = f scientific
661653withScientific expected _ v = typeMismatch expected v
662654{-# INLINE withScientific #-}
663655
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+
664670-- | @'withBool' expected f value@ applies @f@ to the 'Bool' when @value@ is a
665671-- 'Bool' and fails using @'typeMismatch' expected@ otherwise.
666672withBool :: String -> (Bool -> Parser a) -> Value -> Parser a
@@ -1240,12 +1246,6 @@ instance FromJSONKey Double where
12401246 "-Infinity" -> pure (negate 1/0)
12411247 _ -> Scientific.toRealFloat <$> parseScientificText t
12421248
1243−instance FromJSON Number where
1244− parseJSON (Number s) = pure $ scientificToNumber s
1245− parseJSON Null = pure (D (0/0))
1246− parseJSON v = typeMismatch "Number" v
1247− {-# INLINE parseJSON #-}
1248−
12491249instance FromJSON Float where
12501250 parseJSON = parseRealFloat "Float"
12511251 {-# INLINE parseJSON #-}
@@ -1266,12 +1266,12 @@ instance (FromJSON a, Integral a) => FromJSON (Ratio a) where
12661266 else pure $ numerator % denominator
12671267 {-# INLINE parseJSON #-}
12681268
1269−-- | /WARNING:/ Only parse fixed-precision numbers from trusted input
1270−-- since an attacker could easily fill up the memory of the target
1271−-- system by specifying a scientific number with a big exponent like
1272−-- @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.
12731273instance HasResolution a => FromJSON (Fixed a) where
1274− parseJSON = withScientific "Fixed" $ pure . realToFrac
1274+ parseJSON = withBoundedScientific "Fixed" $ pure . realToFrac
12751275 {-# INLINE parseJSON #-}
12761276
12771277instance FromJSON Int where
@@ -1281,10 +1281,10 @@ instance FromJSON Int where
12811281instance FromJSONKey Int where
12821282 fromJSONKey = FromJSONKeyTextParser $ parseBoundedIntegralText "Int"
12831283
1284−-- | /WARNING:/ Only parse Integers from trusted input since an
1285−-- attacker could easily fill up the memory of the target system by
1286−-- specifying a scientific number with a big exponent like
1287−-- @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.
12881288instance FromJSON Integer where
12891289 parseJSON = parseIntegral "Integer"
12901290 {-# INLINE parseJSON #-}
@@ -1723,21 +1723,21 @@ instance FromJSONKey UTCTime where
17231723 fromJSONKey = FromJSONKeyTextParser (Time.run Time.utcTime)
17241724
17251725
1726−-- | /WARNING:/ Only parse lengths of time from trusted input
1727−-- since an attacker could easily fill up the memory of the target
1728−-- system by specifying a scientific number with a big exponent like
1729−-- @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.
17301730instance FromJSON NominalDiffTime where
1731− parseJSON = withScientific "NominalDiffTime" $ pure . realToFrac
1731+ parseJSON = withBoundedScientific "NominalDiffTime" $ pure . realToFrac
17321732 {-# INLINE parseJSON #-}
17331733
17341734
1735−-- | /WARNING:/ Only parse lengths of time from trusted input
1736−-- since an attacker could easily fill up the memory of the target
1737−-- system by specifying a scientific number with a big exponent like
1738−-- @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.
17391739instance FromJSON DiffTime where
1740− parseJSON = withScientific "DiffTime" $ pure . realToFrac
1740+ parseJSON = withBoundedScientific "DiffTime" $ pure . realToFrac
17411741 {-# INLINE parseJSON #-}
17421742
17431743-------------------------------------------------------------------------------