@@ -167,16 +167,8 @@ instance ToJSON Double where
167167 toJSON = realFloatToJSON
168168 {-# INLINE toJSON #-}
169169
170−realFloatToJSON :: RealFloat a => a -> Value
171−realFloatToJSON d
172− | isNaN d || isInfinite d = Null
173− | otherwise = Number $ Scientific.fromFloatDigits d
174−{-# INLINE realFloatToJSON #-}
175−
176170instance FromJSON Double where
177− parseJSON (Number s) = pure $ realToFrac s
178− parseJSON Null = pure (0/0)
179− parseJSON v = typeMismatch "Double" v
171+ parseJSON = parseFractional "Double"
180172 {-# INLINE parseJSON #-}
181173
182174instance ToJSON Number where
@@ -195,9 +187,7 @@ instance ToJSON Float where
195187 {-# INLINE toJSON #-}
196188
197189instance FromJSON Float where
198− parseJSON (Number s) = pure $ realToFrac s
199− parseJSON Null = pure (0/0)
200− parseJSON v = typeMismatch "Float" v
190+ parseJSON = parseFractional "Float"
201191 {-# INLINE parseJSON #-}
202192
203193instance ToJSON (Ratio Integer) where
@@ -225,19 +215,19 @@ instance ToJSON Int where
225215 {-# INLINE toJSON #-}
226216
227217instance FromJSON Int where
228− parseJSON = parseIntegral
218+ parseJSON = parseIntegral "Int"
229219 {-# INLINE parseJSON #-}
230220
231−parseIntegral :: Integral a => Value -> Parser a
232−parseIntegral = withScientific "Integral" $ pure . floor
233−{-# INLINE parseIntegral #-}
234−
235221instance ToJSON Integer where
236222 toJSON = Number . fromInteger
237223 {-# INLINE toJSON #-}
238224
225+-- | /WARNING:/ Only parse Integers from trusted input since an
226+-- attacker could easily fill up the memory of the target system by
227+-- specifying a scientific number with a big exponent like
228+-- @1e1000000000@.
239229instance FromJSON Integer where
240− parseJSON = parseIntegral
230+ parseJSON = withScientific "Integral" $ pure . floor
241231 {-# INLINE parseJSON #-}
242232
243233instance ToJSON Int8 where
@@ -245,7 +235,7 @@ instance ToJSON Int8 where
245235 {-# INLINE toJSON #-}
246236
247237instance FromJSON Int8 where
248− parseJSON = parseIntegral
238+ parseJSON = parseIntegral "Int8"
249239 {-# INLINE parseJSON #-}
250240
251241instance ToJSON Int16 where
@@ -253,7 +243,7 @@ instance ToJSON Int16 where
253243 {-# INLINE toJSON #-}
254244
255245instance FromJSON Int16 where
256− parseJSON = parseIntegral
246+ parseJSON = parseIntegral "Int16"
257247 {-# INLINE parseJSON #-}
258248
259249instance ToJSON Int32 where
@@ -261,7 +251,7 @@ instance ToJSON Int32 where
261251 {-# INLINE toJSON #-}
262252
263253instance FromJSON Int32 where
264− parseJSON = parseIntegral
254+ parseJSON = parseIntegral "Int32"
265255 {-# INLINE parseJSON #-}
266256
267257instance ToJSON Int64 where
@@ -269,7 +259,7 @@ instance ToJSON Int64 where
269259 {-# INLINE toJSON #-}
270260
271261instance FromJSON Int64 where
272− parseJSON = parseIntegral
262+ parseJSON = parseIntegral "Int64"
273263 {-# INLINE parseJSON #-}
274264
275265instance ToJSON Word where
@@ -277,7 +267,7 @@ instance ToJSON Word where
277267 {-# INLINE toJSON #-}
278268
279269instance FromJSON Word where
280− parseJSON = parseIntegral
270+ parseJSON = parseIntegral "Word"
281271 {-# INLINE parseJSON #-}
282272
283273instance ToJSON Word8 where
@@ -285,7 +275,7 @@ instance ToJSON Word8 where
285275 {-# INLINE toJSON #-}
286276
287277instance FromJSON Word8 where
288− parseJSON = parseIntegral
278+ parseJSON = parseIntegral "Word8"
289279 {-# INLINE parseJSON #-}
290280
291281instance ToJSON Word16 where
@@ -293,7 +283,7 @@ instance ToJSON Word16 where
293283 {-# INLINE toJSON #-}
294284
295285instance FromJSON Word16 where
296− parseJSON = parseIntegral
286+ parseJSON = parseIntegral "Word16"
297287 {-# INLINE parseJSON #-}
298288
299289instance ToJSON Word32 where
@@ -301,7 +291,7 @@ instance ToJSON Word32 where
301291 {-# INLINE toJSON #-}
302292
303293instance FromJSON Word32 where
304− parseJSON = parseIntegral
294+ parseJSON = parseIntegral "Word32"
305295 {-# INLINE parseJSON #-}
306296
307297instance ToJSON Word64 where
@@ -309,7 +299,7 @@ instance ToJSON Word64 where
309299 {-# INLINE toJSON #-}
310300
311301instance FromJSON Word64 where
312− parseJSON = parseIntegral
302+ parseJSON = parseIntegral "Word64"
313303 {-# INLINE parseJSON #-}
314304
315305instance ToJSON Text where
@@ -788,6 +778,12 @@ typeMismatch expected actual =
788778 Bool _ -> "Boolean"
789779 Null -> "Null"
790780
781+realFloatToJSON :: RealFloat a => a -> Value
782+realFloatToJSON d
783+ | isNaN d || isInfinite d = Null
784+ | otherwise = Number $ Scientific.fromFloatDigits d
785+{-# INLINE realFloatToJSON #-}
786+
791787scientificToNumber :: Scientific -> Number
792788scientificToNumber s
793789 | e < 0 = D $ realToFrac s
@@ -796,3 +792,96 @@ scientificToNumber s
796792 e = Scientific.base10Exponent s
797793 c = Scientific.coefficient s
798794{-# INLINE scientificToNumber #-}
795+
796+parseFractional :: Fractional a => String -> Value -> Parser a
797+parseFractional _ (Number s) = pure $ scientificToFractional s
798+parseFractional _ Null = pure (0/0)
799+parseFractional expected v = typeMismatch expected v
800+{-# INLINE parseFractional #-}
801+
802+-- | Convert an /untrusted/ scientific value to a fractional.
803+scientificToFractional :: Fractional a => Scientific -> a
804+scientificToFractional s = realToFrac s
805+ -- TODO: Using realToFrac is unsafe here. Do something similar as
806+ -- scientificToIntegral. The following might work but I'm not sure
807+ -- this doesn't introduce rounding errors:
808+ --
809+ -- fromInteger c * 10 ^ e
810+ -- where
811+ -- e = Scientific.base10Exponent s
812+ -- c = Scientific.coefficient s
813+
814+parseIntegral :: Integral a => String -> Value -> Parser a
815+parseIntegral expected = withScientific expected $ pure . scientificToIntegral
816+{-# INLINE parseIntegral #-}
817+
818+-- | Safely convert an /untrusted/ scientific value to an integral.
819+--
820+-- This function is safe in the sense that the amount of space used is
821+-- bounded by the size of the target type.
822+scientificToIntegral :: Integral a => Scientific -> a
823+scientificToIntegral s
824+ -- When the exponent is positive (we're dealing with an integer)
825+ -- we convert the coefficient to the desired integral type and
826+ -- multiply it by the magnitude (10^e). Note that the magnitude is
827+ -- also represented in the target type which means that the space
828+ -- usage is bounded by the size of that type (8/16/32/64
829+ -- bits). Computing the magnitude could take a long time but it's
830+ -- easy to protect against that by using a timeout.
831+ | e >= 0 = fromInteger c * 10 ^ e
832+
833+ -- When the exponent is negative we divide the Integer coefficient
834+ -- by the magnitude (10^(-e)) and convert the resulting Integer to
835+ -- the target integral type.
836+ --
837+ -- Do note that the magnitude (which is an Integer) will consume
838+ -- lots of space if the exponent is a big negative number. If left
839+ -- unguarded this allows an attacker to supply a scientific number
840+ -- with a big negative exponent like 1e-1000000000 and crash the
841+ -- target system by filling up all memory.
842+ --
843+ -- We guard against this by only computing the magnitude when the
844+ -- exponent is between -limit and 0 (in which case the magnitude
845+ -- doesn't consume much space). If the exponent is smaller than
846+ -- -limit we return 0 but only when it's smaller than
847+ -- -nrOfCoefficientDigits (the number of decimal digits in the
848+ -- coefficient).
849+ --
850+ -- Note that this still allows an attacker to trigger the unsafe
851+ -- magnitude computation. However, he can only trigger it by
852+ -- supplying a coefficient consisting of more decimal digits than
853+ -- 10^(-e). It's easy to protect against this by limiting the
854+ -- amount of bytes read from an untrusted source.
855+ --
856+ -- Also note that nrOfCoefficientDigits is only computed when the
857+ -- exponent is smaller than -limit.
858+ | e < (-limit) && e < (-nrOfCoefficientDigits) = 0
859+
860+ | otherwise = fromInteger (c `div` (10^(-e)))
861+ where
862+ e = Scientific.base10Exponent s
863+ c = Scientific.coefficient s
864+
865+ limit = 20
866+
867+ -- The number of decimal digits of the coefficient.
868+ nrOfCoefficientDigits = integerLogBase 10 (abs c)
869+
870+-- | Calculate the integer logarithm for an arbitrary base.
871+-- The base must be greater than 1, the second argument, the number
872+-- whose logarithm is sought, should be positive, otherwise the
873+-- result is meaningless.
874+--
875+-- > base ^ integerLogBase base m <= m < base ^ (integerLogBase base m + 1)
876+--
877+-- for @base > 1@ and @m > 0@.
878+--
879+-- TODO: Use integerLogBase# from integer-gmp which is probably more efficient!
880+integerLogBase :: Integer -> Integer -> Int
881+integerLogBase b m = case step b of (_, e) -> e
882+ where
883+ step pw | m < pw = (m, 0)
884+ | q < pw = (q, 2 * e)
885+ | otherwise = (q `quot` pw, 2 * e + 1)
886+ where
887+ (q, e) = step (pw * pw)