Curve.hs (6545B)
1 {-# OPTIONS_GHC -fno-warn-orphans #-} 2 {-# LANGUAGE ApplicativeDo #-} 3 {-# LANGUAGE BangPatterns #-} 4 {-# LANGUAGE MagicHash #-} 5 {-# LANGUAGE NumericUnderscores #-} 6 {-# LANGUAGE UnboxedSums #-} 7 {-# LANGUAGE UnboxedTuples #-} 8 {-# LANGUAGE ViewPatterns #-} 9 10 module Montgomery.Curve ( 11 tests 12 ) where 13 14 import qualified Data.Choice as CT 15 import qualified Data.Word.Wider as W 16 import qualified GHC.Num.Integer as I 17 import GHC.Natural 18 import qualified Numeric.Montgomery.Secp256k1.Curve as C 19 import Test.Tasty 20 import qualified Test.Tasty.HUnit as H 21 import qualified Test.Tasty.QuickCheck as Q 22 23 -- orphan Eq instance for testing 24 instance Eq C.Montgomery where 25 a == b = CT.decide (C.eq a b) 26 27 -- generic modular exponentiation 28 -- b ^ e mod m 29 modexp :: Integer -> Natural -> Natural -> Integer 30 modexp b (fromIntegral -> e) p = case I.integerPowMod# b e p of 31 (# fromIntegral -> n | #) -> n 32 (# | _ #) -> error "bang" 33 {-# INLINE modexp #-} 34 35 -- modulus 36 m :: W.Wider 37 m = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2F 38 39 -- modulus 40 mm :: C.Montgomery 41 mm = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2F 42 43 repr :: H.Assertion 44 repr = H.assertBool mempty (W.eq_vartime 0 (C.from mm)) 45 46 add_case :: String -> W.Wider -> W.Wider -> W.Wider -> H.Assertion 47 add_case t a b s = do 48 H.assertEqual "sanity" 49 ((W.from_vartime a + W.from_vartime b) `mod` W.from_vartime m) 50 (W.from_vartime s) 51 H.assertBool t 52 (W.eq_vartime s (C.from (C.to a + C.to b))) 53 54 add :: H.Assertion 55 add = do 56 add_case "small" 1 2 3 57 add_case "wrap to 0 mod m" 58 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2E 1 0 59 add_case "wrap to 1" 60 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2D 3 1 61 add_case "random" 62 0x000123456789ABCDEF0123456789ABCDEF0123456789ABCDEF0123456789ABCD 63 0x0FEDCBA9876543210FEDCBA9876543210FEDCBA9876543210FEDCBA987654321 64 0x0FEEEEEEEEEEEEEEFEEEEEEEEEEEEEEEFEEEEEEEEEEEEEEEFEEEEEEEEEEEEEEE 65 add_case "near R" 66 0xAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 67 0x5555555555555555555555555555555555555555555555555555555555555555 68 0x00000000000000000000000000000000000000000000000000000001000003D0 69 70 sub_case :: String -> W.Wider -> W.Wider -> W.Wider -> H.Assertion 71 sub_case t b a d = do 72 H.assertEqual "sanity" 73 ((W.from_vartime b - W.from_vartime a) `mod` W.from_vartime m) 74 (W.from_vartime d) 75 H.assertBool t 76 (W.eq_vartime d (C.from (C.to b - C.to a))) 77 78 sub :: H.Assertion 79 sub = do 80 sub_case "small" 3 2 1 81 sub_case "wrap from 0 mod m" 0 1 82 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2E 83 sub_case "wrap to 0" 1 1 0 84 sub_case "random" 85 0x0FEDCBA9876543210FEDCBA9876543210FEDCBA9876543210FEDCBA987654321 86 0x000123456789ABCDEF0123456789ABCDEF0123456789ABCDEF0123456789ABCD 87 0x0FECA8641FDB975320ECA8641FDB975320ECA8641FDB975320ECA8641FDB9754 88 sub_case "near R" 89 0x00000000000000000000000000000000000000000000000000000001000003D0 90 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2E 91 0x00000000000000000000000000000000000000000000000000000001000003D1 92 93 mul_case :: String -> W.Wider -> W.Wider -> W.Wider -> H.Assertion 94 mul_case t a b p = do 95 H.assertEqual "sanity" 96 ((W.from_vartime a * W.from_vartime b) `mod` W.from_vartime m) 97 (W.from_vartime p) 98 H.assertBool t 99 (W.eq_vartime p (C.from (C.to a * C.to b))) 100 101 mul :: H.Assertion 102 mul = do 103 mul_case "small" 2 3 6 104 mul_case "wrap to 1 mod m" 105 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2E 106 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2E 107 0x1 108 mul_case "zero" 109 0x000123456789ABCDEF0123456789ABCDEF0123456789ABCDEF0123456789ABCD 110 0x0 111 0x0 112 mul_case "random" 113 0x000123456789ABCDEF0123456789ABCDEF0123456789ABCDEF0123456789ABCD 114 0x0FEDCBA9876543210FEDCBA9876543210FEDCBA9876543210FEDCBA987654321 115 0xCEF9C520FC3502A4BA6F1CE3B2550511D5E474A66875077EF159DE87E15148FC 116 mul_case "near R" 117 0x00000000000000000000000000000000000000000000000000000001000003D1 118 0x00000000000000000000000000000000000000000000000000000001000003D1 119 0x000000000000000000000000000000000000000000000001000007A2000E90A1 120 121 signum_correct :: H.Assertion 122 signum_correct = do 123 H.assertBool "signum 0 = 0" (C.eq_vartime (signum 0) 0) 124 H.assertBool "signum 5 = 1" (C.eq_vartime (signum 5) 1) 125 H.assertBool "abs 5 * signum 5 = 5" 126 (C.eq_vartime (abs 5 * signum 5) 5) 127 128 instance Q.Arbitrary W.Wider where 129 arbitrary = fmap W.to_vartime Q.arbitrary 130 131 instance Q.Arbitrary C.Montgomery where 132 arbitrary = fmap C.to Q.arbitrary 133 134 add_matches :: W.Wider -> W.Wider -> Bool 135 add_matches a b = 136 let ma = C.to a 137 mb = C.to b 138 ia = W.from_vartime a 139 ib = W.from_vartime b 140 im = W.from_vartime m 141 in W.eq_vartime 142 (W.to_vartime ((ia + ib) `mod` im)) 143 (C.from (ma + mb)) 144 145 mul_matches :: W.Wider -> W.Wider -> Bool 146 mul_matches a b = 147 let ma = C.to a 148 mb = C.to b 149 ia = W.from_vartime a 150 ib = W.from_vartime b 151 im = W.from_vartime m 152 in W.eq_vartime 153 (W.to_vartime ((ia * ib) `mod` im)) 154 (C.from (ma * mb)) 155 156 sqr_matches :: W.Wider -> Bool 157 sqr_matches a = 158 let ma = C.to a 159 ia = W.from_vartime a 160 im = W.from_vartime m 161 in W.eq_vartime 162 (W.to_vartime ((ia * ia) `mod` im)) 163 (C.from (C.sqr ma)) 164 165 exp_matches :: C.Montgomery -> W.Wider -> Bool 166 exp_matches a b = 167 let ia = W.from_vartime (C.from a) 168 nb = fromIntegral (W.from_vartime b) 169 nm = fromIntegral (W.from_vartime m) 170 in W.eq_vartime 171 (W.to_vartime (modexp ia nb nm)) 172 (C.from (C.exp a b)) 173 174 inv_valid :: Q.NonZero C.Montgomery -> Bool 175 inv_valid (Q.NonZero s) = C.eq_vartime (C.inv s * s) 1 176 177 odd_correct :: C.Montgomery -> Bool 178 odd_correct w = 179 C.odd_vartime w == I.integerTestBit (W.from_vartime (C.from w)) 0 180 181 tests :: TestTree 182 tests = testGroup "montgomery tests (curve)" [ 183 H.testCase "representation" repr 184 , H.testCase "add" add 185 , H.testCase "sub" sub 186 , H.testCase "mul" mul 187 , H.testCase "signum" signum_correct 188 , Q.testProperty "a + b mod m ~ ma + mb" $ Q.withMaxSuccess 500 add_matches 189 , Q.testProperty "a * b mod m ~ ma * mb" $ Q.withMaxSuccess 500 mul_matches 190 , Q.testProperty "a ^ 2 mod m ~ ma ^ 2" $ Q.withMaxSuccess 500 sqr_matches 191 , Q.testProperty "a ^ b mod m ~ ma ^ mb" $ Q.withMaxSuccess 500 exp_matches 192 , Q.testProperty "n ^ -1 mod m * n ~ 1" $ Q.withMaxSuccess 500 inv_valid 193 , Q.testProperty "odd m ~ odd (from m)" $ Q.withMaxSuccess 500 odd_correct 194 ] 195