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