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