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