@@ -167,16 +167,8 @@ instance ToJSON Double where
167 toJSON = realFloatToJSON
167 toJSON = realFloatToJSON
168 {-# INLINE toJSON #-}
168 {-# INLINE toJSON #-}
170−realFloatToJSON :: RealFloat a => a -> Value
172− | isNaN d || isInfinite d = Null
173− | otherwise = Number $ Scientific.fromFloatDigits d
174−{-# INLINE realFloatToJSON #-}
176instance FromJSON Double where
170instance FromJSON Double where
177− parseJSON (Number s) = pure $ realToFrac s
171+ parseJSON = parseFractional "Double"
178− parseJSON Null = pure (0/0)
179− parseJSON v = typeMismatch "Double" v
180 {-# INLINE parseJSON #-}
172 {-# INLINE parseJSON #-}
182instance ToJSON Number where
174instance ToJSON Number where
@@ -195,9 +187,7 @@ instance ToJSON Float where
195 {-# INLINE toJSON #-}
187 {-# INLINE toJSON #-}
197instance FromJSON Float where
189instance FromJSON Float where
198− parseJSON (Number s) = pure $ realToFrac s
190+ parseJSON = parseFractional "Float"
199− parseJSON Null = pure (0/0)
200− parseJSON v = typeMismatch "Float" v
201 {-# INLINE parseJSON #-}
191 {-# INLINE parseJSON #-}
203instance ToJSON (Ratio Integer) where
193instance ToJSON (Ratio Integer) where
@@ -225,19 +215,19 @@ instance ToJSON Int where
225 {-# INLINE toJSON #-}
215 {-# INLINE toJSON #-}
227instance FromJSON Int where
217instance FromJSON Int where
228− parseJSON = parseIntegral
218+ parseJSON = parseIntegral "Int"
229 {-# INLINE parseJSON #-}
219 {-# INLINE parseJSON #-}
231−parseIntegral :: Integral a => Value -> Parser a
232−parseIntegral = withScientific "Integral" $ pure . floor
233−{-# INLINE parseIntegral #-}
235instance ToJSON Integer where
221instance ToJSON Integer where
236 toJSON = Number . fromInteger
222 toJSON = Number . fromInteger
237 {-# INLINE toJSON #-}
223 {-# INLINE toJSON #-}
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
239instance FromJSON Integer where
229instance FromJSON Integer where
240− parseJSON = parseIntegral
230+ parseJSON = withScientific "Integral" $ pure . floor
241 {-# INLINE parseJSON #-}
231 {-# INLINE parseJSON #-}
243instance ToJSON Int8 where
233instance ToJSON Int8 where
@@ -245,7 +235,7 @@ instance ToJSON Int8 where
245 {-# INLINE toJSON #-}
235 {-# INLINE toJSON #-}
247instance FromJSON Int8 where
237instance FromJSON Int8 where
248− parseJSON = parseIntegral
238+ parseJSON = parseIntegral "Int8"
249 {-# INLINE parseJSON #-}
239 {-# INLINE parseJSON #-}
251instance ToJSON Int16 where
241instance ToJSON Int16 where
@@ -253,7 +243,7 @@ instance ToJSON Int16 where
253 {-# INLINE toJSON #-}
243 {-# INLINE toJSON #-}
255instance FromJSON Int16 where
245instance FromJSON Int16 where
256− parseJSON = parseIntegral
246+ parseJSON = parseIntegral "Int16"
257 {-# INLINE parseJSON #-}
247 {-# INLINE parseJSON #-}
259instance ToJSON Int32 where
249instance ToJSON Int32 where
@@ -261,7 +251,7 @@ instance ToJSON Int32 where
261 {-# INLINE toJSON #-}
251 {-# INLINE toJSON #-}
263instance FromJSON Int32 where
253instance FromJSON Int32 where
264− parseJSON = parseIntegral
254+ parseJSON = parseIntegral "Int32"
265 {-# INLINE parseJSON #-}
255 {-# INLINE parseJSON #-}
267instance ToJSON Int64 where
257instance ToJSON Int64 where
@@ -269,7 +259,7 @@ instance ToJSON Int64 where
269 {-# INLINE toJSON #-}
259 {-# INLINE toJSON #-}
271instance FromJSON Int64 where
261instance FromJSON Int64 where
272− parseJSON = parseIntegral
262+ parseJSON = parseIntegral "Int64"
273 {-# INLINE parseJSON #-}
263 {-# INLINE parseJSON #-}
275instance ToJSON Word where
265instance ToJSON Word where
@@ -277,7 +267,7 @@ instance ToJSON Word where
277 {-# INLINE toJSON #-}
267 {-# INLINE toJSON #-}
279instance FromJSON Word where
269instance FromJSON Word where
280− parseJSON = parseIntegral
270+ parseJSON = parseIntegral "Word"
281 {-# INLINE parseJSON #-}
271 {-# INLINE parseJSON #-}
283instance ToJSON Word8 where
273instance ToJSON Word8 where
@@ -285,7 +275,7 @@ instance ToJSON Word8 where
285 {-# INLINE toJSON #-}
275 {-# INLINE toJSON #-}
287instance FromJSON Word8 where
277instance FromJSON Word8 where
288− parseJSON = parseIntegral
278+ parseJSON = parseIntegral "Word8"
289 {-# INLINE parseJSON #-}
279 {-# INLINE parseJSON #-}
291instance ToJSON Word16 where
281instance ToJSON Word16 where
@@ -293,7 +283,7 @@ instance ToJSON Word16 where
293 {-# INLINE toJSON #-}
283 {-# INLINE toJSON #-}
295instance FromJSON Word16 where
285instance FromJSON Word16 where
296− parseJSON = parseIntegral
286+ parseJSON = parseIntegral "Word16"
297 {-# INLINE parseJSON #-}
287 {-# INLINE parseJSON #-}
299instance ToJSON Word32 where
289instance ToJSON Word32 where
@@ -301,7 +291,7 @@ instance ToJSON Word32 where
301 {-# INLINE toJSON #-}
291 {-# INLINE toJSON #-}
303instance FromJSON Word32 where
293instance FromJSON Word32 where
304− parseJSON = parseIntegral
294+ parseJSON = parseIntegral "Word32"
305 {-# INLINE parseJSON #-}
295 {-# INLINE parseJSON #-}
307instance ToJSON Word64 where
297instance ToJSON Word64 where
@@ -309,7 +299,7 @@ instance ToJSON Word64 where
309 {-# INLINE toJSON #-}
299 {-# INLINE toJSON #-}
311instance FromJSON Word64 where
301instance FromJSON Word64 where
312− parseJSON = parseIntegral
302+ parseJSON = parseIntegral "Word64"
313 {-# INLINE parseJSON #-}
303 {-# INLINE parseJSON #-}
315instance ToJSON Text where
305instance ToJSON Text where
@@ -788,6 +778,12 @@ typeMismatch expected actual =
788 Bool _ -> "Boolean"
778 Bool _ -> "Boolean"
789 Null -> "Null"
779 Null -> "Null"
781+realFloatToJSON :: RealFloat a => a -> Value
783+ | isNaN d || isInfinite d = Null
784+ | otherwise = Number $ Scientific.fromFloatDigits d
785+{-# INLINE realFloatToJSON #-}
791scientificToNumber :: Scientific -> Number
787scientificToNumber :: Scientific -> Number
792scientificToNumber s
788scientificToNumber s
793 | e < 0 = D $ realToFrac s
789 | e < 0 = D $ realToFrac s
@@ -796,3 +792,96 @@ scientificToNumber s
796 e = Scientific.base10Exponent s
792 e = Scientific.base10Exponent s
797 c = Scientific.coefficient s
793 c = Scientific.coefficient s
798{-# INLINE scientificToNumber #-}
794{-# INLINE scientificToNumber #-}
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 #-}
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:
809+ -- fromInteger c * 10 ^ e
811+ -- e = Scientific.base10Exponent s
812+ -- c = Scientific.coefficient s
814+parseIntegral :: Integral a => String -> Value -> Parser a
815+parseIntegral expected = withScientific expected $ pure . scientificToIntegral
816+{-# INLINE parseIntegral #-}
818+-- | Safely convert an /untrusted/ scientific value to an integral.
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
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.
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.
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
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.
856+ -- Also note that nrOfCoefficientDigits is only computed when the
857+ -- exponent is smaller than -limit.
858+ | e < (-limit) && e < (-nrOfCoefficientDigits) = 0
860+ | otherwise = fromInteger (c `div` (10^(-e)))
862+ e = Scientific.base10Exponent s
863+ c = Scientific.coefficient s
867+ -- The number of decimal digits of the coefficient.
868+ nrOfCoefficientDigits = integerLogBase 10 (abs c)
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.
875+-- > base ^ integerLogBase base m <= m < base ^ (integerLogBase base m + 1)
877+-- for @base > 1@ and @m > 0@.
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
883+ step pw | m < pw = (m, 0)
884+ | q < pw = (q, 2 * e)
885+ | otherwise = (q `quot` pw, 2 * e + 1)
887+ (q, e) = step (pw * pw)