Secp256k1.hs (49139B)
1 {-# OPTIONS_HADDOCK prune #-} 2 {-# LANGUAGE BangPatterns #-} 3 {-# LANGUAGE CPP #-} 4 {-# LANGUAGE DeriveGeneric #-} 5 {-# LANGUAGE DerivingStrategies #-} 6 {-# LANGUAGE LambdaCase #-} 7 {-# LANGUAGE MagicHash #-} 8 {-# LANGUAGE OverloadedStrings #-} 9 {-# LANGUAGE PatternSynonyms #-} 10 {-# LANGUAGE RecordWildCards #-} 11 {-# LANGUAGE UnboxedTuples #-} 12 {-# LANGUAGE ViewPatterns #-} 13 14 #include "MachDeps.h" 15 #if WORD_SIZE_IN_BITS != 64 16 #error "ppad-secp256k1 requires a 64-bit architecture" 17 #endif 18 19 -- | 20 -- Module: Crypto.Curve.Secp256k1 21 -- Copyright: (c) 2024 Jared Tobin 22 -- License: MIT 23 -- Maintainer: Jared Tobin <jared@ppad.tech> 24 -- 25 -- Pure [BIP0340](https://github.com/bitcoin/bips/blob/master/bip-0340.mediawiki) 26 -- Schnorr signatures, deterministic 27 -- [RFC6979](https://www.rfc-editor.org/rfc/rfc6979) ECDSA (with 28 -- [BIP0146](https://github.com/bitcoin/bips/blob/master/bip-0146.mediawiki)-style 29 -- "low-S" signatures), and ECDH shared secret computation 30 -- on the elliptic curve secp256k1. 31 32 module Crypto.Curve.Secp256k1 ( 33 -- * Parsing 34 parse_int256 35 , parse_point 36 , parse_sig 37 38 -- * Serializing 39 , serialize_point 40 41 -- * secp256k1 points 42 , Pub 43 , derive_pub 44 , derive_pub' 45 , _CURVE_G 46 , _CURVE_ZERO 47 , ge 48 , fe 49 50 -- * ECDH 51 , ecdh 52 53 -- * BIP0340 Schnorr signatures 54 , sign_schnorr 55 , verify_schnorr 56 57 -- * RFC6979 ECDSA 58 , ECDSA(..) 59 , SigType(..) 60 , sign_ecdsa 61 , sign_ecdsa_unrestricted 62 , verify_ecdsa 63 , verify_ecdsa_unrestricted 64 65 -- * Fast variants 66 , Context 67 , precompute 68 , sign_schnorr' 69 , verify_schnorr' 70 , sign_ecdsa' 71 , sign_ecdsa_unrestricted' 72 , verify_ecdsa' 73 , verify_ecdsa_unrestricted' 74 75 -- Elliptic curve group operations 76 , neg 77 , add 78 , add_mixed 79 , add_proj 80 , double 81 , mul 82 , mul_vartime 83 , mul_wnaf 84 85 -- * Field and group parameters 86 , _CURVE_Q 87 , _CURVE_P 88 89 -- Coordinate systems and transformations 90 , Affine(..) 91 , Projective(..) 92 , affine 93 , projective 94 , valid 95 96 -- for testing/benchmarking 97 , _precompute 98 , _sign_ecdsa_no_hash 99 , _sign_ecdsa_no_hash' 100 , _verify_ecdsa_no_hash 101 , _verify_ecdsa_no_hash' 102 , roll32 103 , unsafe_roll32 104 , unroll32 105 , select_proj 106 ) where 107 108 import Control.Monad (guard) 109 import Control.Monad.ST 110 import qualified Crypto.DRBG.HMAC.SHA256 as DRBG 111 import qualified Crypto.Hash.SHA256 as SHA256 112 import qualified Data.Bits as B 113 import Data.Bits ((.<<.)) 114 import qualified Data.ByteString as BS 115 import qualified Data.ByteString.Internal as BI 116 import qualified Data.ByteString.Unsafe as BU 117 import qualified Data.Choice as CT 118 import qualified Data.Maybe as M 119 import Data.Primitive.ByteArray (ByteArray(..), MutableByteArray(..)) 120 import qualified Data.Primitive.ByteArray as BA 121 import Data.Word (Word8) 122 import Data.Word.Limb (Limb(..)) 123 import qualified Data.Word.Limb as L 124 import Data.Word.Wider (Wider(..)) 125 import qualified Data.Word.Wider as W 126 import qualified Foreign.Storable as Storable (pokeByteOff) 127 import qualified GHC.Exts as Exts 128 import GHC.Generics 129 import qualified GHC.Word (Word(..), Word8(..)) 130 import qualified Numeric.Montgomery.Secp256k1.Curve as C 131 import qualified Numeric.Montgomery.Secp256k1.Scalar as S 132 import Prelude hiding (sqrt) 133 134 -- convenience synonyms ------------------------------------------------------- 135 136 -- Unboxed Wider/Montgomery synonym. 137 type Limb4 = (# Limb, Limb, Limb, Limb #) 138 139 -- Unboxed Projective synonym. 140 type Proj = (# Limb4, Limb4, Limb4 #) 141 142 pattern Z :: Limb4 143 pattern Z = (# Limb 0##, Limb 0##, Limb 0##, Limb 0## #) 144 145 pattern P :: Limb4 -> Limb4 -> Limb4 -> Projective 146 pattern P x y z = Projective (C.Montgomery x) (C.Montgomery y) (C.Montgomery z) 147 {-# COMPLETE P #-} 148 149 -- utilities ------------------------------------------------------------------ 150 151 fi :: (Integral a, Num b) => a -> b 152 fi = fromIntegral 153 {-# INLINE fi #-} 154 155 -- convert a Word8 to a Limb 156 limb :: Word8 -> Limb 157 limb (GHC.Word.W8# (Exts.word8ToWord# -> w)) = Limb w 158 {-# INLINABLE limb #-} 159 160 -- convert a Limb to a Word8 161 word8 :: Limb -> Word8 162 word8 (Limb w) = GHC.Word.W8# (Exts.wordToWord8# w) 163 {-# INLINABLE word8 #-} 164 165 -- convert a Limb to a Word8 after right-shifting 166 word8s :: Limb -> Exts.Int# -> Word8 167 word8s l s = 168 let !(Limb w) = L.shr# l s 169 in GHC.Word.W8# (Exts.wordToWord8# w) 170 {-# INLINABLE word8s #-} 171 172 -- convert a Word8 to a Wider 173 word8_to_wider :: Word8 -> Wider 174 word8_to_wider w = Wider (# limb w, Limb 0##, Limb 0##, Limb 0## #) 175 {-# INLINABLE word8_to_wider #-} 176 177 -- unsafely extract the first 64-bit word from a big-endian-encoded bytestring 178 unsafe_word0 :: BS.ByteString -> Limb 179 unsafe_word0 bs = 180 (limb (BU.unsafeIndex bs 00) `L.shl#` 56#) 181 `L.or#` (limb (BU.unsafeIndex bs 01) `L.shl#` 48#) 182 `L.or#` (limb (BU.unsafeIndex bs 02) `L.shl#` 40#) 183 `L.or#` (limb (BU.unsafeIndex bs 03) `L.shl#` 32#) 184 `L.or#` (limb (BU.unsafeIndex bs 04) `L.shl#` 24#) 185 `L.or#` (limb (BU.unsafeIndex bs 05) `L.shl#` 16#) 186 `L.or#` (limb (BU.unsafeIndex bs 06) `L.shl#` 08#) 187 `L.or#` (limb (BU.unsafeIndex bs 07)) 188 {-# INLINABLE unsafe_word0 #-} 189 190 -- unsafely extract the second 64-bit word from a big-endian-encoded bytestring 191 unsafe_word1 :: BS.ByteString -> Limb 192 unsafe_word1 bs = 193 (limb (BU.unsafeIndex bs 08) `L.shl#` 56#) 194 `L.or#` (limb (BU.unsafeIndex bs 09) `L.shl#` 48#) 195 `L.or#` (limb (BU.unsafeIndex bs 10) `L.shl#` 40#) 196 `L.or#` (limb (BU.unsafeIndex bs 11) `L.shl#` 32#) 197 `L.or#` (limb (BU.unsafeIndex bs 12) `L.shl#` 24#) 198 `L.or#` (limb (BU.unsafeIndex bs 13) `L.shl#` 16#) 199 `L.or#` (limb (BU.unsafeIndex bs 14) `L.shl#` 08#) 200 `L.or#` (limb (BU.unsafeIndex bs 15)) 201 {-# INLINABLE unsafe_word1 #-} 202 203 -- unsafely extract the third 64-bit word from a big-endian-encoded bytestring 204 unsafe_word2 :: BS.ByteString -> Limb 205 unsafe_word2 bs = 206 (limb (BU.unsafeIndex bs 16) `L.shl#` 56#) 207 `L.or#` (limb (BU.unsafeIndex bs 17) `L.shl#` 48#) 208 `L.or#` (limb (BU.unsafeIndex bs 18) `L.shl#` 40#) 209 `L.or#` (limb (BU.unsafeIndex bs 19) `L.shl#` 32#) 210 `L.or#` (limb (BU.unsafeIndex bs 20) `L.shl#` 24#) 211 `L.or#` (limb (BU.unsafeIndex bs 21) `L.shl#` 16#) 212 `L.or#` (limb (BU.unsafeIndex bs 22) `L.shl#` 08#) 213 `L.or#` (limb (BU.unsafeIndex bs 23)) 214 {-# INLINABLE unsafe_word2 #-} 215 216 -- unsafely extract the fourth 64-bit word from a big-endian-encoded bytestring 217 unsafe_word3 :: BS.ByteString -> Limb 218 unsafe_word3 bs = 219 (limb (BU.unsafeIndex bs 24) `L.shl#` 56#) 220 `L.or#` (limb (BU.unsafeIndex bs 25) `L.shl#` 48#) 221 `L.or#` (limb (BU.unsafeIndex bs 26) `L.shl#` 40#) 222 `L.or#` (limb (BU.unsafeIndex bs 27) `L.shl#` 32#) 223 `L.or#` (limb (BU.unsafeIndex bs 28) `L.shl#` 24#) 224 `L.or#` (limb (BU.unsafeIndex bs 29) `L.shl#` 16#) 225 `L.or#` (limb (BU.unsafeIndex bs 30) `L.shl#` 08#) 226 `L.or#` (limb (BU.unsafeIndex bs 31)) 227 {-# INLINABLE unsafe_word3 #-} 228 229 -- 256-bit big-endian bytestring decoding. the input size is not checked! 230 unsafe_roll32 :: BS.ByteString -> Wider 231 unsafe_roll32 bs = 232 let !w0 = unsafe_word0 bs 233 !w1 = unsafe_word1 bs 234 !w2 = unsafe_word2 bs 235 !w3 = unsafe_word3 bs 236 in Wider (# w3, w2, w1, w0 #) 237 {-# INLINABLE unsafe_roll32 #-} 238 239 -- arbitrary-size big-endian bytestring decoding 240 roll32 :: BS.ByteString -> Maybe Wider 241 roll32 bs 242 | BS.length stripped > 32 = Nothing 243 | otherwise = Just $! BS.foldl' alg 0 stripped 244 where 245 stripped = BS.dropWhile (== 0) bs 246 alg !a (word8_to_wider -> !b) = (a `W.shl_limb` 8) `W.or` b 247 {-# INLINABLE roll32 #-} 248 249 -- 256-bit big-endian bytestring encoding 250 unroll32 :: Wider -> BS.ByteString 251 unroll32 (Wider (# w0, w1, w2, w3 #)) = 252 BI.unsafeCreate 32 $ \ptr -> do 253 -- w0 254 Storable.pokeByteOff ptr 00 (word8s w3 56#) 255 Storable.pokeByteOff ptr 01 (word8s w3 48#) 256 Storable.pokeByteOff ptr 02 (word8s w3 40#) 257 Storable.pokeByteOff ptr 03 (word8s w3 32#) 258 Storable.pokeByteOff ptr 04 (word8s w3 24#) 259 Storable.pokeByteOff ptr 05 (word8s w3 16#) 260 Storable.pokeByteOff ptr 06 (word8s w3 08#) 261 Storable.pokeByteOff ptr 07 (word8 w3) 262 -- w1 263 Storable.pokeByteOff ptr 08 (word8s w2 56#) 264 Storable.pokeByteOff ptr 09 (word8s w2 48#) 265 Storable.pokeByteOff ptr 10 (word8s w2 40#) 266 Storable.pokeByteOff ptr 11 (word8s w2 32#) 267 Storable.pokeByteOff ptr 12 (word8s w2 24#) 268 Storable.pokeByteOff ptr 13 (word8s w2 16#) 269 Storable.pokeByteOff ptr 14 (word8s w2 08#) 270 Storable.pokeByteOff ptr 15 (word8 w2) 271 -- w2 272 Storable.pokeByteOff ptr 16 (word8s w1 56#) 273 Storable.pokeByteOff ptr 17 (word8s w1 48#) 274 Storable.pokeByteOff ptr 18 (word8s w1 40#) 275 Storable.pokeByteOff ptr 19 (word8s w1 32#) 276 Storable.pokeByteOff ptr 20 (word8s w1 24#) 277 Storable.pokeByteOff ptr 21 (word8s w1 16#) 278 Storable.pokeByteOff ptr 22 (word8s w1 08#) 279 Storable.pokeByteOff ptr 23 (word8 w1) 280 -- w3 281 Storable.pokeByteOff ptr 24 (word8s w0 56#) 282 Storable.pokeByteOff ptr 25 (word8s w0 48#) 283 Storable.pokeByteOff ptr 26 (word8s w0 40#) 284 Storable.pokeByteOff ptr 27 (word8s w0 32#) 285 Storable.pokeByteOff ptr 28 (word8s w0 24#) 286 Storable.pokeByteOff ptr 29 (word8s w0 16#) 287 Storable.pokeByteOff ptr 30 (word8s w0 08#) 288 Storable.pokeByteOff ptr 31 (word8 w0) 289 {-# INLINABLE unroll32 #-} 290 291 -- modQ via conditional subtraction 292 modQ :: Wider -> Wider 293 modQ x = W.select x (x - _CURVE_Q) (CT.not (W.lt x _CURVE_Q)) 294 {-# INLINABLE modQ #-} 295 296 -- bytewise xor 297 xor :: BS.ByteString -> BS.ByteString -> BS.ByteString 298 xor = BS.packZipWith B.xor 299 {-# INLINABLE xor #-} 300 301 -- constants ------------------------------------------------------------------ 302 303 -- | secp256k1 field prime. 304 -- 305 -- >>> _CURVE_P 306 -- 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2F 307 _CURVE_P :: Wider 308 _CURVE_P = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2F 309 310 -- | secp256k1 group order. 311 -- 312 -- >>> _CURVE_Q 313 -- 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141 314 _CURVE_Q :: Wider 315 _CURVE_Q = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141 316 317 -- | half of the secp256k1 group order. 318 _CURVE_QH :: Wider 319 _CURVE_QH = 0x7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF5D576E7357A4501DDFE92F46681B20A0 320 321 -- bitlength of group order 322 -- 323 -- = smallest integer such that _CURVE_Q < 2 ^ _CURVE_Q_BITS 324 _CURVE_Q_BITS :: Int 325 _CURVE_Q_BITS = 256 326 327 -- bytelength of _CURVE_Q 328 -- 329 -- = _CURVE_Q_BITS / 8 330 _CURVE_Q_BYTES :: Int 331 _CURVE_Q_BYTES = 32 332 333 -- secp256k1 weierstrass form, /b/ coefficient 334 _CURVE_B :: Wider 335 _CURVE_B = 7 336 337 -- secp256k1 weierstrass form, /b/ coefficient, montgomery form 338 _CURVE_Bm :: C.Montgomery 339 _CURVE_Bm = 7 340 341 -- _CURVE_Bm * 3 342 _CURVE_Bm3 :: C.Montgomery 343 _CURVE_Bm3 = 21 344 345 -- Is field element? 346 fe :: Wider -> Bool 347 fe n = case W.cmp_vartime n 0 of 348 GT -> case W.cmp_vartime n _CURVE_P of 349 LT -> True 350 _ -> False 351 _ -> False 352 {-# INLINE fe #-} 353 354 -- Is group element? 355 ge :: Wider -> Bool 356 ge (Wider n) = CT.decide (ge# n) 357 {-# INLINE ge #-} 358 359 -- curve points --------------------------------------------------------------- 360 361 -- curve point, affine coordinates 362 data Affine = Affine !C.Montgomery !C.Montgomery 363 deriving stock (Show, Generic) 364 365 -- curve point, projective coordinates 366 data Projective = Projective { 367 px :: !C.Montgomery 368 , py :: !C.Montgomery 369 , pz :: !C.Montgomery 370 } 371 deriving stock (Show, Generic) 372 373 instance Eq Projective where 374 Projective ax ay az == Projective bx by bz = 375 let !x1z2 = ax * bz 376 !x2z1 = bx * az 377 !y1z2 = ay * bz 378 !y2z1 = by * az 379 in CT.decide (CT.and (C.eq x1z2 x2z1) (C.eq y1z2 y2z1)) 380 381 -- | A public key, i.e. secp256k1 point. 382 type Pub = Projective 383 384 -- Convert to affine coordinates. 385 affine :: Projective -> Affine 386 affine (Projective x y z) = 387 let !iz = C.inv z 388 in Affine (x * iz) (y * iz) 389 {-# INLINABLE affine #-} 390 391 -- Convert to projective coordinates. 392 projective :: Affine -> Projective 393 projective (Affine x y) 394 | C.eq_vartime x 0 || C.eq_vartime y 0 = _CURVE_ZERO 395 | otherwise = Projective x y 1 396 397 -- | secp256k1 generator point. 398 _CURVE_G :: Projective 399 _CURVE_G = Projective x y z where 400 !x = C.Montgomery 401 (# Limb 15507633332195041431##, Limb 2530505477788034779## 402 , Limb 10925531211367256732##, Limb 11061375339145502536## #) 403 !y = C.Montgomery 404 (# Limb 12780836216951778274##, Limb 10231155108014310989## 405 , Limb 8121878653926228278##, Limb 14933801261141951190## #) 406 !z = C.Montgomery 407 (# Limb 0x1000003D1##, Limb 0##, Limb 0##, Limb 0## #) 408 409 -- | secp256k1 zero point, point at infinity, or monoidal identity. 410 _CURVE_ZERO :: Projective 411 _CURVE_ZERO = Projective 0 1 0 412 413 -- secp256k1 zero point, point at infinity, or monoidal identity 414 _ZERO :: Projective 415 _ZERO = Projective 0 1 0 416 {-# DEPRECATED _ZERO "use _CURVE_ZERO instead" #-} 417 418 -- secp256k1 in short weierstrass form (y ^ 2 = x ^ 3 + 7) 419 weierstrass :: C.Montgomery -> C.Montgomery 420 weierstrass x = C.sqr x * x + _CURVE_Bm 421 {-# INLINE weierstrass #-} 422 423 -- Point is valid 424 valid :: Projective -> Bool 425 valid (affine -> Affine x y) = C.eq_vartime (C.sqr y) (weierstrass x) 426 427 -- Point is the identity, i.e. the point at infinity. 428 -- 429 -- Note that 'affine' maps the identity to (0, 0), so a point must be 430 -- tested here, and not via its affine coordinates. 431 is_inf :: Projective -> Bool 432 is_inf (Projective _ _ z) = CT.decide (C.eq z 0) 433 {-# INLINE is_inf #-} 434 435 -- (bip0340) return point with x coordinate == x and with even y coordinate 436 -- 437 -- conceptually: 438 -- y ^ 2 = x ^ 3 + 7 439 -- y = "+-" sqrt (x ^ 3 + 7) 440 -- (n.b. for solution y, p - y is also a solution) 441 -- y + (p - y) = p (odd) 442 -- (n.b. sum is odd, so one of y and p - y must be odd, and the other even) 443 -- if y even, return (x, y) 444 -- else, return (x, p - y) 445 lift_vartime :: C.Montgomery -> Maybe Affine 446 lift_vartime x = do 447 let !c = weierstrass x 448 !y <- C.sqrt_vartime c 449 let !y_e | C.odd_vartime y = negate y 450 | otherwise = y 451 pure $! Affine x y_e 452 453 even_y_vartime :: Projective -> Projective 454 even_y_vartime p = case affine p of 455 Affine _ (C.retr -> y) 456 | CT.decide (W.odd y) -> neg p 457 | otherwise -> p 458 459 -- Constant-time selection of Projective points. 460 select_proj :: Projective -> Projective -> CT.Choice -> Projective 461 select_proj (Projective ax ay az) (Projective bx by bz) c = 462 Projective (C.select ax bx c) (C.select ay by c) (C.select az bz c) 463 {-# INLINE select_proj #-} 464 465 -- unboxed internals ---------------------------------------------------------- 466 467 -- algo 7, renes et al, 2015 468 add_proj# :: Proj -> Proj -> Proj 469 add_proj# (# x1, y1, z1 #) (# x2, y2, z2 #) = 470 let !(C.Montgomery b3) = _CURVE_Bm3 471 !t0a = C.mul# x1 x2 472 !t1a = C.mul# y1 y2 473 !t2a = C.mul# z1 z2 474 !t3a = C.add# x1 y1 475 !t4a = C.add# x2 y2 476 !t3b = C.mul# t3a t4a 477 !t4b = C.add# t0a t1a 478 !t3c = C.sub# t3b t4b 479 !t4c = C.add# y1 z1 480 !x3a = C.add# y2 z2 481 !t4d = C.mul# t4c x3a 482 !x3b = C.add# t1a t2a 483 !t4e = C.sub# t4d x3b 484 !x3c = C.add# x1 z1 485 !y3a = C.add# x2 z2 486 !x3d = C.mul# x3c y3a 487 !y3b = C.add# t0a t2a 488 !y3c = C.sub# x3d y3b 489 !x3e = C.add# t0a t0a 490 !t0b = C.add# x3e t0a 491 !t2b = C.mul# b3 t2a 492 !z3a = C.add# t1a t2b 493 !t1b = C.sub# t1a t2b 494 !y3d = C.mul# b3 y3c 495 !x3f = C.mul# t4e y3d 496 !t2c = C.mul# t3c t1b 497 !x3g = C.sub# t2c x3f 498 !y3e = C.mul# y3d t0b 499 !t1c = C.mul# t1b z3a 500 !y3f = C.add# t1c y3e 501 !t0c = C.mul# t0b t3c 502 !z3b = C.mul# z3a t4e 503 !z3c = C.add# z3b t0c 504 in (# x3g, y3f, z3c #) 505 {-# INLINE add_proj# #-} 506 507 -- algo 8, renes et al, 2015 508 add_mixed# :: Proj -> Proj -> Proj 509 add_mixed# (# x1, y1, z1 #) (# x2, y2, _z2 #) = 510 let !(C.Montgomery b3) = _CURVE_Bm3 511 !t0a = C.mul# x1 x2 512 !t1a = C.mul# y1 y2 513 !t3a = C.add# x2 y2 514 !t4a = C.add# x1 y1 515 !t3b = C.mul# t3a t4a 516 !t4b = C.add# t0a t1a 517 !t3c = C.sub# t3b t4b 518 !t4c = C.mul# y2 z1 519 !t4d = C.add# t4c y1 520 !y3a = C.mul# x2 z1 521 !y3b = C.add# y3a x1 522 !x3a = C.add# t0a t0a 523 !t0b = C.add# x3a t0a 524 !t2a = C.mul# b3 z1 525 !z3a = C.add# t1a t2a 526 !t1b = C.sub# t1a t2a 527 !y3c = C.mul# b3 y3b 528 !x3b = C.mul# t4d y3c 529 !t2b = C.mul# t3c t1b 530 !x3c = C.sub# t2b x3b 531 !y3d = C.mul# y3c t0b 532 !t1c = C.mul# t1b z3a 533 !y3e = C.add# t1c y3d 534 !t0c = C.mul# t0b t3c 535 !z3b = C.mul# z3a t4d 536 !z3c = C.add# z3b t0c 537 in (# x3c, y3e, z3c #) 538 {-# INLINE add_mixed# #-} 539 540 -- algo 9, renes et al, 2015 541 double# :: Proj -> Proj 542 double# (# x, y, z #) = 543 let !(C.Montgomery b3) = _CURVE_Bm3 544 !t0 = C.sqr# y 545 !z3a = C.add# t0 t0 546 !z3b = C.add# z3a z3a 547 !z3c = C.add# z3b z3b 548 !t1 = C.mul# y z 549 !t2a = C.sqr# z 550 !t2b = C.mul# b3 t2a 551 !x3a = C.mul# t2b z3c 552 !y3a = C.add# t0 t2b 553 !z3d = C.mul# t1 z3c 554 !t1b = C.add# t2b t2b 555 !t2c = C.add# t1b t2b 556 !t0b = C.sub# t0 t2c 557 !y3b = C.mul# t0b y3a 558 !y3c = C.add# x3a y3b 559 !t1c = C.mul# x y 560 !x3b = C.mul# t0b t1c 561 !x3c = C.add# x3b x3b 562 in (# x3c, y3c, z3d #) 563 {-# INLINE double# #-} 564 565 select_proj# :: Proj -> Proj -> CT.Choice -> Proj 566 select_proj# (# ax, ay, az #) (# bx, by, bz #) c = 567 (# W.select# ax bx c, W.select# ay by c, W.select# az bz c #) 568 {-# INLINE select_proj# #-} 569 570 neg# :: Proj -> Proj 571 neg# (# x, y, z #) = (# x, C.neg# y, z #) 572 {-# INLINE neg# #-} 573 574 mul# :: Proj -> Limb4 -> (# () | Proj #) 575 mul# (# px, py, pz #) s 576 | CT.decide (CT.not (ge# s)) = (# () | #) 577 | otherwise = 578 let !(C.Montgomery o) = C.one 579 in loop (0 :: Int) (# Z, o, Z #) (# px, py, pz #) s 580 where 581 loop !j !a !d !_SECRET 582 | j == _CURVE_Q_BITS = (# | a #) 583 | otherwise = 584 let !nd = double# d 585 !(# nm, lsb_set #) = W.shr1_c# _SECRET 586 !nacc = select_proj# a (add_proj# a d) lsb_set 587 in loop (succ j) nacc nd nm 588 {-# INLINE mul# #-} 589 590 mul_vartime# :: Proj -> Limb4 -> (# () | Proj #) 591 mul_vartime# (# px, py, pz #) s 592 | zero# s = 593 let !(P zx zy zz) = _CURVE_ZERO 594 in (# | (# zx, zy, zz #) #) 595 | CT.decide (CT.not (ge# s)) = (# () | #) 596 | otherwise = 597 let !(P zx zy zz) = _CURVE_ZERO 598 in (# | loop (# zx, zy, zz #) (# px, py, pz #) s #) 599 where 600 zero# (# Limb a, Limb b, Limb c, Limb d #) = Exts.isTrue# 601 ((a `Exts.or#` b `Exts.or#` c `Exts.or#` d) `Exts.eqWord#` 0##) 602 603 loop !r !d !m 604 | zero# m = r 605 | otherwise = 606 let !nd = double# d 607 !(# nm, lsb_set #) = W.shr1_c# m 608 !nr = if CT.decide lsb_set then add_proj# r d else r 609 in loop nr nd nm 610 {-# INLINE mul_vartime# #-} 611 612 ge# :: Limb4 -> CT.Choice 613 ge# n = 614 let !(Wider q) = _CURVE_Q 615 in CT.and (W.gt# n Z) (W.lt# n q) 616 {-# INLINE ge# #-} 617 618 mul_wnaf# :: ByteArray -> Int -> Limb4 -> (# () | Proj #) 619 mul_wnaf# ctxArray ctxW ls 620 | CT.decide (CT.not (ge# ls)) = (# () | #) 621 | otherwise = 622 let !(P zx zy zz) = _CURVE_ZERO 623 in (# | loop 0 (# zx, zy, zz #) ls #) 624 where 625 !one = (# Limb 1##, Limb 0##, Limb 0##, Limb 0## #) 626 !wins = fi (256 `quot` ctxW + 1) 627 !size@(GHC.Word.W# s) = 1 .<<. (ctxW - 1) 628 !(GHC.Word.W# mask) = 1 .<<. ctxW - 1 629 !(GHC.Word.W# texW) = fi ctxW 630 !(GHC.Word.W# mnum) = 1 .<<. ctxW 631 632 loop !j !acc !n@(# Limb lo, _, _, _ #) 633 | j == wins = acc 634 | otherwise = 635 let !(GHC.Word.W# off0) = j * size 636 !b0 = Exts.and# lo mask 637 !bor = CT.from_word_gt# b0 s 638 639 !(# n0, _ #) = W.shr_limb# n (Exts.word2Int# texW) 640 !n0_plus_1 = W.add_w# n0 one 641 !n1 = W.select# n0 n0_plus_1 bor 642 643 !abs_b = CT.select_word# b0 (Exts.minusWord# mnum b0) bor 644 !is_zero = CT.from_word_eq# b0 0## 645 !off_nz = Exts.minusWord# (Exts.plusWord# off0 abs_b) 1## 646 !off = CT.select_word# off0 off_nz (CT.not is_zero) 647 648 !pr = ct_index_proj# ctxArray off0 s off 649 !neg_pr = neg# pr 650 !pt_nonzero = select_proj# pr neg_pr bor 651 652 !acc_added = add_proj# acc pt_nonzero 653 !nacc = select_proj# acc_added acc is_zero 654 in loop (succ j) nacc n1 655 {-# INLINE mul_wnaf# #-} 656 657 -- retrieve a point (as an unboxed tuple) from a context array 658 index_proj# :: ByteArray -> Exts.Int# -> Proj 659 index_proj# (ByteArray arr#) i# = 660 let !base# = i# Exts.*# 12# 661 !x = (# Limb (Exts.indexWordArray# arr# base#) 662 , Limb (Exts.indexWordArray# arr# (base# Exts.+# 01#)) 663 , Limb (Exts.indexWordArray# arr# (base# Exts.+# 02#)) 664 , Limb (Exts.indexWordArray# arr# (base# Exts.+# 03#)) #) 665 !y = (# Limb (Exts.indexWordArray# arr# (base# Exts.+# 04#)) 666 , Limb (Exts.indexWordArray# arr# (base# Exts.+# 05#)) 667 , Limb (Exts.indexWordArray# arr# (base# Exts.+# 06#)) 668 , Limb (Exts.indexWordArray# arr# (base# Exts.+# 07#)) #) 669 !z = (# Limb (Exts.indexWordArray# arr# (base# Exts.+# 08#)) 670 , Limb (Exts.indexWordArray# arr# (base# Exts.+# 09#)) 671 , Limb (Exts.indexWordArray# arr# (base# Exts.+# 10#)) 672 , Limb (Exts.indexWordArray# arr# (base# Exts.+# 11#)) #) 673 in (# x, y, z #) 674 {-# INLINE index_proj# #-} 675 676 -- Constant-time table lookup within a window. 677 -- 678 -- Unconditionally scans all entries from 'base' to 'base + size - 1', 679 -- selecting the one where 'index' equals 'target'. 680 ct_index_proj# 681 :: ByteArray 682 -> Exts.Word# -- ^ base index 683 -> Exts.Word# -- ^ size of window 684 -> Exts.Word# -- ^ target index 685 -> Proj 686 ct_index_proj# arr base size target = loop 0## (# Z, Z, Z #) where 687 loop i acc 688 | Exts.isTrue# (i `Exts.geWord#` size) = acc 689 | otherwise = 690 let !idx = Exts.plusWord# base i 691 !pt = index_proj# arr (Exts.word2Int# idx) 692 !eq = CT.from_word_eq# idx target 693 !nacc = select_proj# acc pt eq 694 in loop (Exts.plusWord# i 1##) nacc 695 {-# INLINE ct_index_proj# #-} 696 697 -- ec arithmetic -------------------------------------------------------------- 698 699 -- Negate secp256k1 point. 700 neg :: Projective -> Projective 701 neg (P x y z) = 702 let !(# px, py, pz #) = neg# (# x, y, z #) 703 in P px py pz 704 {-# INLINABLE neg #-} 705 706 -- Elliptic curve addition on secp256k1. 707 add :: Projective -> Projective -> Projective 708 add p q = add_proj p q 709 {-# INLINABLE add #-} 710 711 -- algo 7, "complete addition formulas for prime order elliptic curves," 712 -- renes et al, 2015 713 -- 714 -- https://eprint.iacr.org/2015/1060.pdf 715 add_proj :: Projective -> Projective -> Projective 716 add_proj (P ax ay az) (P bx by bz) = 717 let !(# x, y, z #) = add_proj# (# ax, ay, az #) (# bx, by, bz #) 718 in P x y z 719 {-# INLINABLE add_proj #-} 720 721 -- algo 8, renes et al, 2015 722 -- 723 -- the second point must be affine, i.e. have z == 1. this is not 724 -- checked, and the result is meaningless otherwise; use add_proj if 725 -- the second point may be in projective form. 726 add_mixed :: Projective -> Projective -> Projective 727 add_mixed (P ax ay az) (P bx by bz) = 728 let !(# x, y, z #) = add_mixed# (# ax, ay, az #) (# bx, by, bz #) 729 in P x y z 730 {-# INLINABLE add_mixed #-} 731 732 -- algo 9, renes et al, 2015 733 double :: Projective -> Projective 734 double (Projective (C.Montgomery ax) (C.Montgomery ay) (C.Montgomery az)) = 735 let !(# x, y, z #) = double# (# ax, ay, az #) 736 in P x y z 737 {-# INLINABLE double #-} 738 739 -- Timing-safe scalar multiplication of secp256k1 points. 740 mul :: Projective -> Wider -> Maybe Projective 741 mul (P x y z) (Wider s) = case mul# (# x, y, z #) s of 742 (# () | #) -> Nothing 743 (# | (# px, py, pz #) #) -> Just $! P px py pz 744 {-# INLINABLE mul #-} 745 746 -- Timing-unsafe scalar multiplication of secp256k1 points. 747 -- 748 -- Don't use this function if the scalar could potentially be a secret. 749 mul_vartime :: Projective -> Wider -> Maybe Projective 750 mul_vartime (P x y z) (Wider s) = case mul_vartime# (# x, y, z #) s of 751 (# () | #) -> Nothing 752 (# | (# px, py, pz #) #) -> Just $! P px py pz 753 754 -- | Precomputed multiples of the secp256k1 base or generator point. 755 data Context = Context { 756 ctxW :: {-# UNPACK #-} !Int 757 , ctxArray :: {-# UNPACK #-} !ByteArray 758 } deriving Generic 759 760 instance Show Context where 761 show Context {} = "<secp256k1 context>" 762 763 -- | Create a secp256k1 context by precomputing multiples of the curve's 764 -- generator point. 765 -- 766 -- This should be used once to create a 'Context' to be reused 767 -- repeatedly afterwards. 768 -- 769 -- >>> let !tex = precompute 770 -- >>> sign_ecdsa' tex sec msg 771 -- >>> sign_schnorr' tex sec msg aux 772 precompute :: Context 773 precompute = _precompute 4 774 775 -- This is a highly-optimized version of a function originally 776 -- translated from noble-secp256k1's "precompute". Points are stored in 777 -- a ByteArray by arranging each limb into slices of 12 consecutive 778 -- slots (each Projective point consists of three Montgomery values, 779 -- each of which consists of four limbs, summing to twelve limbs in 780 -- total). 781 -- 782 -- Each point takes 96 bytes to store in this fashion, so the total size of 783 -- the ByteArray is (size * 96) bytes. 784 _precompute :: Int -> Context 785 _precompute ctxW = Context {..} where 786 capJ = (1 :: Int) .<<. (ctxW - 1) 787 ws = 256 `quot` ctxW + 1 788 size = ws * capJ 789 790 -- construct the context array 791 ctxArray = runST $ do 792 marr <- BA.newByteArray (size * 96) 793 loop_w marr _CURVE_G 0 794 BA.unsafeFreezeByteArray marr 795 796 -- write a point into the i^th 12-slot slice in the array 797 write :: MutableByteArray s -> Int -> Projective -> ST s () 798 write marr i 799 (P (# Limb x0, Limb x1, Limb x2, Limb x3 #) 800 (# Limb y0, Limb y1, Limb y2, Limb y3 #) 801 (# Limb z0, Limb z1, Limb z2, Limb z3 #)) = do 802 let !base = i * 12 803 BA.writeByteArray marr (base + 00) (GHC.Word.W# x0) 804 BA.writeByteArray marr (base + 01) (GHC.Word.W# x1) 805 BA.writeByteArray marr (base + 02) (GHC.Word.W# x2) 806 BA.writeByteArray marr (base + 03) (GHC.Word.W# x3) 807 BA.writeByteArray marr (base + 04) (GHC.Word.W# y0) 808 BA.writeByteArray marr (base + 05) (GHC.Word.W# y1) 809 BA.writeByteArray marr (base + 06) (GHC.Word.W# y2) 810 BA.writeByteArray marr (base + 07) (GHC.Word.W# y3) 811 BA.writeByteArray marr (base + 08) (GHC.Word.W# z0) 812 BA.writeByteArray marr (base + 09) (GHC.Word.W# z1) 813 BA.writeByteArray marr (base + 10) (GHC.Word.W# z2) 814 BA.writeByteArray marr (base + 11) (GHC.Word.W# z3) 815 816 -- loop over windows 817 loop_w :: MutableByteArray s -> Projective -> Int -> ST s () 818 loop_w !marr !p !w 819 | w == ws = pure () 820 | otherwise = do 821 nb <- loop_j marr p p (w * capJ) 0 822 let np = double nb 823 loop_w marr np (succ w) 824 825 -- loop within windows 826 loop_j 827 :: MutableByteArray s 828 -> Projective 829 -> Projective 830 -> Int 831 -> Int 832 -> ST s Projective 833 loop_j !marr !p !b !idx !j = do 834 write marr idx b 835 if j == capJ - 1 836 then pure b 837 else do 838 let !nb = add b p 839 loop_j marr p nb (succ idx) (succ j) 840 841 -- Timing-safe wNAF (w-ary non-adjacent form) scalar multiplication of 842 -- secp256k1 points. 843 mul_wnaf :: Context -> Wider -> Maybe Projective 844 mul_wnaf Context {..} (Wider s) = case mul_wnaf# ctxArray ctxW s of 845 (# () | #) -> Nothing 846 (# | (# px, py, pz #) #) -> Just $! P px py pz 847 {-# INLINABLE mul_wnaf #-} 848 849 -- | Derive a public key (i.e., a secp256k1 point) from the provided 850 -- secret. 851 -- 852 -- >>> import qualified System.Entropy as E 853 -- >>> sk <- fmap parse_int256 (E.getEntropy 32) 854 -- >>> derive_pub sk 855 -- Just "<secp256k1 point>" 856 derive_pub :: Wider -> Maybe Pub 857 derive_pub = mul _CURVE_G 858 {-# NOINLINE derive_pub #-} 859 860 -- | The same as 'derive_pub', except uses a 'Context' to optimise 861 -- internal calculations. 862 -- 863 -- >>> import qualified System.Entropy as E 864 -- >>> sk <- fmap parse_int256 (E.getEntropy 32) 865 -- >>> let !tex = precompute 866 -- >>> derive_pub' tex sk 867 -- Just "<secp256k1 point>" 868 derive_pub' :: Context -> Wider -> Maybe Pub 869 derive_pub' = mul_wnaf 870 {-# NOINLINE derive_pub' #-} 871 872 -- parsing -------------------------------------------------------------------- 873 874 -- | Parse a 'Wider', /e.g./ a Schnorr or ECDSA secret key. 875 -- 876 -- >>> import qualified Data.ByteString as BS 877 -- >>> parse_int256 (BS.replicate 32 0xFF) 878 -- Just <2^256 - 1> 879 parse_int256 :: BS.ByteString -> Maybe Wider 880 parse_int256 bs = do 881 guard (BS.length bs == 32) 882 pure $! unsafe_roll32 bs 883 {-# INLINABLE parse_int256 #-} 884 885 -- | Parse compressed secp256k1 point (33 bytes), uncompressed point (65 886 -- bytes), or BIP0340-style point (32 bytes). 887 -- 888 -- >>> parse_point <33-byte compressed point> 889 -- Just <Pub> 890 -- >>> parse_point <65-byte uncompressed point> 891 -- Just <Pub> 892 -- >>> parse_point <32-byte bip0340 public key> 893 -- Just <Pub> 894 -- >>> parse_point <anything else> 895 -- Nothing 896 parse_point :: BS.ByteString -> Maybe Projective 897 parse_point bs 898 | len == 32 = _parse_bip0340 bs 899 | otherwise = case BS.uncons bs of 900 Nothing -> Nothing 901 Just (h, t) 902 | len == 33 -> _parse_compressed h t 903 | len == 65 -> _parse_uncompressed h t 904 | otherwise -> Nothing 905 where 906 len = BS.length bs 907 908 -- input is guaranteed to be 32B in length 909 _parse_bip0340 :: BS.ByteString -> Maybe Projective 910 _parse_bip0340 (unsafe_roll32 -> x) = do 911 guard (fe x) -- bip0340 "fail if x >= p"; x == 0 has no lift anyway 912 fmap projective (lift_vartime (C.to x)) 913 914 -- bytestring input is guaranteed to be 32B in length 915 _parse_compressed :: Word8 -> BS.ByteString -> Maybe Projective 916 _parse_compressed h (unsafe_roll32 -> x) 917 | h /= 0x02 && h /= 0x03 = Nothing 918 | not (fe x) = Nothing 919 | otherwise = do 920 let !mx = C.to x 921 !my <- C.sqrt_vartime (weierstrass mx) 922 let !yodd = CT.decide (W.odd (C.retr my)) 923 !hodd = B.testBit h 0 924 pure $! 925 if hodd /= yodd 926 then Projective mx (negate my) 1 927 else Projective mx my 1 928 929 -- bytestring input is guaranteed to be 64B in length 930 _parse_uncompressed :: Word8 -> BS.ByteString -> Maybe Projective 931 _parse_uncompressed h bs = do 932 let (unsafe_roll32 -> x, unsafe_roll32 -> y) = BS.splitAt _CURVE_Q_BYTES bs 933 guard (h == 0x04) 934 guard (fe x && fe y) -- sec1-v2 requires both in [0, p - 1] 935 let !p = Projective (C.to x) (C.to y) 1 936 guard (valid p) 937 pure $! p 938 939 -- | Parse an ECDSA signature encoded in 64-byte "compact" form. 940 -- 941 -- >>> parse_sig <64-byte compact signature> 942 -- Just "<ecdsa signature>" 943 parse_sig :: BS.ByteString -> Maybe ECDSA 944 parse_sig bs = do 945 guard (BS.length bs == 64) 946 let (r0, s0) = BS.splitAt 32 bs 947 r <- roll32 r0 948 s <- roll32 s0 949 pure $! ECDSA r s 950 951 -- serializing ---------------------------------------------------------------- 952 953 -- | Serialize a secp256k1 point in 33-byte compressed form. 954 -- 955 -- >>> serialize_point pub 956 -- "<33-byte compressed point>" 957 serialize_point :: Projective -> BS.ByteString 958 serialize_point (affine -> Affine (C.from -> x) (C.from -> y)) = 959 let !(Wider (# Limb w, _, _, _ #)) = y 960 !b | B.testBit (GHC.Word.W# w) 0 = 0x03 961 | otherwise = 0x02 962 in BS.cons b (unroll32 x) 963 964 -- ecdh ----------------------------------------------------------------------- 965 966 -- SEC1-v2 3.3.1, plus SHA256 hash 967 968 -- | Compute a shared secret, given a secret key and public secp256k1 point, 969 -- via Elliptic Curve Diffie-Hellman (ECDH). 970 -- 971 -- The shared secret is the SHA256 hash of the x-coordinate of the 972 -- point obtained by scalar multiplication. 973 -- 974 -- >>> let sec_alice = 0x03 975 -- >>> let sec_bob = 2 ^ 128 - 1 976 -- >>> let Just pub_alice = derive_pub sec_alice 977 -- >>> let Just pub_bob = derive_pub sec_bob 978 -- >>> let secret_as_computed_by_alice = ecdh pub_bob sec_alice 979 -- >>> let secret_as_computed_by_bob = ecdh pub_alice sec_bob 980 -- >>> secret_as_computed_by_alice == secret_as_computed_by_bob 981 -- True 982 ecdh 983 :: Projective -- ^ public key 984 -> Wider -- ^ secret key 985 -> Maybe BS.ByteString -- ^ shared secret 986 ecdh pub _SECRET = do 987 pt@(P _ _ (C.Montgomery -> z)) <- mul pub _SECRET 988 let !(Affine (C.retr -> x) _) = affine pt 989 !result = SHA256.hash (unroll32 x) 990 if CT.decide (C.eq z 0) then Nothing else Just result 991 992 -- schnorr -------------------------------------------------------------------- 993 -- see https://github.com/bitcoin/bips/blob/master/bip-0340.mediawiki 994 995 -- | Create a 64-byte Schnorr signature for the provided message, using 996 -- the provided secret key. 997 -- 998 -- BIP0340 recommends that 32 bytes of fresh auxiliary entropy be 999 -- generated and added at signing time as additional protection 1000 -- against side-channel attacks (namely, to thwart so-called "fault 1001 -- injection" attacks). This entropy is /supplemental/ to security, 1002 -- and the cryptographic security of the signature scheme itself does 1003 -- not rely on it, so it is not strictly required; 32 zero bytes can 1004 -- be used in its stead. 1005 -- 1006 -- The auxiliary input is hashed, so any length input is accepted. 1007 -- 1008 -- >>> import qualified System.Entropy as E 1009 -- >>> aux <- E.getEntropy 32 1010 -- >>> sign_schnorr sec msg aux 1011 -- Just "<64-byte schnorr signature>" 1012 sign_schnorr 1013 :: Wider -- ^ secret key 1014 -> BS.ByteString -- ^ message 1015 -> BS.ByteString -- ^ 32 bytes of auxilliary random data 1016 -> Maybe BS.ByteString -- ^ 64-byte Schnorr signature 1017 sign_schnorr = _sign_schnorr (mul _CURVE_G) 1018 1019 -- | The same as 'sign_schnorr', except uses a 'Context' to optimise 1020 -- internal calculations. 1021 -- 1022 -- You can expect about a 2x performance increase when using this 1023 -- function, compared to 'sign_schnorr'. 1024 -- 1025 -- >>> import qualified System.Entropy as E 1026 -- >>> aux <- E.getEntropy 32 1027 -- >>> let !tex = precompute 1028 -- >>> sign_schnorr' tex sec msg aux 1029 -- Just "<64-byte schnorr signature>" 1030 sign_schnorr' 1031 :: Context -- ^ secp256k1 context 1032 -> Wider -- ^ secret key 1033 -> BS.ByteString -- ^ message 1034 -> BS.ByteString -- ^ 32 bytes of auxilliary random data 1035 -> Maybe BS.ByteString -- ^ 64-byte Schnorr signature 1036 sign_schnorr' tex = _sign_schnorr (mul_wnaf tex) 1037 1038 _sign_schnorr 1039 :: (Wider -> Maybe Projective) -- partially-applied multiplication function 1040 -> Wider -- secret key 1041 -> BS.ByteString -- message 1042 -> BS.ByteString -- 32 bytes of auxilliary random data 1043 -> Maybe BS.ByteString 1044 _sign_schnorr _mul _SECRET m a = do 1045 p <- _mul _SECRET 1046 let Affine (C.retr -> x_p) (C.retr -> y_p) = affine p 1047 s = S.to _SECRET 1048 d = S.select s (negate s) (W.odd y_p) 1049 bytes_d = unroll32 (S.retr d) 1050 bytes_p = unroll32 x_p 1051 t = xor bytes_d (hash_aux a) 1052 rand = hash_nonce (t <> bytes_p <> m) 1053 k' = S.to (unsafe_roll32 rand) 1054 -- negligible probability, but k' is secret, so compare without 1055 -- short-circuiting and decide only on the result 1056 guard (not (CT.decide (S.eq k' 0))) 1057 pt <- _mul (S.retr k') 1058 let Affine (C.retr -> x_r) (C.retr -> y_r) = affine pt 1059 k = S.select k' (negate k') (W.odd y_r) 1060 bytes_r = unroll32 x_r 1061 rand' = hash_challenge (bytes_r <> bytes_p <> m) 1062 e = S.to (unsafe_roll32 rand') 1063 bytes_ked = unroll32 (S.retr (k + e * d)) 1064 sig = bytes_r <> bytes_ked 1065 -- NB for benchmarking we morally want to remove the precautionary 1066 -- verification check here. 1067 -- 1068 -- guard (verify_schnorr m p sig) 1069 pure $! sig 1070 {-# INLINE _sign_schnorr #-} 1071 1072 -- | Verify a 64-byte Schnorr signature for the provided message with 1073 -- the supplied public key. 1074 -- 1075 -- >>> verify_schnorr msg pub <valid signature> 1076 -- True 1077 -- >>> verify_schnorr msg pub <invalid signature> 1078 -- False 1079 verify_schnorr 1080 :: BS.ByteString -- ^ message 1081 -> Pub -- ^ public key 1082 -> BS.ByteString -- ^ 64-byte Schnorr signature 1083 -> Bool 1084 verify_schnorr = _verify_schnorr (mul_vartime _CURVE_G) 1085 1086 -- | The same as 'verify_schnorr', except uses a 'Context' to optimise 1087 -- internal calculations. 1088 -- 1089 -- You can expect about a 1.5x performance increase when using this 1090 -- function, compared to 'verify_schnorr'. 1091 -- 1092 -- >>> let !tex = precompute 1093 -- >>> verify_schnorr' tex msg pub <valid signature> 1094 -- True 1095 -- >>> verify_schnorr' tex msg pub <invalid signature> 1096 -- False 1097 verify_schnorr' 1098 :: Context -- ^ secp256k1 context 1099 -> BS.ByteString -- ^ message 1100 -> Pub -- ^ public key 1101 -> BS.ByteString -- ^ 64-byte Schnorr signature 1102 -> Bool 1103 verify_schnorr' tex = _verify_schnorr (mul_wnaf tex) 1104 1105 _verify_schnorr 1106 :: (Wider -> Maybe Projective) -- partially-applied multiplication function 1107 -> BS.ByteString 1108 -> Pub 1109 -> BS.ByteString 1110 -> Bool 1111 _verify_schnorr _mul m p sig 1112 | BS.length sig /= 64 = False 1113 -- e * P vanishes for the identity, dropping the challenge from the 1114 -- verification equation entirely 1115 | is_inf p = False 1116 | otherwise = M.isJust $ do 1117 let capP = even_y_vartime p 1118 (unsafe_roll32 -> r, unsafe_roll32 -> s) = BS.splitAt 32 sig 1119 -- bip0340 fails only on r >= p and s >= n, so zero is permitted 1120 guard (W.lt_vartime r _CURVE_P && W.lt_vartime s _CURVE_Q) 1121 let Affine (C.retr -> x_P) _ = affine capP 1122 e = modQ . unsafe_roll32 $ 1123 hash_challenge (unroll32 r <> unroll32 x_P <> m) 1124 -- mul_wnaf rejects a zero scalar, mul_vartime does not; agree on 1125 -- the identity so both multiplication functions behave alike 1126 pt0 <- if W.eq_vartime s 0 1127 then pure _CURVE_ZERO 1128 else _mul s 1129 pt1 <- mul_vartime capP e 1130 let dif = add pt0 (neg pt1) 1131 guard (dif /= _CURVE_ZERO) 1132 let Affine (C.from -> x_R) (C.from -> y_R) = affine dif 1133 guard $ not (CT.decide (W.odd y_R) || not (W.eq_vartime x_R r)) 1134 {-# INLINE _verify_schnorr #-} 1135 1136 -- hardcoded tag of BIP0340/aux 1137 -- 1138 -- \x -> let h = SHA256.hash "BIP0340/aux" 1139 -- in SHA256.hash (h <> h <> x) 1140 hash_aux :: BS.ByteString -> BS.ByteString 1141 hash_aux x = SHA256.hash $ 1142 "\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 1143 {-# INLINE hash_aux #-} 1144 1145 -- hardcoded tag of BIP0340/nonce 1146 hash_nonce :: BS.ByteString -> BS.ByteString 1147 hash_nonce x = SHA256.hash $ 1148 "\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 1149 {-# INLINE hash_nonce #-} 1150 1151 -- hardcoded tag of BIP0340/challenge 1152 hash_challenge :: BS.ByteString -> BS.ByteString 1153 hash_challenge x = SHA256.hash $ 1154 "{\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 1155 {-# INLINE hash_challenge #-} 1156 1157 -- ecdsa ---------------------------------------------------------------------- 1158 -- see https://www.rfc-editor.org/rfc/rfc6979, https://secg.org/sec1-v2.pdf 1159 1160 -- RFC6979 2.3.2 1161 bits2int :: BS.ByteString -> Wider 1162 bits2int = unsafe_roll32 1163 {-# INLINABLE bits2int #-} 1164 1165 -- RFC6979 2.3.3 1166 int2octets :: Wider -> BS.ByteString 1167 int2octets = unroll32 1168 {-# INLINABLE int2octets #-} 1169 1170 -- RFC6979 2.3.4 1171 bits2octets :: BS.ByteString -> BS.ByteString 1172 bits2octets bs = 1173 let z1 = bits2int bs 1174 z2 = modQ z1 1175 in int2octets z2 1176 1177 -- | An ECDSA signature. 1178 data ECDSA = ECDSA { 1179 ecdsa_r :: !Wider 1180 , ecdsa_s :: !Wider 1181 } 1182 deriving (Generic) 1183 1184 instance Show ECDSA where 1185 show _ = "<ecdsa signature>" 1186 1187 -- ECDSA signature type. 1188 data SigType = 1189 LowS 1190 | Unrestricted 1191 deriving Show 1192 1193 -- Indicates whether to hash the message or assume it has already been 1194 -- hashed. 1195 data HashFlag = 1196 Hash 1197 | NoHash 1198 deriving Show 1199 1200 -- Convert an ECDSA signature to low-S form. 1201 low :: ECDSA -> ECDSA 1202 low (ECDSA r s) = ECDSA r (W.select s (_CURVE_Q - s) (W.gt s _CURVE_QH)) 1203 {-# INLINE low #-} 1204 1205 -- | Produce an ECDSA signature for the provided message, using the 1206 -- provided private key. 1207 -- 1208 -- 'sign_ecdsa' produces a "low-s" signature, as is commonly required 1209 -- in applications using secp256k1. If you need a generic ECDSA 1210 -- signature, use 'sign_ecdsa_unrestricted'. 1211 -- 1212 -- >>> sign_ecdsa sec msg 1213 -- Just "<ecdsa signature>" 1214 sign_ecdsa 1215 :: Wider -- ^ secret key 1216 -> BS.ByteString -- ^ message 1217 -> Maybe ECDSA 1218 sign_ecdsa = _sign_ecdsa (mul _CURVE_G) LowS Hash 1219 1220 -- | The same as 'sign_ecdsa', except uses a 'Context' to optimise internal 1221 -- calculations. 1222 -- 1223 -- You can expect about a 10x performance increase when using this 1224 -- function, compared to 'sign_ecdsa'. 1225 -- 1226 -- >>> let !tex = precompute 1227 -- >>> sign_ecdsa' tex sec msg 1228 -- Just "<ecdsa signature>" 1229 sign_ecdsa' 1230 :: Context -- ^ secp256k1 context 1231 -> Wider -- ^ secret key 1232 -> BS.ByteString -- ^ message 1233 -> Maybe ECDSA 1234 sign_ecdsa' tex = _sign_ecdsa (mul_wnaf tex) LowS Hash 1235 1236 -- | Produce an ECDSA signature for the provided message, using the 1237 -- provided private key. 1238 -- 1239 -- 'sign_ecdsa_unrestricted' produces an unrestricted ECDSA signature, 1240 -- which is less common in applications using secp256k1 due to the 1241 -- signature's inherent malleability. If you need a conventional 1242 -- "low-s" signature, use 'sign_ecdsa'. 1243 -- 1244 -- >>> sign_ecdsa_unrestricted sec msg 1245 -- Just "<ecdsa signature>" 1246 sign_ecdsa_unrestricted 1247 :: Wider -- ^ secret key 1248 -> BS.ByteString -- ^ message 1249 -> Maybe ECDSA 1250 sign_ecdsa_unrestricted = _sign_ecdsa (mul _CURVE_G) Unrestricted Hash 1251 1252 -- | The same as 'sign_ecdsa_unrestricted', except uses a 'Context' to 1253 -- optimise internal calculations. 1254 -- 1255 -- You can expect about a 10x performance increase when using this 1256 -- function, compared to 'sign_ecdsa_unrestricted'. 1257 -- 1258 -- >>> let !tex = precompute 1259 -- >>> sign_ecdsa_unrestricted' tex sec msg 1260 -- Just "<ecdsa signature>" 1261 sign_ecdsa_unrestricted' 1262 :: Context -- ^ secp256k1 context 1263 -> Wider -- ^ secret key 1264 -> BS.ByteString -- ^ message 1265 -> Maybe ECDSA 1266 sign_ecdsa_unrestricted' tex = _sign_ecdsa (mul_wnaf tex) Unrestricted Hash 1267 1268 -- Produce a "low-s" ECDSA signature for the provided message, using 1269 -- the provided private key. Assumes that the message has already been 1270 -- pre-hashed, such that the digest is exactly 32 bytes. 1271 -- 1272 -- (Useful for testing against noble-secp256k1's suite, in which messages 1273 -- in the test vectors have already been hashed.) 1274 _sign_ecdsa_no_hash 1275 :: Wider -- ^ secret key 1276 -> BS.ByteString -- ^ message digest 1277 -> Maybe ECDSA 1278 _sign_ecdsa_no_hash _SECRET m 1279 | BS.length m /= _CURVE_Q_BYTES = Nothing 1280 | otherwise = _sign_ecdsa (mul _CURVE_G) LowS NoHash _SECRET m 1281 1282 _sign_ecdsa_no_hash' 1283 :: Context 1284 -> Wider 1285 -> BS.ByteString 1286 -> Maybe ECDSA 1287 _sign_ecdsa_no_hash' tex _SECRET m 1288 | BS.length m /= _CURVE_Q_BYTES = Nothing 1289 | otherwise = _sign_ecdsa (mul_wnaf tex) LowS NoHash _SECRET m 1290 1291 _sign_ecdsa 1292 :: (Wider -> Maybe Projective) -- partially-applied multiplication function 1293 -> SigType 1294 -> HashFlag 1295 -> Wider 1296 -> BS.ByteString 1297 -> Maybe ECDSA 1298 _sign_ecdsa _mul ty hf _SECRET m 1299 | not (ge _SECRET) = Nothing 1300 | otherwise = runST $ do 1301 -- RFC6979 sec 3.3a 1302 let entropy = int2octets _SECRET 1303 nonce = bits2octets h 1304 drbg <- DRBG.new entropy nonce mempty 1305 -- RFC6979 sec 2.4 1306 sign_loop drbg 1307 where 1308 d = S.to _SECRET 1309 hm = S.to (bits2int h) 1310 h = case hf of 1311 Hash -> SHA256.hash m 1312 NoHash -> m 1313 1314 sign_loop g = do 1315 k <- gen_k g 1316 let mpair = do 1317 kg <- _mul k 1318 let Affine (S.to . C.retr -> r) _ = affine kg 1319 ki = S.inv (S.to k) 1320 s = (hm + d * r) * ki 1321 pure $! (S.retr r, S.retr s) 1322 case mpair of 1323 Nothing -> do 1324 DRBG.wipe g 1325 pure Nothing 1326 Just (r, s) 1327 -- sec1-v2 4.1.3 retries on either being zero 1328 | W.eq_vartime r 0 || W.eq_vartime s 0 -> sign_loop g 1329 | otherwise -> do 1330 DRBG.wipe g 1331 let !sig = Just $! ECDSA r s 1332 pure $ case ty of 1333 Unrestricted -> sig 1334 LowS -> fmap low sig 1335 {-# INLINE _sign_ecdsa #-} 1336 1337 -- RFC6979 sec 3.3b 1338 gen_k :: DRBG.DRBG s -> ST s Wider 1339 gen_k g = loop g where 1340 loop drbg = do 1341 bytes <- DRBG.gen drbg mempty (fi _CURVE_Q_BYTES) 1342 case bytes of 1343 Left {} -> error "ppad-secp256k1: internal error (please report a bug!)" 1344 Right bs -> do 1345 let can = bits2int bs 1346 if ge can -- rfc6979 requires k in [1, q - 1] 1347 then pure can 1348 else loop drbg -- 2 ^ -128 probability 1349 {-# INLINE gen_k #-} 1350 1351 -- | Verify a "low-s" ECDSA signature for the provided message and 1352 -- public key, 1353 -- 1354 -- Fails to verify otherwise-valid "high-s" signatures. If you need to 1355 -- verify generic ECDSA signatures, use 'verify_ecdsa_unrestricted'. 1356 -- 1357 -- >>> verify_ecdsa msg pub valid_sig 1358 -- True 1359 -- >>> verify_ecdsa msg pub invalid_sig 1360 -- False 1361 verify_ecdsa 1362 :: BS.ByteString -- ^ message 1363 -> Pub -- ^ public key 1364 -> ECDSA -- ^ signature 1365 -> Bool 1366 verify_ecdsa m p sig@(ECDSA _ s) 1367 | CT.decide (W.gt s _CURVE_QH) = False 1368 | otherwise = verify_ecdsa_unrestricted m p sig 1369 1370 -- | The same as 'verify_ecdsa', except uses a 'Context' to optimise 1371 -- internal calculations. 1372 -- 1373 -- You can expect about a 2x performance increase when using this 1374 -- function, compared to 'verify_ecdsa'. 1375 -- 1376 -- >>> let !tex = precompute 1377 -- >>> verify_ecdsa' tex msg pub valid_sig 1378 -- True 1379 -- >>> verify_ecdsa' tex msg pub invalid_sig 1380 -- False 1381 verify_ecdsa' 1382 :: Context -- ^ secp256k1 context 1383 -> BS.ByteString -- ^ message 1384 -> Pub -- ^ public key 1385 -> ECDSA -- ^ signature 1386 -> Bool 1387 verify_ecdsa' tex m p sig@(ECDSA _ s) 1388 | CT.decide (W.gt s _CURVE_QH) = False 1389 | otherwise = verify_ecdsa_unrestricted' tex m p sig 1390 1391 -- | Verify an unrestricted ECDSA signature for the provided message and 1392 -- public key. 1393 -- 1394 -- >>> verify_ecdsa_unrestricted msg pub valid_sig 1395 -- True 1396 -- >>> verify_ecdsa_unrestricted msg pub invalid_sig 1397 -- False 1398 verify_ecdsa_unrestricted 1399 :: BS.ByteString -- ^ message 1400 -> Pub -- ^ public key 1401 -> ECDSA -- ^ signature 1402 -> Bool 1403 verify_ecdsa_unrestricted = 1404 _verify_ecdsa_unrestricted (mul_vartime _CURVE_G) Hash 1405 1406 -- | The same as 'verify_ecdsa_unrestricted', except uses a 'Context' to 1407 -- optimise internal calculations. 1408 -- 1409 -- You can expect about a 2x performance increase when using this 1410 -- function, compared to 'verify_ecdsa_unrestricted'. 1411 -- 1412 -- >>> let !tex = precompute 1413 -- >>> verify_ecdsa_unrestricted' tex msg pub valid_sig 1414 -- True 1415 -- >>> verify_ecdsa_unrestricted' tex msg pub invalid_sig 1416 -- False 1417 verify_ecdsa_unrestricted' 1418 :: Context -- ^ secp256k1 context 1419 -> BS.ByteString -- ^ message 1420 -> Pub -- ^ public key 1421 -> ECDSA -- ^ signature 1422 -> Bool 1423 verify_ecdsa_unrestricted' tex = 1424 _verify_ecdsa_unrestricted (mul_wnaf tex) Hash 1425 1426 _verify_ecdsa_unrestricted 1427 :: (Wider -> Maybe Projective) -- partially-applied multiplication function 1428 -> HashFlag 1429 -> BS.ByteString 1430 -> Pub 1431 -> ECDSA 1432 -> Bool 1433 _verify_ecdsa_unrestricted _mul hf m p (ECDSA r0 s0) = M.isJust $ do 1434 -- SEC1-v2 4.1.4 1435 let h = case hf of 1436 Hash -> SHA256.hash m 1437 NoHash -> m 1438 -- u2 * P vanishes for the identity, leaving an equation an attacker 1439 -- can satisfy by choosing s freely 1440 guard (not (is_inf p)) 1441 guard (ge r0 && ge s0) 1442 let r = S.to r0 1443 s = S.to s0 1444 e = S.to (bits2int h) 1445 si = S.inv s 1446 u1 = S.retr (e * si) 1447 u2 = S.retr (r * si) 1448 pt0 = case _mul u1 of 1449 Nothing -> _CURVE_ZERO 1450 Just pt -> pt 1451 pt1 <- mul_vartime p u2 1452 let capR = add pt0 pt1 1453 guard (capR /= _CURVE_ZERO) 1454 let Affine (S.to . C.retr -> v) _ = affine capR 1455 guard (S.eq_vartime v r) 1456 {-# INLINE _verify_ecdsa_unrestricted #-} 1457 1458 -- | Verify a "low-s" ECDSA signature for the provided message digest 1459 -- and public key. 1460 -- 1461 -- Mirrors 'verify_ecdsa', but skips the internal SHA256 step, 1462 -- treating the input as the message digest itself. Fails to verify 1463 -- if the digest is not exactly 32 bytes. 1464 -- 1465 -- >>> _verify_ecdsa_no_hash dig pub valid_sig 1466 -- True 1467 -- >>> _verify_ecdsa_no_hash dig pub invalid_sig 1468 -- False 1469 _verify_ecdsa_no_hash 1470 :: BS.ByteString -- ^ message digest 1471 -> Pub -- ^ public key 1472 -> ECDSA -- ^ signature 1473 -> Bool 1474 _verify_ecdsa_no_hash m p sig@(ECDSA _ s) 1475 | BS.length m /= _CURVE_Q_BYTES = False 1476 | W.gt_vartime s _CURVE_QH = False 1477 | otherwise = 1478 _verify_ecdsa_unrestricted (mul_vartime _CURVE_G) NoHash m p sig 1479 1480 -- | The same as '_verify_ecdsa_no_hash', except uses a 'Context' to 1481 -- optimise internal calculations. 1482 -- 1483 -- You can expect about a 2x performance increase when using this 1484 -- function, compared to '_verify_ecdsa_no_hash'. 1485 -- 1486 -- >>> let !tex = precompute 1487 -- >>> _verify_ecdsa_no_hash' tex dig pub valid_sig 1488 -- True 1489 -- >>> _verify_ecdsa_no_hash' tex dig pub invalid_sig 1490 -- False 1491 _verify_ecdsa_no_hash' 1492 :: Context -- ^ secp256k1 context 1493 -> BS.ByteString -- ^ message digest 1494 -> Pub -- ^ public key 1495 -> ECDSA -- ^ signature 1496 -> Bool 1497 _verify_ecdsa_no_hash' tex m p sig@(ECDSA _ s) 1498 | BS.length m /= _CURVE_Q_BYTES = False 1499 | W.gt_vartime s _CURVE_QH = False 1500 | otherwise = 1501 _verify_ecdsa_unrestricted (mul_wnaf tex) NoHash m p sig 1502