Scalar.hs (6349B)
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.Scalar ( 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.Scalar as S 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 S.Montgomery where 25 a == b = CT.decide (S.eq a b) 26 27 -- generic modular exponentiation 28 -- b ^ e mod m 29 modexp :: Integer -> Natural -> Natural -> Integer 30 modexp b (fromIntegral -> e) q = case I.integerPowMod# b e q of 31 (# fromIntegral -> n | #) -> n 32 (# | _ #) -> error "bang" 33 {-# INLINE modexp #-} 34 35 -- modulus 36 m :: W.Wider 37 m = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141 38 39 -- modulus 40 mm :: S.Montgomery 41 mm = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141 42 43 repr :: H.Assertion 44 repr = H.assertBool mempty (W.eq_vartime 0 (S.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 (S.from (S.to a + S.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 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364140 1 0 59 add_case "wrap to 1" 60 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD036413F 3 1 61 add_case "random" 62 0x000123456789ABCDEF0123456789ABCDEF0123456789ABCDEF0123456789ABCD 63 0x0FEDCBA9876543210FEDCBA9876543210FEDCBA9876543210FEDCBA987654321 64 0x0FEEEEEEEEEEEEEEFEEEEEEEEEEEEEEEFEEEEEEEEEEEEEEEFEEEEEEEEEEEEEEE 65 add_case "near R" 66 0xAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 67 0x5555555555555555555555555555555555555555555555555555555555555555 68 0x000000000000000000000000000000014551231950B75FC4402DA1732FC9BEBE 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 (S.from (S.to b - S.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 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364140 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 0x000000000000000000000000000000014551231950B75FC4402DA1732FC9BEBE 90 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364140 91 0x000000000000000000000000000000014551231950B75FC4402DA1732FC9BEBF 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 (S.from (S.to a * S.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 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364140 106 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364140 107 0x1 108 mul_case "zero" 109 0x000123456789ABCDEF0123456789ABCDEF0123456789ABCDEF0123456789ABCD 110 0x0 111 0x0 112 mul_case "random" 113 0x000123456789ABCDEF0123456789ABCDEF0123456789ABCDEF0123456789ABCD 114 0x0FEDCBA9876543210FEDCBA9876543210FEDCBA9876543210FEDCBA987654321 115 0x1A9B526FE2B5CE72CE59A8E81612BC5785CED8C6B231B643B36DA80BE2A60636 116 mul_case "near R" 117 0x000000000000000000000000000000014551231950B75FC4402DA1732FC9BEBF 118 0x000000000000000000000000000000014551231950B75FC4402DA1732FC9BEBF 119 0x9D671CD581C69BC5E697F5E45BCD07C6741496C20E7CF878896CF21467D7D140 120 121 signum_correct :: H.Assertion 122 signum_correct = do 123 H.assertBool "signum 0 = 0" (S.eq_vartime (signum 0) 0) 124 H.assertBool "signum 5 = 1" (S.eq_vartime (signum 5) 1) 125 H.assertBool "abs 5 * signum 5 = 5" 126 (S.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 S.Montgomery where 132 arbitrary = fmap S.to Q.arbitrary 133 134 add_matches :: W.Wider -> W.Wider -> Bool 135 add_matches a b = 136 let ma = S.to a 137 mb = S.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 (S.from (ma + mb)) 144 145 mul_matches :: W.Wider -> W.Wider -> Bool 146 mul_matches a b = 147 let ma = S.to a 148 mb = S.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 (S.from (ma * mb)) 155 156 sqr_matches :: W.Wider -> Bool 157 sqr_matches a = 158 let ma = S.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 (S.from (S.sqr ma)) 164 165 exp_matches :: S.Montgomery -> W.Wider -> Bool 166 exp_matches a b = 167 let ia = W.from_vartime (S.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 (S.from (S.exp a b)) 173 174 inv_valid :: Q.NonZero S.Montgomery -> Bool 175 inv_valid (Q.NonZero s) = S.eq_vartime (S.inv s * s) 1 176 177 tests :: TestTree 178 tests = testGroup "montgomery tests (scalar)" [ 179 H.testCase "representation" repr 180 , H.testCase "add" add 181 , H.testCase "sub" sub 182 , H.testCase "mul" mul 183 , H.testCase "signum" signum_correct 184 , Q.testProperty "a + b mod m ~ ma + mb" $ Q.withMaxSuccess 500 add_matches 185 , Q.testProperty "a * b mod m ~ ma * mb" $ Q.withMaxSuccess 500 mul_matches 186 , Q.testProperty "a ^ 2 mod m ~ ma ^ 2" $ Q.withMaxSuccess 500 sqr_matches 187 , Q.testProperty "a ^ b mod m ~ ma ^ mb" $ Q.withMaxSuccess 500 exp_matches 188 , Q.testProperty "n ^ -1 mod m * n ~ 1" $ Q.withMaxSuccess 500 inv_valid 189 ] 190