From c0cbe97b6d237697185174f08f35805beaa3d60c Mon Sep 17 00:00:00 2001 From: Bodigrim Date: Wed, 21 Feb 2024 00:44:28 +0000 Subject: [PATCH 1/2] More tests for Data.Text.Read.{double,rational} --- tests/Tests/Properties/Read.hs | 81 +++++++++++++++++++++++++--------- 1 file changed, 61 insertions(+), 20 deletions(-) diff --git a/tests/Tests/Properties/Read.hs b/tests/Tests/Properties/Read.hs index 5cb8d296..d343ae28 100644 --- a/tests/Tests/Properties/Read.hs +++ b/tests/Tests/Properties/Read.hs @@ -8,7 +8,7 @@ module Tests.Properties.Read import Data.Char (isDigit, isHexDigit) import Numeric (showHex) -import Test.Tasty (TestTree, testGroup) +import Test.Tasty (TestTree, testGroup, localOption, mkTimeout) import Test.Tasty.QuickCheck (testProperty) import Test.QuickCheck import Tests.QuickCheckUtils () @@ -38,23 +38,39 @@ tl_hexadecimal m s ox = isFloaty c = c `elem` ("+-.0123456789eE" :: String) -t_read_rational p tol (n::Double) s = - case p (T.pack (show n) `T.append` t) of - Left err -> counterexample err $ property False - Right (n',t') -> t === t' .&&. property (abs (n-n') <= tol) - where t = T.dropWhile isFloaty s +t_read_rational :: Double -> T.Text -> Property +t_read_rational n s = + case T.rational (T.pack (show n) `T.append` t) of + Left err -> counterexample err $ property False + Right (n', t') -> t === t' .&&. n' === n'' + where + t = T.dropWhile isFloaty s + n'' = read (show n) :: Double -tl_read_rational p tol (n::Double) s = - case p (TL.pack (show n) `TL.append` t) of - Left err -> counterexample err $ property False - Right (n',t') -> t === t' .&&. property (abs (n-n') <= tol) - where t = TL.dropWhile isFloaty s +t_read_double :: Double -> Double -> T.Text -> Property +t_read_double tol n s = + case T.double (T.pack (show n) `T.append` t) of + Left err -> counterexample err $ property False + Right (n', t') -> t === t' .&&. property (abs (n - n') <= tol) + where + t = T.dropWhile isFloaty s -t_double = t_read_rational T.double 1e-13 -tl_double = tl_read_rational TL.double 1e-13 -t_rational = t_read_rational T.rational 1e-16 -tl_rational = tl_read_rational TL.rational 1e-16 +tl_read_rational :: Double -> TL.Text -> Property +tl_read_rational n s = + case TL.rational (TL.pack (show n) `TL.append` t) of + Left err -> counterexample err $ property False + Right (n', t') -> t === t' .&&. n' === n'' + where + t = TL.dropWhile isFloaty s + n'' = read (show n) :: Double +tl_read_double :: Double -> Double -> TL.Text -> Property +tl_read_double tol n s = + case TL.rational (TL.pack (show n) `TL.append` t) of + Left err -> counterexample err $ property False + Right (n', t') -> t === t' .&&. property (abs (n - n') <= tol) + where + t = TL.dropWhile isFloaty s testRead :: TestTree testRead = @@ -63,8 +79,33 @@ testRead = testProperty "tl_decimal" tl_decimal, testProperty "t_hexadecimal" t_hexadecimal, testProperty "tl_hexadecimal" tl_hexadecimal, - testProperty "t_double" t_double, - testProperty "tl_double" tl_double, - testProperty "t_rational" t_rational, - testProperty "tl_rational" tl_rational - ] + + testProperty "t_double" $ t_read_double 1e-13, + testProperty "tl_double" $ tl_read_double 1e-13, + + testProperty "t_rational" t_read_rational, + testProperty "t_rational 1.3e-2" (t_read_rational 1.3e-2), + testProperty "tl_rational" tl_read_rational, + testProperty "tl_rational 9e-3" (tl_read_rational 9e-3), + + localOption (mkTimeout 100000) $ testGroup "DDoS attacks" [ + testProperty "t_double large positive exponent" $ + T.double (T.pack "1.1e1000000000") === Right (1 / 0, mempty), + testProperty "t_double large negative exponent" $ + T.double (T.pack "1.1e-1000000000") === Right (0.0, mempty), + testProperty "tl_double large positive exponent" $ + TL.double (TL.pack "1.1e1000000000") === Right (1 / 0, mempty), + testProperty "tl_double large negative exponent" $ + TL.double (TL.pack "1.1e-1000000000") === Right (0.0, mempty), + + testProperty "t_rational large positive exponent" $ + T.rational (T.pack "1.1e1000000000") === Right (1 / 0 :: Double, mempty), + testProperty "t_rational large negative exponent" $ + T.rational (T.pack "1.1e-1000000000") === Right (0.0 :: Double, mempty), + testProperty "tl_rational large positive exponent" $ + TL.rational (TL.pack "1.1e1000000000") === Right (1 / 0 :: Double, mempty), + testProperty "tl_rational large negative exponent" $ + TL.rational (TL.pack "1.1e-1000000000") === Right (0.0 :: Double, mempty) + ] + + ] From ad9f911f877ea697b423e0c15642db361fa001a1 Mon Sep 17 00:00:00 2001 From: Bodigrim Date: Wed, 21 Feb 2024 00:45:39 +0000 Subject: [PATCH 2/2] Improve precision of Data.Text.Read.rational --- src/Data/Text/Lazy/Read.hs | 24 +++++++++++++++--------- src/Data/Text/Read.hs | 24 +++++++++++++++--------- 2 files changed, 30 insertions(+), 18 deletions(-) diff --git a/src/Data/Text/Lazy/Read.hs b/src/Data/Text/Lazy/Read.hs index efed1026..7889784f 100644 --- a/src/Data/Text/Lazy/Read.hs +++ b/src/Data/Text/Lazy/Read.hs @@ -134,8 +134,16 @@ signed f = runP (signa (P f)) -- >rational "3e" == Right (3.0, "e") rational :: Fractional a => Reader a {-# SPECIALIZE rational :: Reader Double #-} -rational = floaty $ \real frac fracDenom -> fromRational $ - real % 1 + frac % fracDenom +rational = floaty $ \real frac fracDenom power -> + -- We must be careful to prevent DDoS attacks: if the return type is 'Double', + -- a client rightfully expects 'rational' to operate within bounded memory. + -- Thus if power is small, we can compute fraction with full precision and divide. + -- Otherwise divide first, apply fromRational and scale last: + -- the small loss of precision for Double does not matter much because the result is + -- likely infinity or zero anyway. + if abs power < 1000 + then fromRational ((real % 1 + frac % fracDenom) * (10 ^^ power)) + else fromRational (real % 1 + frac % fracDenom) * (10 ^^ power) -- | Read a rational number. -- @@ -150,9 +158,9 @@ rational = floaty $ \real frac fracDenom -> fromRational $ -- around the 15th decimal place. For 0.001% of numbers, this -- function will lose precision at the 13th or 14th decimal place. double :: Reader Double -double = floaty $ \real frac fracDenom -> - fromInteger real + - fromInteger frac / fromInteger fracDenom +double = floaty $ \real frac fracDenom power -> + (fromInteger real + + fromInteger frac / fromInteger fracDenom) * (10 ^^ power) signa :: Num a => Parser a -> Parser a {-# SPECIALIZE signa :: Parser Int -> Parser Int #-} @@ -174,7 +182,7 @@ charAscii p = P $ \case then Right (c, if len <= 1 then ts else Chunk (T.Text arr (off + 1) (len - 1)) ts) else Left "character does not match" -floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a +floaty :: Fractional a => (Integer -> Integer -> Integer -> Int -> a) -> Reader a {-# INLINE floaty #-} floaty f = runP $ do sign <- perhaps (ord8 '+') $ charAscii (\c -> c == ord8 '-' || c == ord8 '+') @@ -190,9 +198,7 @@ floaty f = runP $ do then if power == 0 then fromInteger real else fromInteger real * (10 ^^ power) - else if power == 0 - then f real fraction (10 ^ fracDigits) - else f real fraction (10 ^ fracDigits) * (10 ^^ power) + else f real fraction (10 ^ fracDigits) power return $! if sign == ord8 '+' then n else -n diff --git a/src/Data/Text/Read.hs b/src/Data/Text/Read.hs index 0a37e746..cd747fae 100644 --- a/src/Data/Text/Read.hs +++ b/src/Data/Text/Read.hs @@ -140,8 +140,16 @@ signed f = runP (signa (P f)) -- >rational "3e" == Right (3.0, "e") rational :: Fractional a => Reader a {-# SPECIALIZE rational :: Reader Double #-} -rational = floaty $ \real frac fracDenom -> fromRational $ - real % 1 + frac % fracDenom +rational = floaty $ \real frac fracDenom power -> + -- We must be careful to prevent DDoS attacks: if the return type is 'Double', + -- a client rightfully expects 'rational' to operate within bounded memory. + -- Thus if power is small, we can compute fraction with full precision and divide. + -- Otherwise divide first, apply fromRational and scale last: + -- the small loss of precision for Double does not matter much because the result is + -- likely infinity or zero anyway. + if abs power < 1000 + then fromRational ((real % 1 + frac % fracDenom) * (10 ^^ power)) + else fromRational (real % 1 + frac % fracDenom) * (10 ^^ power) -- | Read a rational number. -- @@ -156,9 +164,9 @@ rational = floaty $ \real frac fracDenom -> fromRational $ -- around the 15th decimal place. For 0.001% of numbers, this -- function will lose precision at the 13th or 14th decimal place. double :: Reader Double -double = floaty $ \real frac fracDenom -> - fromInteger real + - fromInteger frac / fromInteger fracDenom +double = floaty $ \real frac fracDenom power -> + (fromInteger real + + fromInteger frac / fromInteger fracDenom) * (10 ^^ power) signa :: Num a => Parser a -> Parser a {-# SPECIALIZE signa :: Parser Int -> Parser Int #-} @@ -177,7 +185,7 @@ charAscii p = P $ \(Text arr off len) -> let c = A.unsafeIndex arr off in then Right (c, Text arr (off + 1) (len - 1)) else Left "character does not match" -floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a +floaty :: Fractional a => (Integer -> Integer -> Integer -> Int -> a) -> Reader a {-# INLINE floaty #-} floaty f = runP $ do sign <- perhaps (ord8 '+') $ charAscii (\c -> c == ord8 '-' || c == ord8 '+') @@ -193,9 +201,7 @@ floaty f = runP $ do then if power == 0 then fromInteger real else fromInteger real * (10 ^^ power) - else if power == 0 - then f real fraction (10 ^ fracDigits) - else f real fraction (10 ^ fracDigits) * (10 ^^ power) + else f real fraction (10 ^ fracDigits) power return $! if sign == ord8 '+' then n else -n