Weight.hs (4877B)
1 {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns -fno-warn-type-defaults #-} 2 {-# LANGUAGE BangPatterns #-} 3 {-# LANGUAGE OverloadedStrings #-} 4 5 module Main where 6 7 import Control.DeepSeq 8 import Data.Word.Wider (Wider) 9 import qualified Data.Word.Wider as W 10 import qualified Numeric.Montgomery.Secp256k1.Curve as C 11 import qualified Numeric.Montgomery.Secp256k1.Scalar as S 12 import Prelude hiding (sqrt, exp) 13 import Weigh 14 15 -- note that 'weigh' doesn't work properly in a repl 16 main :: IO () 17 main = mainWith $ do 18 num_wider 19 cmp 20 add 21 sub 22 mul 23 sqr 24 inv 25 exp 26 sqrt 27 redc 28 retr 29 30 num_wider :: Weigh () 31 num_wider = wgroup "num_wider" $ do 32 func "small" (force :: Wider -> Wider) 2 33 func "large" (force :: Wider -> Wider) 34 0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed 35 36 cmp :: Weigh () 37 cmp = 38 let !a = 1 39 !b = 2 40 !c = 2 ^ 255 - 19 41 in wgroup "cmp_vartime" $ do 42 func "cmp_vartime: 1 < 2" (W.cmp_vartime a) b 43 func "cmp_vartime: 2 < 1" (W.cmp_vartime b) a 44 func "cmp_vartime: 2 < 2 ^ 255 - 19" (W.cmp_vartime b) c 45 func "cmp_vartime: 2 ^ 255 - 19 < 2" (W.cmp_vartime c) b 46 47 add :: Weigh () 48 add = 49 let !c1 = 1 :: C.Montgomery 50 !c2 = 2 :: C.Montgomery 51 !c_big = (2 ^ 255 - 19) :: C.Montgomery 52 !s1 = 1 :: S.Montgomery 53 !s2 = 2 :: S.Montgomery 54 !s_big = (2 ^ 255 - 19) :: S.Montgomery 55 in wgroup "add" $ do 56 func "curve: M(1) + M(2)" (C.add c1) c2 57 func "curve: M(1) + M(2 ^ 255 - 19)" (C.add c1) c_big 58 func "scalar: M(1) + M(2)" (S.add s1) s2 59 func "scalar: M(1) + M(2 ^ 255 - 19)" (S.add s1) s_big 60 61 sub :: Weigh () 62 sub = 63 let !c_max = (2 ^ 255 - 1) :: C.Montgomery 64 !c1 = 1 :: C.Montgomery 65 !c_big = (2 ^ 255 - 19) :: C.Montgomery 66 !s_max = (2 ^ 255 - 1) :: S.Montgomery 67 !s1 = 1 :: S.Montgomery 68 !s_big = (2 ^ 255 - 19) :: S.Montgomery 69 in wgroup "sub" $ do 70 func "curve: M(2 ^ 255 - 1) - M(1)" (C.sub c_max) c1 71 func "curve: M(2 ^ 255 - 1) - M(2 ^ 255 - 19)" (C.sub c_max) c_big 72 func "scalar: M(2 ^ 255 - 1) - M(1)" (S.sub s_max) s1 73 func "scalar: M(2 ^ 255 - 1) - M(2 ^ 255 - 19)" (S.sub s_max) s_big 74 75 mul :: Weigh () 76 mul = 77 let !c2 = 2 :: C.Montgomery 78 !c_big = (2 ^ 255 - 19) :: C.Montgomery 79 !s2 = 2 :: S.Montgomery 80 !s_big = (2 ^ 255 - 19) :: S.Montgomery 81 in wgroup "mul" $ do 82 func "curve: M(2) * M(2)" (C.mul c2) c2 83 func "curve: M(2) * M(2 ^ 255 - 19)" (C.mul c2) c_big 84 func "scalar: M(2) * M(2)" (S.mul s2) s2 85 func "scalar: M(2) * M(2 ^ 255 - 19)" (S.mul s2) s_big 86 87 sqr :: Weigh () 88 sqr = 89 let !c2 = 2 :: C.Montgomery 90 !c_big = (2 ^ 255 - 19) :: C.Montgomery 91 !s2 = 2 :: S.Montgomery 92 !s_big = (2 ^ 255 - 19) :: S.Montgomery 93 in wgroup "sqr" $ do 94 func "curve: M(2) ^ 2" C.sqr c2 95 func "curve: M(2 ^ 255 - 19) ^ 2" C.sqr c_big 96 func "scalar: M(2) ^ 2" S.sqr s2 97 func "scalar: M(2 ^ 255 - 19) ^ 2" S.sqr s_big 98 99 inv :: Weigh () 100 inv = 101 let !c2 = 2 :: C.Montgomery 102 !c_big = (2 ^ 255 - 19) :: C.Montgomery 103 !s2 = 2 :: S.Montgomery 104 !s_big = (2 ^ 255 - 19) :: S.Montgomery 105 in wgroup "inv" $ do 106 func "curve: M(2) ^ -1" C.inv c2 107 func "curve: M(2 ^ 255 - 19) ^ -1" C.inv c_big 108 func "scalar: M(2) ^ -1" S.inv s2 109 func "scalar: M(2 ^ 255 - 19) ^ -1" S.inv s_big 110 111 exp :: Weigh () 112 exp = 113 let !c2 = 2 :: C.Montgomery 114 !s2 = 2 :: S.Montgomery 115 !sma = 2 :: Wider 116 !big = (2 ^ 255 - 19) :: Wider 117 in wgroup "exp" $ do 118 func "curve: M(2) ^ 2" (C.exp c2) sma 119 func "curve: M(2) ^ (2 ^ 255 - 19)" (C.exp c2) big 120 func "scalar: M(2) ^ 2" (S.exp s2) sma 121 func "scalar: M(2) ^ (2 ^ 255 - 19)" (S.exp s2) big 122 123 sqrt :: Weigh () 124 sqrt = 125 let !c2 = 2 :: C.Montgomery 126 !c_big = (2 ^ 255 - 19) :: C.Montgomery 127 in wgroup "sqrt" $ do 128 func "curve: sqrt M(2)" C.sqrt_vartime c2 129 func "curve: sqrt M(2 ^ 255 - 19)" C.sqrt_vartime c_big 130 131 redc :: Weigh () 132 redc = 133 let !c2 = 2 :: C.Montgomery 134 !c_big = (2 ^ 255 - 19) :: C.Montgomery 135 !s2 = 2 :: S.Montgomery 136 !s_big = (2 ^ 255 - 19) :: S.Montgomery 137 in wgroup "redc" $ do 138 func "curve: REDC(M(2), M(2))" (C.redc c2) c2 139 func "curve: REDC(M(2), M(2 ^ 255 - 19))" (C.redc c2) c_big 140 func "scalar: REDC(M(2), M(2))" (S.redc s2) s2 141 func "scalar: REDC(M(2), M(2 ^ 255 - 19))" (S.redc s2) s_big 142 143 retr :: Weigh () 144 retr = 145 let !c2 = 2 :: C.Montgomery 146 !c_big = (2 ^ 255 - 19) :: C.Montgomery 147 !s2 = 2 :: S.Montgomery 148 !s_big = (2 ^ 255 - 19) :: S.Montgomery 149 in wgroup "retr" $ do 150 func "curve: RETR(M(2))" C.retr c2 151 func "curve: RETR(M(2 ^ 255 - 19))" C.retr c_big 152 func "scalar: RETR(M(2))" S.retr s2 153 func "scalar: RETR(M(2 ^ 255 - 19))" S.retr s_big