fixed

Pure Haskell large fixed-width integers and Montgomery arithmetic.
git clone git://git.ppad.tech/fixed.git
Log | Files | Refs | README | LICENSE

Curve.hs (6261B)

      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 instance Q.Arbitrary W.Wider where
    122   arbitrary = fmap W.to_vartime Q.arbitrary
    123 
    124 instance Q.Arbitrary C.Montgomery where
    125   arbitrary = fmap C.to Q.arbitrary
    126 
    127 add_matches :: W.Wider -> W.Wider -> Bool
    128 add_matches a b =
    129   let ma = C.to a
    130       mb = C.to b
    131       ia = W.from_vartime a
    132       ib = W.from_vartime b
    133       im = W.from_vartime m
    134   in  W.eq_vartime
    135         (W.to_vartime ((ia + ib) `mod` im))
    136         (C.from (ma + mb))
    137 
    138 mul_matches :: W.Wider -> W.Wider -> Bool
    139 mul_matches a b =
    140   let ma = C.to a
    141       mb = C.to b
    142       ia = W.from_vartime a
    143       ib = W.from_vartime b
    144       im = W.from_vartime m
    145   in  W.eq_vartime
    146         (W.to_vartime ((ia * ib) `mod` im))
    147         (C.from (ma * mb))
    148 
    149 sqr_matches :: W.Wider -> Bool
    150 sqr_matches a =
    151   let ma = C.to a
    152       ia = W.from_vartime a
    153       im = W.from_vartime m
    154   in  W.eq_vartime
    155         (W.to_vartime ((ia * ia) `mod` im))
    156         (C.from (C.sqr ma))
    157 
    158 exp_matches :: C.Montgomery -> W.Wider -> Bool
    159 exp_matches a b =
    160   let ia = W.from_vartime (C.from a)
    161       nb = fromIntegral (W.from_vartime b)
    162       nm = fromIntegral (W.from_vartime m)
    163   in  W.eq_vartime
    164         (W.to_vartime (modexp ia nb nm))
    165         (C.from (C.exp a b))
    166 
    167 inv_valid :: Q.NonZero C.Montgomery -> Bool
    168 inv_valid (Q.NonZero s) = C.eq_vartime (C.inv s * s) 1
    169 
    170 odd_correct :: C.Montgomery -> Bool
    171 odd_correct w =
    172   C.odd_vartime w == I.integerTestBit (W.from_vartime (C.from w)) 0
    173 
    174 tests :: TestTree
    175 tests = testGroup "montgomery tests (curve)" [
    176     H.testCase "representation" repr
    177   , H.testCase "add" add
    178   , H.testCase "sub" sub
    179   , H.testCase "mul" mul
    180   , Q.testProperty "a + b mod m ~ ma + mb" $ Q.withMaxSuccess 500 add_matches
    181   , Q.testProperty "a * b mod m ~ ma * mb" $ Q.withMaxSuccess 500 mul_matches
    182   , Q.testProperty "a ^ 2 mod m ~ ma ^ 2"  $ Q.withMaxSuccess 500 sqr_matches
    183   , Q.testProperty "a ^ b mod m ~ ma ^ mb" $ Q.withMaxSuccess 500 exp_matches
    184   , Q.testProperty "n ^ -1 mod m * n ~ 1"  $ Q.withMaxSuccess 500 inv_valid
    185   , Q.testProperty "odd m ~ odd (from m)"  $ Q.withMaxSuccess 500 odd_correct
    186   ]
    187