Main.hs (4732B)
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 Data.Word.Wider (Wider) 8 import qualified Numeric.Montgomery.Secp256k1.Curve as C 9 import qualified Numeric.Montgomery.Secp256k1.Scalar as S 10 import Criterion.Main 11 import Prelude hiding (exp, sqrt) 12 13 main :: IO () 14 main = defaultMain [ 15 add 16 , sub 17 , mul 18 , sqr 19 , inv 20 , exp 21 , sqrt 22 , redc 23 , retr 24 ] 25 26 add :: Benchmark 27 add = 28 let !c1 = 1 :: C.Montgomery 29 !c2 = 2 :: C.Montgomery 30 !c_big = (2 ^ 255 - 19) :: C.Montgomery 31 !s1 = 1 :: S.Montgomery 32 !s2 = 2 :: S.Montgomery 33 !s_big = (2 ^ 255 - 19) :: S.Montgomery 34 in bgroup "add" [ 35 bench "curve: M(1) + M(2)" $ nf (C.add c1) c2 36 , bench "curve: M(1) + M(2 ^ 255 - 19)" $ nf (C.add c1) c_big 37 , bench "scalar: M(1) + M(2)" $ nf (S.add s1) s2 38 , bench "scalar: M(1) + M(2 ^ 255 - 19)" $ nf (S.add s1) s_big 39 ] 40 41 sub :: Benchmark 42 sub = 43 let !c_max = (2 ^ 255 - 1) :: C.Montgomery 44 !c1 = 1 :: C.Montgomery 45 !c_big = (2 ^ 255 - 19) :: C.Montgomery 46 !s_max = (2 ^ 255 - 1) :: S.Montgomery 47 !s1 = 1 :: S.Montgomery 48 !s_big = (2 ^ 255 - 19) :: S.Montgomery 49 in bgroup "sub" [ 50 bench "curve: M(2 ^ 255 - 1) - M(1)" $ nf (C.sub c_max) c1 51 , bench "curve: M(2 ^ 255 - 1) - M(2 ^ 255 - 19)" $ 52 nf (C.sub c_max) c_big 53 , bench "scalar: M(2 ^ 255 - 1) - M(1)" $ nf (S.sub s_max) s1 54 , bench "scalar: M(2 ^ 255 - 1) - M(2 ^ 255 - 19)" $ 55 nf (S.sub s_max) s_big 56 ] 57 58 mul :: Benchmark 59 mul = 60 let !c2 = 2 :: C.Montgomery 61 !c_big = (2 ^ 255 - 19) :: C.Montgomery 62 !s2 = 2 :: S.Montgomery 63 !s_big = (2 ^ 255 - 19) :: S.Montgomery 64 in bgroup "mul" [ 65 bench "curve: M(2) * M(2)" $ nf (C.mul c2) c2 66 , bench "curve: M(2) * M(2 ^ 255 - 19)" $ nf (C.mul c2) c_big 67 , bench "scalar: M(2) * M(2)" $ nf (S.mul s2) s2 68 , bench "scalar: M(2) * M(2 ^ 255 - 19)" $ nf (S.mul s2) s_big 69 ] 70 71 sqr :: Benchmark 72 sqr = 73 let !c2 = 2 :: C.Montgomery 74 !c_big = (2 ^ 255 - 19) :: C.Montgomery 75 !s2 = 2 :: S.Montgomery 76 !s_big = (2 ^ 255 - 19) :: S.Montgomery 77 in bgroup "sqr" [ 78 bench "curve: M(2) ^ 2" $ nf C.sqr c2 79 , bench "curve: M(2 ^ 255 - 19) ^ 2" $ nf C.sqr c_big 80 , bench "scalar: M(2) ^ 2" $ nf S.sqr s2 81 , bench "scalar: M(2 ^ 255 - 19) ^ 2" $ nf S.sqr s_big 82 ] 83 84 inv :: Benchmark 85 inv = 86 let !c2 = 2 :: C.Montgomery 87 !c_big = (2 ^ 255 - 19) :: C.Montgomery 88 !s2 = 2 :: S.Montgomery 89 !s_big = (2 ^ 255 - 19) :: S.Montgomery 90 in bgroup "inv" [ 91 bench "curve: M(2) ^ -1" $ nf C.inv c2 92 , bench "curve: M(2 ^ 255 - 19) ^ -1" $ nf C.inv c_big 93 , bench "scalar: M(2) ^ -1" $ nf S.inv s2 94 , bench "scalar: M(2 ^ 255 - 19) ^ -1" $ nf S.inv s_big 95 ] 96 97 sqrt :: Benchmark 98 sqrt = 99 let !c2 = 2 :: C.Montgomery 100 !c_big = (2 ^ 255 - 19) :: C.Montgomery 101 in bgroup "sqrt" [ 102 bench "curve: sqrt M(2)" $ nf C.sqrt_vartime c2 103 , bench "curve: sqrt M(2 ^ 255 - 19)" $ nf C.sqrt_vartime c_big 104 ] 105 106 exp :: Benchmark 107 exp = 108 let !c2 = 2 :: C.Montgomery 109 !c_big = (2 ^ 255 - 19) :: C.Montgomery 110 !s2 = 2 :: S.Montgomery 111 !s_big = (2 ^ 255 - 19) :: S.Montgomery 112 !e2 = 2 :: Wider 113 !e_big = (2 ^ 255 - 19) :: Wider 114 in bgroup "exp" [ 115 bench "curve: M(2) ^ 2" $ nf (C.exp c2) e2 116 , bench "curve: M(2 ^ 255 - 19) ^ (2 ^ 255 - 19)" $ 117 nf (C.exp c_big) e_big 118 , bench "scalar: M(2) ^ 2" $ nf (S.exp s2) e2 119 , bench "scalar: M(2 ^ 255 - 19) ^ (2 ^ 255 - 19)" $ 120 nf (S.exp s_big) e_big 121 ] 122 123 redc :: Benchmark 124 redc = 125 let !c2 = 2 :: C.Montgomery 126 !c_big = (2 ^ 255 - 19) :: C.Montgomery 127 !s2 = 2 :: S.Montgomery 128 !s_big = (2 ^ 255 - 19) :: S.Montgomery 129 in bgroup "redc" [ 130 bench "curve: REDC(M(2), M(2))" $ nf (C.redc c2) c2 131 , bench "curve: REDC(M(2), M(2 ^ 255 - 19))" $ nf (C.redc c2) c_big 132 , bench "scalar: REDC(M(2), M(2))" $ nf (S.redc s2) s2 133 , bench "scalar: REDC(M(2), M(2 ^ 255 - 19))" $ nf (S.redc s2) s_big 134 ] 135 136 retr :: Benchmark 137 retr = 138 let !c2 = 2 :: C.Montgomery 139 !c_big = (2 ^ 255 - 19) :: C.Montgomery 140 !s2 = 2 :: S.Montgomery 141 !s_big = (2 ^ 255 - 19) :: S.Montgomery 142 in bgroup "retr" [ 143 bench "curve: RETR(M(2))" $ nf C.retr c2 144 , bench "curve: RETR(M(2 ^ 255 - 19))" $ nf C.retr c_big 145 , bench "scalar: RETR(M(2))" $ nf S.retr s2 146 , bench "scalar: RETR(M(2 ^ 255 - 19))" $ nf S.retr s_big 147 ]