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