fixed

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

Scalar.hs (6065B)

      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 instance Q.Arbitrary W.Wider where
    122   arbitrary = fmap W.to_vartime Q.arbitrary
    123 
    124 instance Q.Arbitrary S.Montgomery where
    125   arbitrary = fmap S.to Q.arbitrary
    126 
    127 add_matches :: W.Wider -> W.Wider -> Bool
    128 add_matches a b =
    129   let ma = S.to a
    130       mb = S.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         (S.from (ma + mb))
    137 
    138 mul_matches :: W.Wider -> W.Wider -> Bool
    139 mul_matches a b =
    140   let ma = S.to a
    141       mb = S.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         (S.from (ma * mb))
    148 
    149 sqr_matches :: W.Wider -> Bool
    150 sqr_matches a =
    151   let ma = S.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         (S.from (S.sqr ma))
    157 
    158 exp_matches :: S.Montgomery -> W.Wider -> Bool
    159 exp_matches a b =
    160   let ia = W.from_vartime (S.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         (S.from (S.exp a b))
    166 
    167 inv_valid :: Q.NonZero S.Montgomery -> Bool
    168 inv_valid (Q.NonZero s) = S.eq_vartime (S.inv s * s) 1
    169 
    170 tests :: TestTree
    171 tests = testGroup "montgomery tests (scalar)" [
    172     H.testCase "representation" repr
    173   , H.testCase "add" add
    174   , H.testCase "sub" sub
    175   , H.testCase "mul" mul
    176   , Q.testProperty "a + b mod m ~ ma + mb" $ Q.withMaxSuccess 500 add_matches
    177   , Q.testProperty "a * b mod m ~ ma * mb" $ Q.withMaxSuccess 500 mul_matches
    178   , Q.testProperty "a ^ 2 mod m ~ ma ^ 2"  $ Q.withMaxSuccess 500 sqr_matches
    179   , Q.testProperty "a ^ b mod m ~ ma ^ mb" $ Q.withMaxSuccess 500 exp_matches
    180   , Q.testProperty "n ^ -1 mod m * n ~ 1"  $ Q.withMaxSuccess 500 inv_valid
    181   ]
    182