From 399fc891daf2bdaff1ecac7ac1dcf8bb08d101d9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= <olivier.cheron@gmail.com>
Date: Sun, 24 Mar 2019 08:05:49 +0100
Subject: [PATCH] Test P256 primitives will full scalar range

---
 tests/KAT_PubKey/P256.hs | 33 ++++++++++++++++++++++-----------
 1 file changed, 22 insertions(+), 11 deletions(-)

diff --git a/tests/KAT_PubKey/P256.hs b/tests/KAT_PubKey/P256.hs
index 2d6bb2b..9e43ecd 100644
--- a/tests/KAT_PubKey/P256.hs
+++ b/tests/KAT_PubKey/P256.hs
@@ -17,7 +17,19 @@ newtype P256Scalar = P256Scalar Integer
     deriving (Show,Eq,Ord)
 
 instance Arbitrary P256Scalar where
-    arbitrary = P256Scalar . getQAInteger <$> arbitrary
+    -- Cover the full range up to 2^256-1 except 0 and curveN.  To test edge
+    -- cases with arithmetic functions, some values close to 0, curveN and
+    -- 2^256 are given higher frequency.
+    arbitrary = P256Scalar <$> oneof
+        [ choose (1, w)
+        , choose (w + 1, curveN - w - 1)
+        , choose (curveN - w, curveN - 1)
+        , choose (curveN + 1, curveN + w)
+        , choose (curveN + w + 1, high - w - 1)
+        , choose (high - w, high - 1)
+        ]
+      where high = 2^(256 :: Int)
+            w    = 100
 
 curve  = ECC.getCurveByName ECC.SEC_p256r1
 curveN = ECC.ecc_n . ECC.common_curve $ curve
@@ -27,9 +39,8 @@ pointP256ToECC :: P256.Point -> ECC.Point
 pointP256ToECC = uncurry ECC.Point . P256.pointToIntegers
 
 unP256Scalar :: P256Scalar -> P256.Scalar
-unP256Scalar (P256Scalar r') =
-    let r = if r' == 0 then 0x2901 else (r' `mod` curveN)
-        rBytes = i2ospScalar r
+unP256Scalar (P256Scalar r) =
+    let rBytes = i2ospScalar r
      in case P256.scalarFromBinary rBytes of
                     CryptoFailed err    -> error ("cannot convert scalar: " ++ show err)
                     CryptoPassed scalar -> scalar
@@ -41,7 +52,7 @@ unP256Scalar (P256Scalar r') =
             Just b  -> b
 
 unP256 :: P256Scalar -> Integer
-unP256 (P256Scalar r') = if r' == 0 then 0x2901 else (r' `mod` curveN)
+unP256 (P256Scalar r) = r
 
 p256ScalarToInteger :: P256.Scalar -> Integer
 p256ScalarToInteger s = os2ip (P256.scalarToBinary s :: Bytes)
@@ -55,9 +66,8 @@ yR = 0x8d585cbb2e1327d75241a8a122d7620dc33b13315aa5c9d46d013011744ac264
 
 tests = testGroup "P256"
     [ testGroup "scalar"
-        [ testProperty "marshalling" $ \(QAInteger r') ->
-            let r = r' `mod` curveN
-                rBytes = i2ospScalar r
+        [ testProperty "marshalling" $ \(QAInteger r) ->
+            let rBytes = i2ospScalar r
              in case P256.scalarFromBinary rBytes of
                     CryptoFailed err    -> error (show err)
                     CryptoPassed scalar -> rBytes `propertyEq` P256.scalarToBinary scalar
@@ -66,12 +76,12 @@ tests = testGroup "P256"
                 r' = P256.scalarAdd (unP256Scalar r1) (unP256Scalar r2)
              in r `propertyEq` p256ScalarToInteger r'
         , testProperty "add0" $ \r ->
-            let v = unP256 r
+            let v = unP256 r `mod` curveN
                 v' = P256.scalarAdd (unP256Scalar r) P256.scalarZero
              in v `propertyEq` p256ScalarToInteger v'
         , testProperty "add-n-1" $ \r ->
             let nm1 = throwCryptoError $ P256.scalarFromInteger (curveN - 1)
-                v   = unP256 r
+                v   = unP256 r `mod` curveN
                 v'  = P256.scalarAdd (unP256Scalar r) nm1
              in (((curveN - 1) + v) `mod` curveN) `propertyEq` p256ScalarToInteger v'
         , testProperty "sub" $ \r1 r2 ->
@@ -133,7 +143,8 @@ tests = testGroup "P256"
             pe2   = ECC.pointMul curve (unP256 r2) curveGen
             pR    = P256.toPoint (P256.scalarAdd (unP256Scalar r1) (unP256Scalar r2))
             peR   = ECC.pointAdd curve pe1 pe2
-         in propertyHold [ eqTest "p256" pR (P256.pointAdd p1 p2)
+         in (unP256 r1 + unP256 r2) `mod` curveN /= 0 ==>
+            propertyHold [ eqTest "p256" pR (P256.pointAdd p1 p2)
                          , eqTest "ecc" peR (pointP256ToECC pR)
                          ]