Commits

basvandijk  committed 3c834a2

Use floor on Scientifics again

scientific-0.3 provides a DoS safe floor.

  • Participants
  • Parent commits 5d2b193

Comments (0)

Files changed (1)

File Data/Aeson/Types/Instances.hs

     toJSON = realFloatToJSON
     {-# INLINE toJSON #-}
 
-realFloatToJSON :: RealFloat a => a -> Value
-realFloatToJSON d
-    | isNaN d || isInfinite d = Null
-    | otherwise = Number $ Scientific.fromFloatDigits d
-{-# INLINE realFloatToJSON #-}
-
 instance FromJSON Double where
-    parseJSON (Number s) = pure $ realToFrac s
-    parseJSON Null       = pure (0/0)
-    parseJSON v          = typeMismatch "Double" v
+    parseJSON = parseFractional "Double"
     {-# INLINE parseJSON #-}
 
 instance ToJSON Number where
     {-# INLINE toJSON #-}
 
 instance FromJSON Float where
-    parseJSON (Number s) = pure $ realToFrac s
-    parseJSON Null       = pure (0/0)
-    parseJSON v          = typeMismatch "Float" v
+    parseJSON = parseFractional "Float"
     {-# INLINE parseJSON #-}
 
 instance ToJSON (Ratio Integer) where
     {-# INLINE toJSON #-}
 
 instance FromJSON Int where
-    parseJSON = parseIntegral
+    parseJSON = parseIntegral "Int"
     {-# INLINE parseJSON #-}
 
-parseIntegral :: Integral a => Value -> Parser a
-parseIntegral = withScientific "Integral" $ pure . floor
-{-# INLINE parseIntegral #-}
-
 instance ToJSON Integer where
     toJSON = Number . fromInteger
     {-# INLINE toJSON #-}
 
+-- | /WARNING:/ Only parse Integers from trusted input since an
+-- attacker could easily fill up the memory of the target system by
+-- specifying a scientific number with a big exponent like
+-- @1e1000000000@.
 instance FromJSON Integer where
-    parseJSON = parseIntegral
+    parseJSON = withScientific "Integral" $ pure . floor
     {-# INLINE parseJSON #-}
 
 instance ToJSON Int8 where
     {-# INLINE toJSON #-}
 
 instance FromJSON Int8 where
-    parseJSON = parseIntegral
+    parseJSON = parseIntegral "Int8"
     {-# INLINE parseJSON #-}
 
 instance ToJSON Int16 where
     {-# INLINE toJSON #-}
 
 instance FromJSON Int16 where
-    parseJSON = parseIntegral
+    parseJSON = parseIntegral "Int16"
     {-# INLINE parseJSON #-}
 
 instance ToJSON Int32 where
     {-# INLINE toJSON #-}
 
 instance FromJSON Int32 where
-    parseJSON = parseIntegral
+    parseJSON = parseIntegral "Int32"
     {-# INLINE parseJSON #-}
 
 instance ToJSON Int64 where
     {-# INLINE toJSON #-}
 
 instance FromJSON Int64 where
-    parseJSON = parseIntegral
+    parseJSON = parseIntegral "Int64"
     {-# INLINE parseJSON #-}
 
 instance ToJSON Word where
     {-# INLINE toJSON #-}
 
 instance FromJSON Word where
-    parseJSON = parseIntegral
+    parseJSON = parseIntegral "Word"
     {-# INLINE parseJSON #-}
 
 instance ToJSON Word8 where
     {-# INLINE toJSON #-}
 
 instance FromJSON Word8 where
-    parseJSON = parseIntegral
+    parseJSON = parseIntegral "Word8"
     {-# INLINE parseJSON #-}
 
 instance ToJSON Word16 where
     {-# INLINE toJSON #-}
 
 instance FromJSON Word16 where
-    parseJSON = parseIntegral
+    parseJSON = parseIntegral "Word16"
     {-# INLINE parseJSON #-}
 
 instance ToJSON Word32 where
     {-# INLINE toJSON #-}
 
 instance FromJSON Word32 where
-    parseJSON = parseIntegral
+    parseJSON = parseIntegral "Word32"
     {-# INLINE parseJSON #-}
 
 instance ToJSON Word64 where
     {-# INLINE toJSON #-}
 
 instance FromJSON Word64 where
-    parseJSON = parseIntegral
+    parseJSON = parseIntegral "Word64"
     {-# INLINE parseJSON #-}
 
 instance ToJSON Text where
              Bool _   -> "Boolean"
              Null     -> "Null"
 
+realFloatToJSON :: RealFloat a => a -> Value
+realFloatToJSON d
+    | isNaN d || isInfinite d = Null
+    | otherwise = Number $ Scientific.fromFloatDigits d
+{-# INLINE realFloatToJSON #-}
+
 scientificToNumber :: Scientific -> Number
 scientificToNumber s
     | e < 0     = D $ realToFrac s
     e = Scientific.base10Exponent s
     c = Scientific.coefficient s
 {-# INLINE scientificToNumber #-}
+
+parseFractional :: Fractional a => String -> Value -> Parser a
+parseFractional _        (Number s) = pure $ scientificToFractional s
+parseFractional _        Null       = pure (0/0)
+parseFractional expected v          = typeMismatch expected v
+{-# INLINE parseFractional #-}
+
+-- | Convert an /untrusted/ scientific value to a fractional.
+scientificToFractional :: Fractional a => Scientific -> a
+scientificToFractional s = realToFrac s
+  -- TODO: Using realToFrac is unsafe here. Do something similar as
+  -- scientificToIntegral. The following might work but I'm not sure
+  -- this doesn't introduce rounding errors:
+  --
+  --   fromInteger c * 10 ^ e
+  -- where
+  --   e = Scientific.base10Exponent s
+  --   c = Scientific.coefficient s
+
+parseIntegral :: Integral a => String -> Value -> Parser a
+parseIntegral expected = withScientific expected $ pure . floor
+{-# INLINE parseIntegral #-}