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