Secp256k1.hs (37887B)
1 {-# OPTIONS_HADDOCK prune #-} 2 {-# LANGUAGE BangPatterns #-} 3 {-# LANGUAGE DeriveGeneric #-} 4 {-# LANGUAGE DerivingStrategies #-} 5 {-# LANGUAGE MagicHash #-} 6 {-# LANGUAGE OverloadedStrings #-} 7 {-# LANGUAGE RecordWildCards #-} 8 {-# LANGUAGE UnboxedSums #-} 9 {-# LANGUAGE ViewPatterns #-} 10 11 -- | 12 -- Module: Crypto.Curve.Secp256k1 13 -- Copyright: (c) 2024 Jared Tobin 14 -- License: MIT 15 -- Maintainer: Jared Tobin <jared@ppad.tech> 16 -- 17 -- Pure [BIP0340](https://github.com/bitcoin/bips/blob/master/bip-0340.mediawiki) 18 -- Schnorr signatures and deterministic 19 -- [RFC6979](https://www.rfc-editor.org/rfc/rfc6979) ECDSA (with 20 -- [BIP0146](https://github.com/bitcoin/bips/blob/master/bip-0146.mediawiki)-style 21 -- "low-S" signatures) on the elliptic curve secp256k1. 22 23 module Crypto.Curve.Secp256k1 ( 24 -- * secp256k1 points 25 Pub 26 , derive_pub 27 , derive_pub' 28 29 -- * Parsing 30 , parse_int256 31 , parse_point 32 , parse_sig 33 34 -- * BIP0340 Schnorr signatures 35 , sign_schnorr 36 , verify_schnorr 37 38 -- * RFC6979 ECDSA 39 , ECDSA(..) 40 , SigType(..) 41 , sign_ecdsa 42 , sign_ecdsa_unrestricted 43 , verify_ecdsa 44 , verify_ecdsa_unrestricted 45 46 -- * Fast variants 47 , Context 48 , precompute 49 , sign_schnorr' 50 , verify_schnorr' 51 , sign_ecdsa' 52 , sign_ecdsa_unrestricted' 53 , verify_ecdsa' 54 , verify_ecdsa_unrestricted' 55 56 -- Elliptic curve group operations 57 , neg 58 , add 59 , double 60 , mul 61 , mul_unsafe 62 , mul_wnaf 63 64 -- Coordinate systems and transformations 65 , Affine(..) 66 , Projective(..) 67 , affine 68 , projective 69 , valid 70 71 -- for testing/benchmarking 72 , _sign_ecdsa_no_hash 73 , _sign_ecdsa_no_hash' 74 , _CURVE_P 75 , _CURVE_Q 76 , _CURVE_G 77 , remQ 78 , modQ 79 ) where 80 81 import Control.Monad (when) 82 import Control.Monad.ST 83 import qualified Crypto.DRBG.HMAC as DRBG 84 import qualified Crypto.Hash.SHA256 as SHA256 85 import Data.Bits ((.|.)) 86 import qualified Data.Bits as B 87 import qualified Data.ByteString as BS 88 import qualified Data.ByteString.Unsafe as BU 89 import qualified Data.Primitive.Array as A 90 import Data.STRef 91 import Data.Word (Word8, Word64) 92 import GHC.Generics 93 import GHC.Natural 94 import qualified GHC.Num.Integer as I 95 96 -- note the use of GHC.Num.Integer-qualified functions throughout this 97 -- module; in some cases explicit use of these functions (especially 98 -- I.integerPowMod# and I.integerRecipMod#) yields tremendous speedups 99 -- compared to more general versions 100 101 -- keystroke savers & other utilities ----------------------------------------- 102 103 fi :: (Integral a, Num b) => a -> b 104 fi = fromIntegral 105 {-# INLINE fi #-} 106 107 -- generic modular exponentiation 108 -- b ^ e mod m 109 modexp :: Integer -> Natural -> Natural -> Integer 110 modexp b (fi -> e) m = case I.integerPowMod# b e m of 111 (# fi -> n | #) -> n 112 (# | _ #) -> error "negative power impossible" 113 {-# INLINE modexp #-} 114 115 -- generic modular inverse 116 -- for a, m return x such that ax = 1 mod m 117 modinv :: Integer -> Natural -> Maybe Integer 118 modinv a m = case I.integerRecipMod# a m of 119 (# fi -> n | #) -> Just $! n 120 (# | _ #) -> Nothing 121 {-# INLINE modinv #-} 122 123 -- bytewise xor 124 xor :: BS.ByteString -> BS.ByteString -> BS.ByteString 125 xor = BS.packZipWith B.xor 126 127 -- arbitrary-size big-endian bytestring decoding 128 roll :: BS.ByteString -> Integer 129 roll = BS.foldl' alg 0 where 130 alg !a (fi -> !b) = (a `I.integerShiftL` 8) `I.integerOr` b 131 132 -- /Note:/ there can be substantial differences in execution time 133 -- when this function is called with "extreme" inputs. For example: a 134 -- bytestring consisting entirely of 0x00 bytes will parse more quickly 135 -- than one consisting of entirely 0xFF bytes. For appropriately-random 136 -- inputs, timings should be indistinguishable. 137 -- 138 -- 256-bit big-endian bytestring decoding. the input size is not checked! 139 roll32 :: BS.ByteString -> Integer 140 roll32 bs = go (0 :: Word64) (0 :: Word64) (0 :: Word64) (0 :: Word64) 0 where 141 go !acc0 !acc1 !acc2 !acc3 !j 142 | j == 32 = 143 (fi acc0 `B.unsafeShiftL` 192) 144 .|. (fi acc1 `B.unsafeShiftL` 128) 145 .|. (fi acc2 `B.unsafeShiftL` 64) 146 .|. fi acc3 147 | j < 8 = 148 let b = fi (BU.unsafeIndex bs j) 149 in go ((acc0 `B.unsafeShiftL` 8) .|. b) acc1 acc2 acc3 (j + 1) 150 | j < 16 = 151 let b = fi (BU.unsafeIndex bs j) 152 in go acc0 ((acc1 `B.unsafeShiftL` 8) .|. b) acc2 acc3 (j + 1) 153 | j < 24 = 154 let b = fi (BU.unsafeIndex bs j) 155 in go acc0 acc1 ((acc2 `B.unsafeShiftL` 8) .|. b) acc3 (j + 1) 156 | otherwise = 157 let b = fi (BU.unsafeIndex bs j) 158 in go acc0 acc1 acc2 ((acc3 `B.unsafeShiftL` 8) .|. b) (j + 1) 159 {-# INLINE roll32 #-} 160 161 -- this "looks" inefficient due to the call to reverse, but it's 162 -- actually really fast 163 164 -- big-endian bytestring encoding 165 unroll :: Integer -> BS.ByteString 166 unroll i = case i of 167 0 -> BS.singleton 0 168 _ -> BS.reverse $ BS.unfoldr step i 169 where 170 step 0 = Nothing 171 step m = Just (fi m, m `I.integerShiftR` 8) 172 173 -- big-endian bytestring encoding for 256-bit ints, left-padding with 174 -- zeros if necessary. the size of the integer is not checked. 175 unroll32 :: Integer -> BS.ByteString 176 unroll32 (unroll -> u) 177 | l < 32 = BS.replicate (32 - l) 0 <> u 178 | otherwise = u 179 where 180 l = BS.length u 181 182 -- replacing the following w/a series of functions with the hashed tags 183 -- hard-coded is possible, but there is virtually no performance benefit 184 185 -- (bip0340) tagged hash function 186 hash_tagged :: BS.ByteString -> BS.ByteString -> BS.ByteString 187 hash_tagged tag x = 188 let !h = SHA256.hash tag 189 in SHA256.hash (h <> h <> x) 190 191 -- (bip0340) return point with x coordinate == x and with even y coordinate 192 lift :: Integer -> Maybe Affine 193 lift x 194 | not (fe x) = Nothing 195 | otherwise = 196 let c = remP (modexp x 3 (fi _CURVE_P) + 7) -- modexp always nonnegative 197 e = (_CURVE_P + 1) `I.integerQuot` 4 198 y = modexp c (fi e) (fi _CURVE_P) 199 y_p | B.testBit y 0 = _CURVE_P - y 200 | otherwise = y 201 in if c /= modexp y 2 (fi _CURVE_P) 202 then Nothing 203 else Just $! Affine x y_p 204 205 -- coordinate systems & transformations --------------------------------------- 206 207 -- curve point, affine coordinates 208 data Affine = Affine !Integer !Integer 209 deriving stock (Show, Generic) 210 211 instance Eq Affine where 212 Affine x1 y1 == Affine x2 y2 = 213 modP x1 == modP x2 && modP y1 == modP y2 214 215 -- curve point, projective coordinates 216 data Projective = Projective { 217 px :: !Integer 218 , py :: !Integer 219 , pz :: !Integer 220 } 221 deriving stock (Show, Generic) 222 223 instance Eq Projective where 224 Projective ax ay az == Projective bx by bz = 225 let x1z2 = modP (ax * bz) 226 x2z1 = modP (bx * az) 227 y1z2 = modP (ay * bz) 228 y2z1 = modP (by * az) 229 in x1z2 == x2z1 && y1z2 == y2z1 230 231 -- | A Schnorr and ECDSA-flavoured alias for a secp256k1 point. 232 type Pub = Projective 233 234 -- Convert to affine coordinates. 235 affine :: Projective -> Affine 236 affine p@(Projective x y z) 237 | p == _ZERO = Affine 0 0 238 | z == 1 = Affine x y 239 | otherwise = case modinv z (fi _CURVE_P) of 240 Nothing -> error "ppad-secp256k1 (affine): impossible point" 241 Just iz -> Affine (modP (x * iz)) (modP (y * iz)) 242 243 -- Convert to projective coordinates. 244 projective :: Affine -> Projective 245 projective (Affine x y) 246 | x == 0 && y == 0 = _ZERO 247 | otherwise = Projective x y 1 248 249 -- Point is valid 250 valid :: Projective -> Bool 251 valid p = case affine p of 252 Affine x y 253 | not (fe x) || not (fe y) -> False 254 | modP (y * y) /= weierstrass x -> False 255 | otherwise -> True 256 257 -- curve parameters ----------------------------------------------------------- 258 -- see https://www.secg.org/sec2-v2.pdf for parameter specs 259 260 -- secp256k1 field prime 261 -- 262 -- = 2^256 - 2^32 - 2^9 - 2^8 - 2^7 - 2^6 - 2^4 - 1 263 _CURVE_P :: Integer 264 _CURVE_P = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2F 265 266 -- secp256k1 group order 267 _CURVE_Q :: Integer 268 _CURVE_Q = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141 269 270 -- bitlength of group order 271 -- 272 -- = smallest integer such that _CURVE_Q < 2 ^ _CURVE_Q_BITS 273 _CURVE_Q_BITS :: Int 274 _CURVE_Q_BITS = 256 275 276 -- bytelength of _CURVE_Q 277 -- 278 -- = _CURVE_Q_BITS / 8 279 _CURVE_Q_BYTES :: Int 280 _CURVE_Q_BYTES = 32 281 282 -- secp256k1 short weierstrass form, /a/ coefficient 283 _CURVE_A :: Integer 284 _CURVE_A = 0 285 286 -- secp256k1 weierstrass form, /b/ coefficient 287 _CURVE_B :: Integer 288 _CURVE_B = 7 289 290 -- secp256k1 generator 291 -- 292 -- = parse_point 293 -- "0279BE667EF9DCBBAC55A06295CE870B07029BFCDB2DCE28D959F2815B16F81798" 294 _CURVE_G :: Projective 295 _CURVE_G = Projective x y 1 where 296 x = 0x79be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798 297 y = 0x483ada7726a3c4655da4fbfc0e1108a8fd17b448a68554199c47d08ffb10d4b8 298 299 -- secp256k1 zero point / point at infinity / monoidal identity 300 _ZERO :: Projective 301 _ZERO = Projective 0 1 0 302 303 -- secp256k1 in prime order j-invariant 0 form (i.e. a == 0). 304 weierstrass :: Integer -> Integer 305 weierstrass x = remP (remP (x * x) * x + _CURVE_B) 306 {-# INLINE weierstrass #-} 307 308 -- field, group operations ---------------------------------------------------- 309 310 -- Division modulo secp256k1 field prime. 311 modP :: Integer -> Integer 312 modP a = I.integerMod a _CURVE_P 313 {-# INLINE modP #-} 314 315 -- Division modulo secp256k1 field prime, when argument is nonnegative. 316 -- (more efficient than modP) 317 remP :: Integer -> Integer 318 remP a = I.integerRem a _CURVE_P 319 {-# INLINE remP #-} 320 321 -- Division modulo secp256k1 group order. 322 modQ :: Integer -> Integer 323 modQ a = I.integerMod a _CURVE_Q 324 {-# INLINE modQ #-} 325 326 -- Division modulo secp256k1 group order, when argument is nonnegative. 327 -- (more efficient than modQ) 328 remQ :: Integer -> Integer 329 remQ a = I.integerRem a _CURVE_Q 330 {-# INLINE remQ #-} 331 332 -- Is field element? 333 fe :: Integer -> Bool 334 fe n = 0 < n && n < _CURVE_P 335 {-# INLINE fe #-} 336 337 -- Is group element? 338 ge :: Integer -> Bool 339 ge n = 0 < n && n < _CURVE_Q 340 {-# INLINE ge #-} 341 342 -- Square root (Shanks-Tonelli) modulo secp256k1 field prime. 343 -- 344 -- For a, return x such that a = x x mod _CURVE_P. 345 modsqrtP :: Integer -> Maybe Integer 346 modsqrtP n = runST $ do 347 r <- newSTRef 1 348 num <- newSTRef n 349 e <- newSTRef ((_CURVE_P + 1) `I.integerQuot` 4) 350 351 let loop = do 352 ev <- readSTRef e 353 when (ev > 0) $ do 354 when (I.integerTestBit ev 0) $ do 355 numv <- readSTRef num 356 modifySTRef' r (\rv -> (rv * numv) `I.integerRem` _CURVE_P) 357 modifySTRef' num (\numv -> (numv * numv) `I.integerRem` _CURVE_P) 358 modifySTRef' e (`I.integerShiftR` 1) 359 loop 360 361 loop 362 rv <- readSTRef r 363 pure $ 364 if remP (rv * rv) == n 365 then Just $! rv 366 else Nothing 367 368 -- ec point operations -------------------------------------------------------- 369 370 -- Negate secp256k1 point. 371 neg :: Projective -> Projective 372 neg (Projective x y z) = Projective x (modP (negate y)) z 373 374 -- Elliptic curve addition on secp256k1. 375 add :: Projective -> Projective -> Projective 376 add p q@(Projective _ _ z) 377 | p == q = double p -- algo 9 378 | z == 1 = add_mixed p q -- algo 8 379 | otherwise = add_proj p q -- algo 7 380 381 -- algo 7, "complete addition formulas for prime order elliptic curves," 382 -- renes et al, 2015 383 -- 384 -- https://eprint.iacr.org/2015/1060.pdf 385 add_proj :: Projective -> Projective -> Projective 386 add_proj (Projective x1 y1 z1) (Projective x2 y2 z2) = runST $ do 387 x3 <- newSTRef 0 388 y3 <- newSTRef 0 389 z3 <- newSTRef 0 390 let b3 = remP (_CURVE_B * 3) 391 t0 <- newSTRef (modP (x1 * x2)) -- 1 392 t1 <- newSTRef (modP (y1 * y2)) 393 t2 <- newSTRef (modP (z1 * z2)) 394 t3 <- newSTRef (modP (x1 + y1)) -- 4 395 t4 <- newSTRef (modP (x2 + y2)) 396 readSTRef t4 >>= \r4 -> 397 modifySTRef' t3 (\r3 -> modP (r3 * r4)) 398 readSTRef t0 >>= \r0 -> 399 readSTRef t1 >>= \r1 -> 400 writeSTRef t4 (modP (r0 + r1)) 401 readSTRef t4 >>= \r4 -> 402 modifySTRef' t3 (\r3 -> modP (r3 - r4)) -- 8 403 writeSTRef t4 (modP (y1 + z1)) 404 writeSTRef x3 (modP (y2 + z2)) 405 readSTRef x3 >>= \rx3 -> 406 modifySTRef' t4 (\r4 -> modP (r4 * rx3)) 407 readSTRef t1 >>= \r1 -> 408 readSTRef t2 >>= \r2 -> 409 writeSTRef x3 (modP (r1 + r2)) -- 12 410 readSTRef x3 >>= \rx3 -> 411 modifySTRef' t4 (\r4 -> modP (r4 - rx3)) 412 writeSTRef x3 (modP (x1 + z1)) 413 writeSTRef y3 (modP (x2 + z2)) 414 readSTRef y3 >>= \ry3 -> 415 modifySTRef' x3 (\rx3 -> modP (rx3 * ry3)) -- 16 416 readSTRef t0 >>= \r0 -> 417 readSTRef t2 >>= \r2 -> 418 writeSTRef y3 (modP (r0 + r2)) 419 readSTRef x3 >>= \rx3 -> 420 modifySTRef' y3 (\ry3 -> modP (rx3 - ry3)) 421 readSTRef t0 >>= \r0 -> 422 writeSTRef x3 (modP (r0 + r0)) 423 readSTRef x3 >>= \rx3 -> 424 modifySTRef t0 (\r0 -> modP (rx3 + r0)) -- 20 425 modifySTRef' t2 (\r2 -> modP (b3 * r2)) 426 readSTRef t1 >>= \r1 -> 427 readSTRef t2 >>= \r2 -> 428 writeSTRef z3 (modP (r1 + r2)) 429 readSTRef t2 >>= \r2 -> 430 modifySTRef' t1 (\r1 -> modP (r1 - r2)) 431 modifySTRef' y3 (\ry3 -> modP (b3 * ry3)) -- 24 432 readSTRef t4 >>= \r4 -> 433 readSTRef y3 >>= \ry3 -> 434 writeSTRef x3 (modP (r4 * ry3)) 435 readSTRef t3 >>= \r3 -> 436 readSTRef t1 >>= \r1 -> 437 writeSTRef t2 (modP (r3 * r1)) 438 readSTRef t2 >>= \r2 -> 439 modifySTRef' x3 (\rx3 -> modP (r2 - rx3)) 440 readSTRef t0 >>= \r0 -> 441 modifySTRef' y3 (\ry3 -> modP (ry3 * r0)) -- 28 442 readSTRef z3 >>= \rz3 -> 443 modifySTRef' t1 (\r1 -> modP (r1 * rz3)) 444 readSTRef t1 >>= \r1 -> 445 modifySTRef' y3 (\ry3 -> modP (r1 + ry3)) 446 readSTRef t3 >>= \r3 -> 447 modifySTRef' t0 (\r0 -> modP (r0 * r3)) 448 readSTRef t4 >>= \r4 -> 449 modifySTRef' z3 (\rz3 -> modP (rz3 * r4)) -- 32 450 readSTRef t0 >>= \r0 -> 451 modifySTRef' z3 (\rz3 -> modP (rz3 + r0)) 452 Projective <$> readSTRef x3 <*> readSTRef y3 <*> readSTRef z3 453 454 -- algo 8, renes et al, 2015 455 add_mixed :: Projective -> Projective -> Projective 456 add_mixed (Projective x1 y1 z1) (Projective x2 y2 z2) 457 | z2 /= 1 = error "ppad-secp256k1: internal error" 458 | otherwise = runST $ do 459 x3 <- newSTRef 0 460 y3 <- newSTRef 0 461 z3 <- newSTRef 0 462 let b3 = remP (_CURVE_B * 3) 463 t0 <- newSTRef (modP (x1 * x2)) -- 1 464 t1 <- newSTRef (modP (y1 * y2)) 465 t3 <- newSTRef (modP (x2 + y2)) 466 t4 <- newSTRef (modP (x1 + y1)) -- 4 467 readSTRef t4 >>= \r4 -> 468 modifySTRef' t3 (\r3 -> modP (r3 * r4)) 469 readSTRef t0 >>= \r0 -> 470 readSTRef t1 >>= \r1 -> 471 writeSTRef t4 (modP (r0 + r1)) 472 readSTRef t4 >>= \r4 -> 473 modifySTRef' t3 (\r3 -> modP (r3 - r4)) -- 7 474 writeSTRef t4 (modP (y2 * z1)) 475 modifySTRef' t4 (\r4 -> modP (r4 + y1)) 476 writeSTRef y3 (modP (x2 * z1)) -- 10 477 modifySTRef' y3 (\ry3 -> modP (ry3 + x1)) 478 readSTRef t0 >>= \r0 -> 479 writeSTRef x3 (modP (r0 + r0)) 480 readSTRef x3 >>= \rx3 -> 481 modifySTRef' t0 (\r0 -> modP (rx3 + r0)) -- 13 482 t2 <- newSTRef (modP (b3 * z1)) 483 readSTRef t1 >>= \r1 -> 484 readSTRef t2 >>= \r2 -> 485 writeSTRef z3 (modP (r1 + r2)) 486 readSTRef t2 >>= \r2 -> 487 modifySTRef' t1 (\r1 -> modP (r1 - r2)) -- 16 488 modifySTRef' y3 (\ry3 -> modP (b3 * ry3)) 489 readSTRef t4 >>= \r4 -> 490 readSTRef y3 >>= \ry3 -> 491 writeSTRef x3 (modP (r4 * ry3)) 492 readSTRef t3 >>= \r3 -> 493 readSTRef t1 >>= \r1 -> 494 writeSTRef t2 (modP (r3 * r1)) -- 19 495 readSTRef t2 >>= \r2 -> 496 modifySTRef' x3 (\rx3 -> modP (r2 - rx3)) 497 readSTRef t0 >>= \r0 -> 498 modifySTRef' y3 (\ry3 -> modP (ry3 * r0)) 499 readSTRef z3 >>= \rz3 -> 500 modifySTRef' t1 (\r1 -> modP (r1 * rz3)) -- 22 501 readSTRef t1 >>= \r1 -> 502 modifySTRef' y3 (\ry3 -> modP (r1 + ry3)) 503 readSTRef t3 >>= \r3 -> 504 modifySTRef' t0 (\r0 -> modP (r0 * r3)) 505 readSTRef t4 >>= \r4 -> 506 modifySTRef' z3 (\rz3 -> modP (rz3 * r4)) -- 25 507 readSTRef t0 >>= \r0 -> 508 modifySTRef' z3 (\rz3 -> modP (rz3 + r0)) 509 Projective <$> readSTRef x3 <*> readSTRef y3 <*> readSTRef z3 510 511 -- algo 9, renes et al, 2015 512 double :: Projective -> Projective 513 double (Projective x y z) = runST $ do 514 x3 <- newSTRef 0 515 y3 <- newSTRef 0 516 z3 <- newSTRef 0 517 let b3 = remP (_CURVE_B * 3) 518 t0 <- newSTRef (modP (y * y)) -- 1 519 readSTRef t0 >>= \r0 -> 520 writeSTRef z3 (modP (r0 + r0)) 521 modifySTRef' z3 (\rz3 -> modP (rz3 + rz3)) 522 modifySTRef' z3 (\rz3 -> modP (rz3 + rz3)) -- 4 523 t1 <- newSTRef (modP (y * z)) 524 t2 <- newSTRef (modP (z * z)) 525 modifySTRef t2 (\r2 -> modP (b3 * r2)) -- 7 526 readSTRef z3 >>= \rz3 -> 527 readSTRef t2 >>= \r2 -> 528 writeSTRef x3 (modP (r2 * rz3)) 529 readSTRef t0 >>= \r0 -> 530 readSTRef t2 >>= \r2 -> 531 writeSTRef y3 (modP (r0 + r2)) 532 readSTRef t1 >>= \r1 -> 533 modifySTRef' z3 (\rz3 -> modP (r1 * rz3)) -- 10 534 readSTRef t2 >>= \r2 -> 535 writeSTRef t1 (modP (r2 + r2)) 536 readSTRef t1 >>= \r1 -> 537 modifySTRef' t2 (\r2 -> modP (r1 + r2)) 538 readSTRef t2 >>= \r2 -> 539 modifySTRef' t0 (\r0 -> modP (r0 - r2)) -- 13 540 readSTRef t0 >>= \r0 -> 541 modifySTRef' y3 (\ry3 -> modP (r0 * ry3)) 542 readSTRef x3 >>= \rx3 -> 543 modifySTRef' y3 (\ry3 -> modP (rx3 + ry3)) 544 writeSTRef t1 (modP (x * y)) -- 16 545 readSTRef t0 >>= \r0 -> 546 readSTRef t1 >>= \r1 -> 547 writeSTRef x3 (modP (r0 * r1)) 548 modifySTRef' x3 (\rx3 -> modP (rx3 + rx3)) 549 Projective <$> readSTRef x3 <*> readSTRef y3 <*> readSTRef z3 550 551 -- Timing-safe scalar multiplication of secp256k1 points. 552 mul :: Projective -> Integer -> Projective 553 mul p _SECRET 554 | not (ge _SECRET) = error "ppad-secp256k1 (mul): scalar not in group" 555 | otherwise = loop (0 :: Int) _ZERO _CURVE_G p _SECRET 556 where 557 loop !j !acc !f !d !m 558 | j == _CURVE_Q_BITS = acc 559 | otherwise = 560 let nd = double d 561 nm = I.integerShiftR m 1 562 in if I.integerTestBit m 0 563 then loop (succ j) (add acc d) f nd nm 564 else loop (succ j) acc (add f d) nd nm 565 {-# INLINE mul #-} 566 567 -- Timing-unsafe scalar multiplication of secp256k1 points. 568 -- 569 -- Don't use this function if the scalar could potentially be a secret. 570 mul_unsafe :: Projective -> Integer -> Projective 571 mul_unsafe p n 572 | n == 0 = _ZERO 573 | not (ge n) = 574 error "ppad-secp256k1 (mul_unsafe): scalar not in group" 575 | otherwise = loop _ZERO p n 576 where 577 loop !r !d m 578 | m <= 0 = r 579 | otherwise = 580 let nd = double d 581 nm = I.integerShiftR m 1 582 nr = if I.integerTestBit m 0 then add r d else r 583 in loop nr nd nm 584 585 -- | Precomputed multiples of the secp256k1 base or generator point. 586 data Context = Context { 587 ctxW :: {-# UNPACK #-} !Int 588 , ctxArray :: !(A.Array Projective) 589 } deriving (Eq, Generic) 590 591 instance Show Context where 592 show Context {} = "<secp256k1 context>" 593 594 -- | Create a secp256k1 context by precomputing multiples of the curve's 595 -- generator point. 596 -- 597 -- This should be used once to create a 'Context' to be reused 598 -- repeatedly afterwards. 599 -- 600 -- >>> let !tex = precompute 601 -- >>> sign_ecdsa' tex sec msg 602 -- >>> sign_schnorr' tex sec msg aux 603 precompute :: Context 604 precompute = _precompute 8 605 606 -- dumb strict pair 607 data Pair a b = Pair !a !b 608 609 -- translation of noble-secp256k1's 'precompute' 610 _precompute :: Int -> Context 611 _precompute ctxW = Context {..} where 612 ctxArray = A.arrayFromListN size (loop_w mempty _CURVE_G 0) 613 capJ = (2 :: Int) ^ (ctxW - 1) 614 ws = 256 `quot` ctxW + 1 615 size = ws * capJ 616 617 loop_w !acc !p !w 618 | w == ws = reverse acc 619 | otherwise = 620 let b = p 621 !(Pair nacc nb) = loop_j p (b : acc) b 1 622 np = double nb 623 in loop_w nacc np (succ w) 624 625 loop_j !p !acc !b !j 626 | j == capJ = Pair acc b 627 | otherwise = 628 let nb = add b p 629 in loop_j p (nb : acc) nb (succ j) 630 631 -- Timing-safe wNAF (w-ary non-adjacent form) scalar multiplication of 632 -- secp256k1 points. 633 mul_wnaf :: Context -> Integer -> Projective 634 mul_wnaf Context {..} _SECRET = 635 loop 0 _ZERO _CURVE_G _SECRET 636 where 637 wins = 256 `quot` ctxW + 1 638 wsize = 2 ^ (ctxW - 1) 639 mask = 2 ^ ctxW - 1 640 mnum = 2 ^ ctxW 641 642 loop !w !acc !f !n 643 | w == wins = acc 644 | otherwise = 645 let !off0 = w * fi wsize 646 647 !b0 = n `I.integerAnd` mask 648 !n0 = n `I.integerShiftR` fi ctxW 649 650 !(Pair b1 n1) | b0 > wsize = Pair (b0 - mnum) (n0 + 1) 651 | otherwise = Pair b0 n0 652 653 !c0 = B.testBit w 0 654 !c1 = b1 < 0 655 656 !off1 = off0 + fi (abs b1) - 1 657 658 in if b1 == 0 659 then let !pr = A.indexArray ctxArray off0 660 !pt | c0 = neg pr 661 | otherwise = pr 662 in loop (w + 1) acc (add f pt) n1 663 else let !pr = A.indexArray ctxArray off1 664 !pt | c1 = neg pr 665 | otherwise = pr 666 in loop (w + 1) (add acc pt) f n1 667 {-# INLINE mul_wnaf #-} 668 669 -- | Derive a public key (i.e., a secp256k1 point) from the provided 670 -- secret. 671 -- 672 -- >>> import qualified System.Entropy as E 673 -- >>> sk <- fmap parse_int256 (E.getEntropy 32) 674 -- >>> derive_pub sk 675 -- "<secp256k1 point>" 676 derive_pub :: Integer -> Pub 677 derive_pub _SECRET 678 | not (ge _SECRET) = 679 error "ppad-secp256k1 (derive_pub): invalid secret key" 680 | otherwise = 681 mul _CURVE_G _SECRET 682 {-# NOINLINE derive_pub #-} 683 684 -- | The same as 'derive_pub', except uses a 'Context' to optimise 685 -- internal calculations. 686 -- 687 -- >>> import qualified System.Entropy as E 688 -- >>> sk <- fmap parse_int256 (E.getEntropy 32) 689 -- >>> let !tex = precompute 690 -- >>> derive_pub' tex sk 691 -- "<secp256k1 point>" 692 derive_pub' :: Context -> Integer -> Pub 693 derive_pub' tex _SECRET 694 | not (ge _SECRET) = 695 error "ppad-secp256k1 (derive_pub): invalid secret key" 696 | otherwise = 697 mul_wnaf tex _SECRET 698 {-# NOINLINE derive_pub' #-} 699 700 -- parsing -------------------------------------------------------------------- 701 702 -- | Parse a positive 256-bit 'Integer', /e.g./ a Schnorr or ECDSA 703 -- secret key. 704 -- 705 -- >>> import qualified Data.ByteString as BS 706 -- >>> parse_int256 (BS.replicate 32 0xFF) 707 -- <2^256 - 1> 708 parse_int256 :: BS.ByteString -> Integer 709 parse_int256 bs 710 | BS.length bs /= 32 = 711 error "ppad-secp256k1 (parse_int256): requires exactly 32-byte input" 712 | otherwise = roll32 bs 713 714 -- | Parse compressed secp256k1 point (33 bytes), uncompressed point (65 715 -- bytes), or BIP0340-style point (32 bytes). 716 -- 717 -- >>> parse_point <33-byte compressed point> 718 -- Just <Pub> 719 -- >>> parse_point <65-byte uncompressed point> 720 -- Just <Pub> 721 -- >>> parse_point <32-byte bip0340 public key> 722 -- Just <Pub> 723 -- >>> parse_point <anything else> 724 -- Nothing 725 parse_point :: BS.ByteString -> Maybe Projective 726 parse_point bs 727 | len == 32 = _parse_bip0340 bs 728 | len == 33 = _parse_compressed h t 729 | len == 65 = _parse_uncompressed h t 730 | otherwise = Nothing 731 where 732 len = BS.length bs 733 h = BU.unsafeIndex bs 0 -- lazy 734 t = BS.drop 1 bs 735 736 -- input is guaranteed to be 32B in length 737 _parse_bip0340 :: BS.ByteString -> Maybe Projective 738 _parse_bip0340 = fmap projective . lift . roll32 739 740 -- bytestring input is guaranteed to be 32B in length 741 _parse_compressed :: Word8 -> BS.ByteString -> Maybe Projective 742 _parse_compressed h (roll32 -> x) 743 | h /= 0x02 && h /= 0x03 = Nothing 744 | not (fe x) = Nothing 745 | otherwise = do 746 y <- modsqrtP (weierstrass x) 747 let yodd = I.integerTestBit y 0 748 hodd = B.testBit h 0 749 pure $! 750 if hodd /= yodd 751 then Projective x (modP (negate y)) 1 752 else Projective x y 1 753 754 -- bytestring input is guaranteed to be 64B in length 755 _parse_uncompressed :: Word8 -> BS.ByteString -> Maybe Projective 756 _parse_uncompressed h (BS.splitAt _CURVE_Q_BYTES -> (roll32 -> x, roll32 -> y)) 757 | h /= 0x04 = Nothing 758 | otherwise = 759 let p = Projective x y 1 760 in if valid p 761 then Just $! p 762 else Nothing 763 764 -- | Parse an ECDSA signature encoded in 64-byte "compact" form. 765 -- 766 -- >>> parse_sig <64-byte compact signature> 767 -- "<ecdsa signature>" 768 parse_sig :: BS.ByteString -> Maybe ECDSA 769 parse_sig bs 770 | BS.length bs /= 64 = Nothing 771 | otherwise = pure $ 772 let (roll -> r, roll -> s) = BS.splitAt 32 bs 773 in ECDSA r s 774 775 -- schnorr -------------------------------------------------------------------- 776 -- see https://github.com/bitcoin/bips/blob/master/bip-0340.mediawiki 777 778 -- | Create a 64-byte Schnorr signature for the provided message, using 779 -- the provided secret key. 780 -- 781 -- BIP0340 recommends that 32 bytes of fresh auxiliary entropy be 782 -- generated and added at signing time as additional protection 783 -- against side-channel attacks (namely, to thwart so-called "fault 784 -- injection" attacks). This entropy is /supplemental/ to security, 785 -- and the cryptographic security of the signature scheme itself does 786 -- not rely on it, so it is not strictly required; 32 zero bytes can 787 -- be used in its stead (and can be supplied via 'mempty'). 788 -- 789 -- >>> import qualified System.Entropy as E 790 -- >>> aux <- E.getEntropy 32 791 -- >>> sign_schnorr sec msg aux 792 -- "<64-byte schnorr signature>" 793 sign_schnorr 794 :: Integer -- ^ secret key 795 -> BS.ByteString -- ^ message 796 -> BS.ByteString -- ^ 32 bytes of auxilliary random data 797 -> BS.ByteString -- ^ 64-byte Schnorr signature 798 sign_schnorr = _sign_schnorr (mul _CURVE_G) 799 800 -- | The same as 'sign_schnorr', except uses a 'Context' to optimise 801 -- internal calculations. 802 -- 803 -- You can expect about a 2x performance increase when using this 804 -- function, compared to 'sign_schnorr'. 805 -- 806 -- >>> import qualified System.Entropy as E 807 -- >>> aux <- E.getEntropy 32 808 -- >>> let !tex = precompute 809 -- >>> sign_schnorr' tex sec msg aux 810 -- "<64-byte schnorr signature>" 811 sign_schnorr' 812 :: Context -- ^ secp256k1 context 813 -> Integer -- ^ secret key 814 -> BS.ByteString -- ^ message 815 -> BS.ByteString -- ^ 32 bytes of auxilliary random data 816 -> BS.ByteString -- ^ 64-byte Schnorr signature 817 sign_schnorr' tex = _sign_schnorr (mul_wnaf tex) 818 819 _sign_schnorr 820 :: (Integer -> Projective) -- partially-applied multiplication function 821 -> Integer -- secret key 822 -> BS.ByteString -- message 823 -> BS.ByteString -- 32 bytes of auxilliary random data 824 -> BS.ByteString 825 _sign_schnorr _mul _SECRET m a 826 | not (ge _SECRET) = error "ppad-secp256k1 (sign_schnorr): invalid secret key" 827 | otherwise = 828 let p_proj = _mul _SECRET 829 Affine x_p y_p = affine p_proj 830 d | I.integerTestBit y_p 0 = _CURVE_Q - _SECRET 831 | otherwise = _SECRET 832 833 bytes_d = unroll32 d 834 h_a = hash_tagged "BIP0340/aux" a 835 t = xor bytes_d h_a 836 837 bytes_p = unroll32 x_p 838 rand = hash_tagged "BIP0340/nonce" (t <> bytes_p <> m) 839 840 k' = modQ (roll32 rand) 841 842 in if k' == 0 -- negligible probability 843 then error "ppad-secp256k1 (sign_schnorr): invalid k" 844 else 845 let Affine x_r y_r = affine (_mul k') 846 k | I.integerTestBit y_r 0 = _CURVE_Q - k' 847 | otherwise = k' 848 849 bytes_r = unroll32 x_r 850 e = modQ . roll32 . hash_tagged "BIP0340/challenge" 851 $ bytes_r <> bytes_p <> m 852 853 bytes_ked = unroll32 (modQ (k + e * d)) 854 855 sig = bytes_r <> bytes_ked 856 857 in if verify_schnorr m p_proj sig 858 then sig 859 else error "ppad-secp256k1 (sign_schnorr): invalid signature" 860 {-# INLINE _sign_schnorr #-} 861 862 -- | Verify a 64-byte Schnorr signature for the provided message with 863 -- the supplied public key. 864 -- 865 -- >>> verify_schnorr msg pub <valid signature> 866 -- True 867 -- >>> verify_schnorr msg pub <invalid signature> 868 -- False 869 verify_schnorr 870 :: BS.ByteString -- ^ message 871 -> Pub -- ^ public key 872 -> BS.ByteString -- ^ 64-byte Schnorr signature 873 -> Bool 874 verify_schnorr = _verify_schnorr (mul_unsafe _CURVE_G) 875 876 -- | The same as 'verify_schnorr', except uses a 'Context' to optimise 877 -- internal calculations. 878 -- 879 -- You can expect about a 1.5x performance increase when using this 880 -- function, compared to 'verify_schnorr'. 881 -- 882 -- >>> let !tex = precompute 883 -- >>> verify_schnorr' tex msg pub <valid signature> 884 -- True 885 -- >>> verify_schnorr' tex msg pub <invalid signature> 886 -- False 887 verify_schnorr' 888 :: Context -- ^ secp256k1 context 889 -> BS.ByteString -- ^ message 890 -> Pub -- ^ public key 891 -> BS.ByteString -- ^ 64-byte Schnorr signature 892 -> Bool 893 verify_schnorr' tex = _verify_schnorr (mul_wnaf tex) 894 895 _verify_schnorr 896 :: (Integer -> Projective) -- partially-applied multiplication function 897 -> BS.ByteString 898 -> Pub 899 -> BS.ByteString 900 -> Bool 901 _verify_schnorr _mul m (affine -> Affine x_p _) sig 902 | BS.length sig /= 64 = False 903 | otherwise = case lift x_p of 904 Nothing -> False 905 Just capP@(Affine x_P _) -> 906 let (roll32 -> r, roll32 -> s) = BS.splitAt 32 sig 907 in if r >= _CURVE_P || s >= _CURVE_Q 908 then False 909 else let e = modQ . roll32 $ hash_tagged "BIP0340/challenge" 910 (unroll32 r <> unroll32 x_P <> m) 911 dif = add (_mul s) 912 (neg (mul_unsafe (projective capP) e)) 913 in if dif == _ZERO 914 then False 915 else let Affine x_R y_R = affine dif 916 in not (I.integerTestBit y_R 0 || x_R /= r) 917 {-# INLINE _verify_schnorr #-} 918 919 -- ecdsa ---------------------------------------------------------------------- 920 -- see https://www.rfc-editor.org/rfc/rfc6979, https://secg.org/sec1-v2.pdf 921 922 -- RFC6979 2.3.2 923 bits2int :: BS.ByteString -> Integer 924 bits2int bs = 925 let (fi -> blen) = BS.length bs * 8 926 (fi -> qlen) = _CURVE_Q_BITS 927 del = blen - qlen 928 in if del > 0 929 then roll bs `I.integerShiftR` del 930 else roll bs 931 932 -- RFC6979 2.3.3 933 int2octets :: Integer -> BS.ByteString 934 int2octets i = pad (unroll i) where 935 pad bs 936 | BS.length bs < _CURVE_Q_BYTES = pad (BS.cons 0 bs) 937 | otherwise = bs 938 939 -- RFC6979 2.3.4 940 bits2octets :: BS.ByteString -> BS.ByteString 941 bits2octets bs = 942 let z1 = bits2int bs 943 z2 = modQ z1 944 in int2octets z2 945 946 -- | An ECDSA signature. 947 data ECDSA = ECDSA { 948 ecdsa_r :: !Integer 949 , ecdsa_s :: !Integer 950 } 951 deriving (Eq, Generic) 952 953 instance Show ECDSA where 954 show _ = "<ecdsa signature>" 955 956 -- ECDSA signature type. 957 data SigType = 958 LowS 959 | Unrestricted 960 deriving Show 961 962 -- Indicates whether to hash the message or assume it has already been 963 -- hashed. 964 data HashFlag = 965 Hash 966 | NoHash 967 deriving Show 968 969 -- | Produce an ECDSA signature for the provided message, using the 970 -- provided private key. 971 -- 972 -- 'sign_ecdsa' produces a "low-s" signature, as is commonly required 973 -- in applications using secp256k1. If you need a generic ECDSA 974 -- signature, use 'sign_ecdsa_unrestricted'. 975 -- 976 -- >>> sign_ecdsa sec msg 977 -- "<ecdsa signature>" 978 sign_ecdsa 979 :: Integer -- ^ secret key 980 -> BS.ByteString -- ^ message 981 -> ECDSA 982 sign_ecdsa = _sign_ecdsa (mul _CURVE_G) LowS Hash 983 984 -- | The same as 'sign_ecdsa', except uses a 'Context' to optimise internal 985 -- calculations. 986 -- 987 -- You can expect about a 10x performance increase when using this 988 -- function, compared to 'sign_ecdsa'. 989 -- 990 -- >>> let !tex = precompute 991 -- >>> sign_ecdsa' tex sec msg 992 -- "<ecdsa signature>" 993 sign_ecdsa' 994 :: Context -- ^ secp256k1 context 995 -> Integer -- ^ secret key 996 -> BS.ByteString -- ^ message 997 -> ECDSA 998 sign_ecdsa' tex = _sign_ecdsa (mul_wnaf tex) LowS Hash 999 1000 -- | Produce an ECDSA signature for the provided message, using the 1001 -- provided private key. 1002 -- 1003 -- 'sign_ecdsa_unrestricted' produces an unrestricted ECDSA signature, 1004 -- which is less common in applications using secp256k1 due to the 1005 -- signature's inherent malleability. If you need a conventional 1006 -- "low-s" signature, use 'sign_ecdsa'. 1007 -- 1008 -- >>> sign_ecdsa_unrestricted sec msg 1009 -- "<ecdsa signature>" 1010 sign_ecdsa_unrestricted 1011 :: Integer -- ^ secret key 1012 -> BS.ByteString -- ^ message 1013 -> ECDSA 1014 sign_ecdsa_unrestricted = _sign_ecdsa (mul _CURVE_G) Unrestricted Hash 1015 1016 -- | The same as 'sign_ecdsa_unrestricted', except uses a 'Context' to 1017 -- optimise internal calculations. 1018 -- 1019 -- You can expect about a 10x performance increase when using this 1020 -- function, compared to 'sign_ecdsa_unrestricted'. 1021 -- 1022 -- >>> let !tex = precompute 1023 -- >>> sign_ecdsa_unrestricted' tex sec msg 1024 -- "<ecdsa signature>" 1025 sign_ecdsa_unrestricted' 1026 :: Context -- ^ secp256k1 context 1027 -> Integer -- ^ secret key 1028 -> BS.ByteString -- ^ message 1029 -> ECDSA 1030 sign_ecdsa_unrestricted' tex = _sign_ecdsa (mul_wnaf tex) Unrestricted Hash 1031 1032 -- Produce a "low-s" ECDSA signature for the provided message, using 1033 -- the provided private key. Assumes that the message has already been 1034 -- pre-hashed. 1035 -- 1036 -- (Useful for testing against noble-secp256k1's suite, in which messages 1037 -- in the test vectors have already been hashed.) 1038 _sign_ecdsa_no_hash 1039 :: Integer -- ^ secret key 1040 -> BS.ByteString -- ^ message digest 1041 -> ECDSA 1042 _sign_ecdsa_no_hash = _sign_ecdsa (mul _CURVE_G) LowS NoHash 1043 1044 _sign_ecdsa_no_hash' 1045 :: Context 1046 -> Integer 1047 -> BS.ByteString 1048 -> ECDSA 1049 _sign_ecdsa_no_hash' tex = _sign_ecdsa (mul_wnaf tex) LowS NoHash 1050 1051 _sign_ecdsa 1052 :: (Integer -> Projective) -- partially-applied multiplication function 1053 -> SigType 1054 -> HashFlag 1055 -> Integer 1056 -> BS.ByteString 1057 -> ECDSA 1058 _sign_ecdsa _mul ty hf _SECRET m 1059 | not (ge _SECRET) = error "ppad-secp256k1 (sign_ecdsa): invalid secret key" 1060 | otherwise = runST $ do 1061 -- RFC6979 sec 3.3a 1062 let entropy = int2octets _SECRET 1063 nonce = bits2octets h 1064 drbg <- DRBG.new SHA256.hmac entropy nonce mempty 1065 -- RFC6979 sec 2.4 1066 sign_loop drbg 1067 where 1068 h = case hf of 1069 Hash -> SHA256.hash m 1070 NoHash -> m 1071 1072 h_modQ = remQ (bits2int h) -- bits2int yields nonnegative 1073 1074 sign_loop g = do 1075 k <- gen_k g 1076 let kg = _mul k 1077 Affine (modQ -> r) _ = affine kg 1078 s = case modinv k (fi _CURVE_Q) of 1079 Nothing -> error "ppad-secp256k1 (sign_ecdsa): bad k value" 1080 Just kinv -> remQ (remQ (h_modQ + remQ (_SECRET * r)) * kinv) 1081 if r == 0 -- negligible probability 1082 then sign_loop g 1083 else let !sig = ECDSA r s 1084 in case ty of 1085 Unrestricted -> pure sig 1086 LowS -> pure (low sig) 1087 {-# INLINE _sign_ecdsa #-} 1088 1089 -- RFC6979 sec 3.3b 1090 gen_k :: DRBG.DRBG s -> ST s Integer 1091 gen_k g = loop g where 1092 loop drbg = do 1093 bytes <- DRBG.gen mempty (fi _CURVE_Q_BYTES) drbg 1094 let can = bits2int bytes 1095 if can >= _CURVE_Q 1096 then loop drbg 1097 else pure can 1098 {-# INLINE gen_k #-} 1099 1100 -- Convert an ECDSA signature to low-S form. 1101 low :: ECDSA -> ECDSA 1102 low (ECDSA r s) = ECDSA r ms where 1103 ms 1104 | s > B.unsafeShiftR _CURVE_Q 1 = modQ (negate s) 1105 | otherwise = s 1106 {-# INLINE low #-} 1107 1108 -- | Verify a "low-s" ECDSA signature for the provided message and 1109 -- public key, 1110 -- 1111 -- Fails to verify otherwise-valid "high-s" signatures. If you need to 1112 -- verify generic ECDSA signatures, use 'verify_ecdsa_unrestricted'. 1113 -- 1114 -- >>> verify_ecdsa msg pub valid_sig 1115 -- True 1116 -- >>> verify_ecdsa msg pub invalid_sig 1117 -- False 1118 verify_ecdsa 1119 :: BS.ByteString -- ^ message 1120 -> Pub -- ^ public key 1121 -> ECDSA -- ^ signature 1122 -> Bool 1123 verify_ecdsa m p sig@(ECDSA _ s) 1124 | s > B.unsafeShiftR _CURVE_Q 1 = False 1125 | otherwise = verify_ecdsa_unrestricted m p sig 1126 1127 -- | The same as 'verify_ecdsa', except uses a 'Context' to optimise 1128 -- internal calculations. 1129 -- 1130 -- You can expect about a 2x performance increase when using this 1131 -- function, compared to 'verify_ecdsa'. 1132 -- 1133 -- >>> let !tex = precompute 1134 -- >>> verify_ecdsa' tex msg pub valid_sig 1135 -- True 1136 -- >>> verify_ecdsa' tex msg pub invalid_sig 1137 -- False 1138 verify_ecdsa' 1139 :: Context -- ^ secp256k1 context 1140 -> BS.ByteString -- ^ message 1141 -> Pub -- ^ public key 1142 -> ECDSA -- ^ signature 1143 -> Bool 1144 verify_ecdsa' tex m p sig@(ECDSA _ s) 1145 | s > B.unsafeShiftR _CURVE_Q 1 = False 1146 | otherwise = verify_ecdsa_unrestricted' tex m p sig 1147 1148 -- | Verify an unrestricted ECDSA signature for the provided message and 1149 -- public key. 1150 -- 1151 -- >>> verify_ecdsa_unrestricted msg pub valid_sig 1152 -- True 1153 -- >>> verify_ecdsa_unrestricted msg pub invalid_sig 1154 -- False 1155 verify_ecdsa_unrestricted 1156 :: BS.ByteString -- ^ message 1157 -> Pub -- ^ public key 1158 -> ECDSA -- ^ signature 1159 -> Bool 1160 verify_ecdsa_unrestricted = _verify_ecdsa_unrestricted (mul_unsafe _CURVE_G) 1161 1162 -- | The same as 'verify_ecdsa_unrestricted', except uses a 'Context' to 1163 -- optimise internal calculations. 1164 -- 1165 -- You can expect about a 2x performance increase when using this 1166 -- function, compared to 'verify_ecdsa_unrestricted'. 1167 -- 1168 -- >>> let !tex = precompute 1169 -- >>> verify_ecdsa_unrestricted' tex msg pub valid_sig 1170 -- True 1171 -- >>> verify_ecdsa_unrestricted' tex msg pub invalid_sig 1172 -- False 1173 verify_ecdsa_unrestricted' 1174 :: Context -- ^ secp256k1 context 1175 -> BS.ByteString -- ^ message 1176 -> Pub -- ^ public key 1177 -> ECDSA -- ^ signature 1178 -> Bool 1179 verify_ecdsa_unrestricted' tex = _verify_ecdsa_unrestricted (mul_wnaf tex) 1180 1181 _verify_ecdsa_unrestricted 1182 :: (Integer -> Projective) -- partially-applied multiplication function 1183 -> BS.ByteString 1184 -> Pub 1185 -> ECDSA 1186 -> Bool 1187 _verify_ecdsa_unrestricted _mul (SHA256.hash -> h) p (ECDSA r s) 1188 -- SEC1-v2 4.1.4 1189 | not (ge r) || not (ge s) = False 1190 | otherwise = 1191 let e = remQ (bits2int h) 1192 s_inv = case modinv s (fi _CURVE_Q) of 1193 -- 'ge s' assures existence of inverse 1194 Nothing -> 1195 error "ppad-secp256k1 (verify_ecdsa_unrestricted): no inverse" 1196 Just si -> si 1197 u1 = remQ (e * s_inv) 1198 u2 = remQ (r * s_inv) 1199 capR = add (_mul u1) (mul_unsafe p u2) 1200 in if capR == _ZERO 1201 then False 1202 else let Affine (modQ -> v) _ = affine capR 1203 in v == r 1204 {-# INLINE _verify_ecdsa_unrestricted #-} 1205