ppad-secp256k1-0.5.0: lib/Crypto/Curve/Secp256k1.hs
{-# OPTIONS_HADDOCK prune #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE ViewPatterns #-}
-- |
-- Module: Crypto.Curve.Secp256k1
-- Copyright: (c) 2024 Jared Tobin
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
-- Pure [BIP0340](https://github.com/bitcoin/bips/blob/master/bip-0340.mediawiki)
-- Schnorr signatures, deterministic
-- [RFC6979](https://www.rfc-editor.org/rfc/rfc6979) ECDSA (with
-- [BIP0146](https://github.com/bitcoin/bips/blob/master/bip-0146.mediawiki)-style
-- "low-S" signatures), and ECDH shared secret computation
-- on the elliptic curve secp256k1.
module Crypto.Curve.Secp256k1 (
-- * Field and group parameters
_CURVE_Q
, _CURVE_P
-- * secp256k1 points
, Pub
, derive_pub
, derive_pub'
, _CURVE_G
, _CURVE_ZERO
, ge
, fe
-- * Parsing
, parse_int256
, parse_point
, parse_sig
-- * Serializing
, serialize_point
-- * ECDH
, ecdh
-- * BIP0340 Schnorr signatures
, sign_schnorr
, verify_schnorr
-- * RFC6979 ECDSA
, ECDSA(..)
, SigType(..)
, sign_ecdsa
, sign_ecdsa_unrestricted
, verify_ecdsa
, verify_ecdsa_unrestricted
-- * Fast variants
, Context
, precompute
, sign_schnorr'
, verify_schnorr'
, sign_ecdsa'
, sign_ecdsa_unrestricted'
, verify_ecdsa'
, verify_ecdsa_unrestricted'
-- Elliptic curve group operations
, neg
, add
, add_mixed
, add_proj
, double
, mul
, mul_vartime
, mul_wnaf
-- Coordinate systems and transformations
, Affine(..)
, Projective(..)
, affine
, projective
, valid
-- for testing/benchmarking
, _precompute
, _sign_ecdsa_no_hash
, _sign_ecdsa_no_hash'
, roll32
, unsafe_roll32
, unroll32
, select_proj
) where
import Control.Monad (guard)
import Control.Monad.ST
import qualified Crypto.DRBG.HMAC as DRBG
import qualified Crypto.Hash.SHA256 as SHA256
import qualified Data.Bits as B
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BI
import qualified Data.ByteString.Unsafe as BU
import qualified Data.Choice as CT
import qualified Data.Maybe as M
import Data.Primitive.ByteArray (ByteArray(..), MutableByteArray(..))
import qualified Data.Primitive.ByteArray as BA
import Data.Word (Word8)
import Data.Word.Limb (Limb(..))
import qualified Data.Word.Limb as L
import Data.Word.Wider (Wider(..))
import qualified Data.Word.Wider as W
import qualified Foreign.Storable as Storable (pokeByteOff)
import qualified GHC.Exts as Exts
import GHC.Generics
import qualified GHC.Word (Word(..), Word8(..))
import qualified Numeric.Montgomery.Secp256k1.Curve as C
import qualified Numeric.Montgomery.Secp256k1.Scalar as S
import Prelude hiding (sqrt)
-- convenience synonyms -------------------------------------------------------
-- Unboxed Wider/Montgomery synonym.
type Limb4 = (# Limb, Limb, Limb, Limb #)
-- Unboxed Projective synonym.
type Proj = (# Limb4, Limb4, Limb4 #)
pattern Zero :: Wider
pattern Zero = Wider Z
pattern Z :: Limb4
pattern Z = (# Limb 0##, Limb 0##, Limb 0##, Limb 0## #)
pattern P :: Limb4 -> Limb4 -> Limb4 -> Projective
pattern P x y z =
Projective (C.Montgomery x) (C.Montgomery y) (C.Montgomery z)
{-# COMPLETE P #-}
-- utilities ------------------------------------------------------------------
fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
{-# INLINE fi #-}
-- convert a Word8 to a Limb
limb :: Word8 -> Limb
limb (GHC.Word.W8# (Exts.word8ToWord# -> w)) = Limb w
{-# INLINABLE limb #-}
-- convert a Limb to a Word8
word8 :: Limb -> Word8
word8 (Limb w) = GHC.Word.W8# (Exts.wordToWord8# w)
{-# INLINABLE word8 #-}
-- convert a Limb to a Word8 after right-shifting
word8s :: Limb -> Exts.Int# -> Word8
word8s l s =
let !(Limb w) = L.shr# l s
in GHC.Word.W8# (Exts.wordToWord8# w)
{-# INLINABLE word8s #-}
-- convert a Word8 to a Wider
word8_to_wider :: Word8 -> Wider
word8_to_wider w = Wider (# limb w, Limb 0##, Limb 0##, Limb 0## #)
{-# INLINABLE word8_to_wider #-}
-- unsafely extract the first 64-bit word from a big-endian-encoded bytestring
unsafe_word0 :: BS.ByteString -> Limb
unsafe_word0 bs =
(limb (BU.unsafeIndex bs 00) `L.shl#` 56#)
`L.or#` (limb (BU.unsafeIndex bs 01) `L.shl#` 48#)
`L.or#` (limb (BU.unsafeIndex bs 02) `L.shl#` 40#)
`L.or#` (limb (BU.unsafeIndex bs 03) `L.shl#` 32#)
`L.or#` (limb (BU.unsafeIndex bs 04) `L.shl#` 24#)
`L.or#` (limb (BU.unsafeIndex bs 05) `L.shl#` 16#)
`L.or#` (limb (BU.unsafeIndex bs 06) `L.shl#` 08#)
`L.or#` (limb (BU.unsafeIndex bs 07))
{-# INLINABLE unsafe_word0 #-}
-- unsafely extract the second 64-bit word from a big-endian-encoded bytestring
unsafe_word1 :: BS.ByteString -> Limb
unsafe_word1 bs =
(limb (BU.unsafeIndex bs 08) `L.shl#` 56#)
`L.or#` (limb (BU.unsafeIndex bs 09) `L.shl#` 48#)
`L.or#` (limb (BU.unsafeIndex bs 10) `L.shl#` 40#)
`L.or#` (limb (BU.unsafeIndex bs 11) `L.shl#` 32#)
`L.or#` (limb (BU.unsafeIndex bs 12) `L.shl#` 24#)
`L.or#` (limb (BU.unsafeIndex bs 13) `L.shl#` 16#)
`L.or#` (limb (BU.unsafeIndex bs 14) `L.shl#` 08#)
`L.or#` (limb (BU.unsafeIndex bs 15))
{-# INLINABLE unsafe_word1 #-}
-- unsafely extract the third 64-bit word from a big-endian-encoded bytestring
unsafe_word2 :: BS.ByteString -> Limb
unsafe_word2 bs =
(limb (BU.unsafeIndex bs 16) `L.shl#` 56#)
`L.or#` (limb (BU.unsafeIndex bs 17) `L.shl#` 48#)
`L.or#` (limb (BU.unsafeIndex bs 18) `L.shl#` 40#)
`L.or#` (limb (BU.unsafeIndex bs 19) `L.shl#` 32#)
`L.or#` (limb (BU.unsafeIndex bs 20) `L.shl#` 24#)
`L.or#` (limb (BU.unsafeIndex bs 21) `L.shl#` 16#)
`L.or#` (limb (BU.unsafeIndex bs 22) `L.shl#` 08#)
`L.or#` (limb (BU.unsafeIndex bs 23))
{-# INLINABLE unsafe_word2 #-}
-- unsafely extract the fourth 64-bit word from a big-endian-encoded bytestring
unsafe_word3 :: BS.ByteString -> Limb
unsafe_word3 bs =
(limb (BU.unsafeIndex bs 24) `L.shl#` 56#)
`L.or#` (limb (BU.unsafeIndex bs 25) `L.shl#` 48#)
`L.or#` (limb (BU.unsafeIndex bs 26) `L.shl#` 40#)
`L.or#` (limb (BU.unsafeIndex bs 27) `L.shl#` 32#)
`L.or#` (limb (BU.unsafeIndex bs 28) `L.shl#` 24#)
`L.or#` (limb (BU.unsafeIndex bs 29) `L.shl#` 16#)
`L.or#` (limb (BU.unsafeIndex bs 30) `L.shl#` 08#)
`L.or#` (limb (BU.unsafeIndex bs 31))
{-# INLINABLE unsafe_word3 #-}
-- 256-bit big-endian bytestring decoding. the input size is not checked!
unsafe_roll32 :: BS.ByteString -> Wider
unsafe_roll32 bs =
let !w0 = unsafe_word0 bs
!w1 = unsafe_word1 bs
!w2 = unsafe_word2 bs
!w3 = unsafe_word3 bs
in Wider (# w3, w2, w1, w0 #)
{-# INLINABLE unsafe_roll32 #-}
-- arbitrary-size big-endian bytestring decoding
roll32 :: BS.ByteString -> Maybe Wider
roll32 bs
| BS.length stripped > 32 = Nothing
| otherwise = Just $! BS.foldl' alg 0 stripped
where
stripped = BS.dropWhile (== 0) bs
alg !a (word8_to_wider -> !b) = (a `W.shl_limb` 8) `W.or` b
{-# INLINABLE roll32 #-}
-- 256-bit big-endian bytestring encoding
unroll32 :: Wider -> BS.ByteString
unroll32 (Wider (# w0, w1, w2, w3 #)) =
BI.unsafeCreate 32 $ \ptr -> do
-- w0
Storable.pokeByteOff ptr 00 (word8s w3 56#)
Storable.pokeByteOff ptr 01 (word8s w3 48#)
Storable.pokeByteOff ptr 02 (word8s w3 40#)
Storable.pokeByteOff ptr 03 (word8s w3 32#)
Storable.pokeByteOff ptr 04 (word8s w3 24#)
Storable.pokeByteOff ptr 05 (word8s w3 16#)
Storable.pokeByteOff ptr 06 (word8s w3 08#)
Storable.pokeByteOff ptr 07 (word8 w3)
-- w1
Storable.pokeByteOff ptr 08 (word8s w2 56#)
Storable.pokeByteOff ptr 09 (word8s w2 48#)
Storable.pokeByteOff ptr 10 (word8s w2 40#)
Storable.pokeByteOff ptr 11 (word8s w2 32#)
Storable.pokeByteOff ptr 12 (word8s w2 24#)
Storable.pokeByteOff ptr 13 (word8s w2 16#)
Storable.pokeByteOff ptr 14 (word8s w2 08#)
Storable.pokeByteOff ptr 15 (word8 w2)
-- w2
Storable.pokeByteOff ptr 16 (word8s w1 56#)
Storable.pokeByteOff ptr 17 (word8s w1 48#)
Storable.pokeByteOff ptr 18 (word8s w1 40#)
Storable.pokeByteOff ptr 19 (word8s w1 32#)
Storable.pokeByteOff ptr 20 (word8s w1 24#)
Storable.pokeByteOff ptr 21 (word8s w1 16#)
Storable.pokeByteOff ptr 22 (word8s w1 08#)
Storable.pokeByteOff ptr 23 (word8 w1)
-- w3
Storable.pokeByteOff ptr 24 (word8s w0 56#)
Storable.pokeByteOff ptr 25 (word8s w0 48#)
Storable.pokeByteOff ptr 26 (word8s w0 40#)
Storable.pokeByteOff ptr 27 (word8s w0 32#)
Storable.pokeByteOff ptr 28 (word8s w0 24#)
Storable.pokeByteOff ptr 29 (word8s w0 16#)
Storable.pokeByteOff ptr 30 (word8s w0 08#)
Storable.pokeByteOff ptr 31 (word8 w0)
{-# INLINABLE unroll32 #-}
-- cheeky montgomery-assisted modQ
modQ :: Wider -> Wider
modQ = S.from . S.to
{-# INLINABLE modQ #-}
-- bytewise xor
xor :: BS.ByteString -> BS.ByteString -> BS.ByteString
xor = BS.packZipWith B.xor
{-# INLINABLE xor #-}
-- constants ------------------------------------------------------------------
-- | secp256k1 field prime.
_CURVE_P :: Wider
_CURVE_P = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2F
-- | secp256k1 group order.
_CURVE_Q :: Wider
_CURVE_Q = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141
-- | half of the secp256k1 group order.
_CURVE_QH :: Wider
_CURVE_QH = 0x7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF5D576E7357A4501DDFE92F46681B20A0
-- bitlength of group order
--
-- = smallest integer such that _CURVE_Q < 2 ^ _CURVE_Q_BITS
_CURVE_Q_BITS :: Int
_CURVE_Q_BITS = 256
-- bytelength of _CURVE_Q
--
-- = _CURVE_Q_BITS / 8
_CURVE_Q_BYTES :: Int
_CURVE_Q_BYTES = 32
-- secp256k1 weierstrass form, /b/ coefficient
_CURVE_B :: Wider
_CURVE_B = 7
-- secp256k1 weierstrass form, /b/ coefficient, montgomery form
_CURVE_Bm :: C.Montgomery
_CURVE_Bm = 7
-- _CURVE_Bm * 3
_CURVE_Bm3 :: C.Montgomery
_CURVE_Bm3 = 21
-- Is field element?
fe :: Wider -> Bool
fe n = n > 0 && n < _CURVE_P
{-# INLINE fe #-}
-- Is group element?
ge :: Wider -> Bool
ge (Wider n) = CT.decide (ge# n)
{-# INLINE ge #-}
-- curve points ---------------------------------------------------------------
-- curve point, affine coordinates
data Affine = Affine !C.Montgomery !C.Montgomery
deriving stock (Show, Generic)
-- curve point, projective coordinates
data Projective = Projective {
px :: !C.Montgomery
, py :: !C.Montgomery
, pz :: !C.Montgomery
}
deriving stock (Show, Generic)
instance Eq Projective where
Projective ax ay az == Projective bx by bz =
let !x1z2 = ax * bz
!x2z1 = bx * az
!y1z2 = ay * bz
!y2z1 = by * az
in CT.decide (CT.and# (C.eq x1z2 x2z1) (C.eq y1z2 y2z1))
-- | An ECC-flavoured alias for a secp256k1 point.
type Pub = Projective
-- Convert to affine coordinates.
affine :: Projective -> Affine
affine (Projective x y z) =
let !iz = C.inv z
in Affine (x * iz) (y * iz)
{-# INLINABLE affine #-}
-- Convert to projective coordinates.
projective :: Affine -> Projective
projective = \case
Affine 0 0 -> _CURVE_ZERO
Affine x y -> Projective x y 1
-- | secp256k1 generator point.
_CURVE_G :: Projective
_CURVE_G = Projective x y z where
!x = C.Montgomery
(# Limb 15507633332195041431##, Limb 2530505477788034779##
, Limb 10925531211367256732##, Limb 11061375339145502536## #)
!y = C.Montgomery
(# Limb 12780836216951778274##, Limb 10231155108014310989##
, Limb 8121878653926228278##, Limb 14933801261141951190## #)
!z = C.Montgomery
(# Limb 0x1000003D1##, Limb 0##, Limb 0##, Limb 0## #)
-- | secp256k1 zero point, point at infinity, or monoidal identity.
_CURVE_ZERO :: Projective
_CURVE_ZERO = Projective 0 1 0
-- secp256k1 zero point, point at infinity, or monoidal identity
_ZERO :: Projective
_ZERO = Projective 0 1 0
{-# DEPRECATED _ZERO "use _CURVE_ZERO instead" #-}
-- secp256k1 in short weierstrass form (y ^ 2 = x ^ 3 + 7)
weierstrass :: C.Montgomery -> C.Montgomery
weierstrass x = C.sqr x * x + _CURVE_Bm
{-# INLINE weierstrass #-}
-- Point is valid
valid :: Projective -> Bool
valid p = case affine p of
Affine x y
| C.sqr y /= weierstrass x -> False
| otherwise -> True
-- (bip0340) return point with x coordinate == x and with even y coordinate
--
-- conceptually:
-- y ^ 2 = x ^ 3 + 7
-- y = "+-" sqrt (x ^ 3 + 7)
-- (n.b. for solution y, p - y is also a solution)
-- y + (p - y) = p (odd)
-- (n.b. sum is odd, so one of y and p - y must be odd, and the other even)
-- if y even, return (x, y)
-- else, return (x, p - y)
lift_vartime :: C.Montgomery -> Maybe Affine
lift_vartime x = do
let !c = weierstrass x
!y <- C.sqrt c
let !y_e | C.odd y = negate y
| otherwise = y
guard (C.sqr y_e == c)
pure $! Affine x y_e
even_y_vartime :: Projective -> Projective
even_y_vartime p = case affine p of
Affine _ (C.retr -> y)
| CT.decide (W.odd y) -> neg p
| otherwise -> p
-- Constant-time selection of Projective points.
select_proj :: Projective -> Projective -> CT.Choice -> Projective
select_proj (P ax ay az) (P bx by bz) c =
P (W.select# ax bx c) (W.select# ay by c) (W.select# az bz c)
{-# INLINE select_proj #-}
-- unboxed internals ----------------------------------------------------------
-- algo 7, renes et al, 2015
add_proj# :: Proj -> Proj -> Proj
add_proj# (# x1, y1, z1 #) (# x2, y2, z2 #) =
let !(C.Montgomery b3) = _CURVE_Bm3
!t0a = C.mul# x1 x2
!t1a = C.mul# y1 y2
!t2a = C.mul# z1 z2
!t3a = C.add# x1 y1
!t4a = C.add# x2 y2
!t3b = C.mul# t3a t4a
!t4b = C.add# t0a t1a
!t3c = C.sub# t3b t4b
!t4c = C.add# y1 z1
!x3a = C.add# y2 z2
!t4d = C.mul# t4c x3a
!x3b = C.add# t1a t2a
!t4e = C.sub# t4d x3b
!x3c = C.add# x1 z1
!y3a = C.add# x2 z2
!x3d = C.mul# x3c y3a
!y3b = C.add# t0a t2a
!y3c = C.sub# x3d y3b
!x3e = C.add# t0a t0a
!t0b = C.add# x3e t0a
!t2b = C.mul# b3 t2a
!z3a = C.add# t1a t2b
!t1b = C.sub# t1a t2b
!y3d = C.mul# b3 y3c
!x3f = C.mul# t4e y3d
!t2c = C.mul# t3c t1b
!x3g = C.sub# t2c x3f
!y3e = C.mul# y3d t0b
!t1c = C.mul# t1b z3a
!y3f = C.add# t1c y3e
!t0c = C.mul# t0b t3c
!z3b = C.mul# z3a t4e
!z3c = C.add# z3b t0c
in (# x3g, y3f, z3c #)
{-# INLINE add_proj# #-}
-- algo 8, renes et al, 2015
add_mixed# :: Proj -> Proj -> Proj
add_mixed# (# x1, y1, z1 #) (# x2, y2, _z2 #) =
let !(C.Montgomery b3) = _CURVE_Bm3
!t0a = C.mul# x1 x2
!t1a = C.mul# y1 y2
!t3a = C.add# x2 y2
!t4a = C.add# x1 y1
!t3b = C.mul# t3a t4a
!t4b = C.add# t0a t1a
!t3c = C.sub# t3b t4b
!t4c = C.mul# y2 z1
!t4d = C.add# t4c y1
!y3a = C.mul# x2 z1
!y3b = C.add# y3a x1
!x3a = C.add# t0a t0a
!t0b = C.add# x3a t0a
!t2a = C.mul# b3 z1
!z3a = C.add# t1a t2a
!t1b = C.sub# t1a t2a
!y3c = C.mul# b3 y3b
!x3b = C.mul# t4d y3c
!t2b = C.mul# t3c t1b
!x3c = C.sub# t2b x3b
!y3d = C.mul# y3c t0b
!t1c = C.mul# t1b z3a
!y3e = C.add# t1c y3d
!t0c = C.mul# t0b t3c
!z3b = C.mul# z3a t4d
!z3c = C.add# z3b t0c
in (# x3c, y3e, z3c #)
{-# INLINE add_mixed# #-}
-- algo 9, renes et al, 2015
double# :: Proj -> Proj
double# (# x, y, z #) =
let !(C.Montgomery b3) = _CURVE_Bm3
!t0 = C.sqr# y
!z3a = C.add# t0 t0
!z3b = C.add# z3a z3a
!z3c = C.add# z3b z3b
!t1 = C.mul# y z
!t2a = C.sqr# z
!t2b = C.mul# b3 t2a
!x3a = C.mul# t2b z3c
!y3a = C.add# t0 t2b
!z3d = C.mul# t1 z3c
!t1b = C.add# t2b t2b
!t2c = C.add# t1b t2b
!t0b = C.sub# t0 t2c
!y3b = C.mul# t0b y3a
!y3c = C.add# x3a y3b
!t1c = C.mul# x y
!x3b = C.mul# t0b t1c
!x3c = C.add# x3b x3b
in (# x3c, y3c, z3d #)
{-# INLINE double# #-}
select_proj# :: Proj -> Proj -> CT.Choice -> Proj
select_proj# (# ax, ay, az #) (# bx, by, bz #) c =
(# W.select# ax bx c, W.select# ay by c, W.select# az bz c #)
{-# INLINE select_proj# #-}
neg# :: Proj -> Proj
neg# (# x, y, z #) = (# x, C.neg# y, z #)
{-# INLINE neg# #-}
mul# :: Proj -> Limb4 -> (# () | Proj #)
mul# (# px, py, pz #) s
| CT.decide (CT.not# (ge# s)) = (# () | #)
| otherwise =
let !(P gx gy gz) = _CURVE_G
!(C.Montgomery o) = C.one
in loop (0 :: Int) (# Z, o, Z #) (# gx, gy, gz #) (# px, py, pz #) s
where
loop !j !a !f !d !_SECRET
| j == _CURVE_Q_BITS = (# | a #)
| otherwise =
let !nd = double# d
!(# nm, lsb_set #) = W.shr1_c# _SECRET
!nacc = select_proj# a (add_proj# a d) lsb_set
!nf = select_proj# (add_proj# f d) f lsb_set
in loop (succ j) nacc nf nd nm
{-# INLINE mul# #-}
ge# :: Limb4 -> CT.Choice
ge# n =
let !(Wider q) = _CURVE_Q
in CT.and# (W.gt# n Z) (W.lt# n q)
{-# INLINE ge# #-}
mul_wnaf# :: ByteArray -> Int -> Limb4 -> (# () | Proj #)
mul_wnaf# ctxArray ctxW ls
| CT.decide (CT.not# (ge# ls)) = (# () | #)
| otherwise =
let !(P zx zy zz) = _CURVE_ZERO
!(P gx gy gz) = _CURVE_G
in (# | loop 0 (# zx, zy, zz #) (# gx, gy, gz #) ls #)
where
!one = (# Limb 1##, Limb 0##, Limb 0##, Limb 0## #)
!wins = fi (256 `quot` ctxW + 1)
!size@(GHC.Word.W# s) = 2 ^ (ctxW - 1)
!(GHC.Word.W# mask) = 2 ^ ctxW - 1
!(GHC.Word.W# texW) = fi ctxW
!(GHC.Word.W# mnum) = 2 ^ ctxW
loop !j@(GHC.Word.W# w) !acc !f !n@(# Limb lo, _, _, _ #)
| j == wins = acc
| otherwise =
let !(GHC.Word.W# off0) = j * size
!b0 = Exts.and# lo mask
!bor = CT.from_word_gt# b0 s
!(# n0, _ #) = W.shr_limb# n (Exts.word2Int# texW)
!n0_plus_1 = W.add_w# n0 one
!n1 = W.select# n0 n0_plus_1 bor
!abs_b = CT.select_word# b0 (Exts.minusWord# mnum b0) bor
!is_zero = CT.from_word_eq# b0 0##
!c0 = CT.from_word# (Exts.and# w 1##)
!off_nz = Exts.minusWord# (Exts.plusWord# off0 abs_b) 1##
!off = CT.select_word# off0 off_nz (CT.not# is_zero)
!pr = index_proj# ctxArray (Exts.word2Int# off)
!neg_pr = neg# pr
!pt_zero = select_proj# pr neg_pr c0
!pt_nonzero = select_proj# pr neg_pr bor
!f_added = add_proj# f pt_zero
!acc_added = add_proj# acc pt_nonzero
!nacc = select_proj# acc_added acc is_zero
!nf = select_proj# f f_added is_zero
in loop (succ j) nacc nf n1
{-# INLINE mul_wnaf# #-}
-- retrieve a point (as an unboxed tuple) from a context array
index_proj# :: ByteArray -> Exts.Int# -> Proj
index_proj# (ByteArray arr#) i# =
let !base# = i# Exts.*# 12#
!x = (# Limb (Exts.indexWordArray# arr# base#)
, Limb (Exts.indexWordArray# arr# (base# Exts.+# 01#))
, Limb (Exts.indexWordArray# arr# (base# Exts.+# 02#))
, Limb (Exts.indexWordArray# arr# (base# Exts.+# 03#)) #)
!y = (# Limb (Exts.indexWordArray# arr# (base# Exts.+# 04#))
, Limb (Exts.indexWordArray# arr# (base# Exts.+# 05#))
, Limb (Exts.indexWordArray# arr# (base# Exts.+# 06#))
, Limb (Exts.indexWordArray# arr# (base# Exts.+# 07#)) #)
!z = (# Limb (Exts.indexWordArray# arr# (base# Exts.+# 08#))
, Limb (Exts.indexWordArray# arr# (base# Exts.+# 09#))
, Limb (Exts.indexWordArray# arr# (base# Exts.+# 10#))
, Limb (Exts.indexWordArray# arr# (base# Exts.+# 11#)) #)
in (# x, y, z #)
{-# INLINE index_proj# #-}
-- ec arithmetic --------------------------------------------------------------
-- Negate secp256k1 point.
neg :: Projective -> Projective
neg (P x y z) =
let !(# px, py, pz #) = neg# (# x, y, z #)
in P px py pz
{-# INLINABLE neg #-}
-- Elliptic curve addition on secp256k1.
add :: Projective -> Projective -> Projective
add p q = add_proj p q
{-# INLINABLE add #-}
-- algo 7, "complete addition formulas for prime order elliptic curves,"
-- renes et al, 2015
--
-- https://eprint.iacr.org/2015/1060.pdf
add_proj :: Projective -> Projective -> Projective
add_proj (P ax ay az) (P bx by bz) =
let !(# x, y, z #) = add_proj# (# ax, ay, az #) (# bx, by, bz #)
in P x y z
{-# INLINABLE add_proj #-}
-- algo 8, renes et al, 2015
add_mixed :: Projective -> Projective -> Projective
add_mixed (P ax ay az) (P bx by bz) =
let !(# x, y, z #) = add_mixed# (# ax, ay, az #) (# bx, by, bz #)
in P x y z
{-# INLINABLE add_mixed #-}
-- algo 9, renes et al, 2015
double :: Projective -> Projective
double (Projective (C.Montgomery ax) (C.Montgomery ay) (C.Montgomery az)) =
let !(# x, y, z #) = double# (# ax, ay, az #)
in P x y z
{-# INLINABLE double #-}
-- Timing-safe scalar multiplication of secp256k1 points.
mul :: Projective -> Wider -> Maybe Projective
mul (P x y z) (Wider s) = case mul# (# x, y, z #) s of
(# () | #) -> Nothing
(# | (# px, py, pz #) #) -> Just $! P px py pz
{-# INLINABLE mul #-}
-- Timing-unsafe scalar multiplication of secp256k1 points.
--
-- Don't use this function if the scalar could potentially be a secret.
mul_vartime :: Projective -> Wider -> Maybe Projective
mul_vartime p = \case
Zero -> pure _CURVE_ZERO
n | not (ge n) -> Nothing
| otherwise -> pure $! loop _CURVE_ZERO p n
where
loop !r !d = \case
Zero -> r
m ->
let !nd = double d
!(# nm, lsb_set #) = W.shr1_c m
!nr = if CT.decide lsb_set then add r d else r
in loop nr nd nm
-- | Precomputed multiples of the secp256k1 base or generator point.
data Context = Context {
ctxW :: {-# UNPACK #-} !Int
, ctxArray :: {-# UNPACK #-} !ByteArray
} deriving Generic
instance Show Context where
show Context {} = "<secp256k1 context>"
-- | Create a secp256k1 context by precomputing multiples of the curve's
-- generator point.
--
-- This should be used once to create a 'Context' to be reused
-- repeatedly afterwards.
--
-- >>> let !tex = precompute
-- >>> sign_ecdsa' tex sec msg
-- >>> sign_schnorr' tex sec msg aux
precompute :: Context
precompute = _precompute 8
-- This is a highly-optimized version of a function originally
-- translated from noble-secp256k1's "precompute". Points are stored in
-- a ByteArray by arranging each limb into slices of 12 consecutive
-- slots (each Projective point consists of three Montgomery values,
-- each of which consists of four limbs, summing to twelve limbs in
-- total).
--
-- Each point takes 96 bytes to store in this fashion, so the total size of
-- the ByteArray is (size * 96) bytes.
_precompute :: Int -> Context
_precompute ctxW = Context {..} where
capJ = (2 :: Int) ^ (ctxW - 1)
ws = 256 `quot` ctxW + 1
size = ws * capJ
-- construct the context array
ctxArray = runST $ do
marr <- BA.newByteArray (size * 96)
loop_w marr _CURVE_G 0
BA.unsafeFreezeByteArray marr
-- write a point into the i^th 12-slot slice in the array
write :: MutableByteArray s -> Int -> Projective -> ST s ()
write marr i
(P (# Limb x0, Limb x1, Limb x2, Limb x3 #)
(# Limb y0, Limb y1, Limb y2, Limb y3 #)
(# Limb z0, Limb z1, Limb z2, Limb z3 #)) = do
let !base = i * 12
BA.writeByteArray marr (base + 00) (GHC.Word.W# x0)
BA.writeByteArray marr (base + 01) (GHC.Word.W# x1)
BA.writeByteArray marr (base + 02) (GHC.Word.W# x2)
BA.writeByteArray marr (base + 03) (GHC.Word.W# x3)
BA.writeByteArray marr (base + 04) (GHC.Word.W# y0)
BA.writeByteArray marr (base + 05) (GHC.Word.W# y1)
BA.writeByteArray marr (base + 06) (GHC.Word.W# y2)
BA.writeByteArray marr (base + 07) (GHC.Word.W# y3)
BA.writeByteArray marr (base + 08) (GHC.Word.W# z0)
BA.writeByteArray marr (base + 09) (GHC.Word.W# z1)
BA.writeByteArray marr (base + 10) (GHC.Word.W# z2)
BA.writeByteArray marr (base + 11) (GHC.Word.W# z3)
-- loop over windows
loop_w :: MutableByteArray s -> Projective -> Int -> ST s ()
loop_w !marr !p !w
| w == ws = pure ()
| otherwise = do
nb <- loop_j marr p p (w * capJ) 0
let np = double nb
loop_w marr np (succ w)
-- loop within windows
loop_j
:: MutableByteArray s
-> Projective
-> Projective
-> Int
-> Int
-> ST s Projective
loop_j !marr !p !b !idx !j = do
write marr idx b
if j == capJ - 1
then pure b
else do
let !nb = add b p
loop_j marr p nb (succ idx) (succ j)
-- Timing-safe wNAF (w-ary non-adjacent form) scalar multiplication of
-- secp256k1 points.
mul_wnaf :: Context -> Wider -> Maybe Projective
mul_wnaf Context {..} (Wider s) = case mul_wnaf# ctxArray ctxW s of
(# () | #) -> Nothing
(# | (# px, py, pz #) #) -> Just $! P px py pz
{-# INLINABLE mul_wnaf #-}
-- | Derive a public key (i.e., a secp256k1 point) from the provided
-- secret.
--
-- >>> import qualified System.Entropy as E
-- >>> sk <- fmap parse_int256 (E.getEntropy 32)
-- >>> derive_pub sk
-- Just "<secp256k1 point>"
derive_pub :: Wider -> Maybe Pub
derive_pub = mul _CURVE_G
{-# NOINLINE derive_pub #-}
-- | The same as 'derive_pub', except uses a 'Context' to optimise
-- internal calculations.
--
-- >>> import qualified System.Entropy as E
-- >>> sk <- fmap parse_int256 (E.getEntropy 32)
-- >>> let !tex = precompute
-- >>> derive_pub' tex sk
-- Just "<secp256k1 point>"
derive_pub' :: Context -> Wider -> Maybe Pub
derive_pub' = mul_wnaf
{-# NOINLINE derive_pub' #-}
-- parsing --------------------------------------------------------------------
-- | Parse a 'Wider', /e.g./ a Schnorr or ECDSA secret key.
--
-- >>> import qualified Data.ByteString as BS
-- >>> parse_int256 (BS.replicate 32 0xFF)
-- Just <2^256 - 1>
parse_int256 :: BS.ByteString -> Maybe Wider
parse_int256 bs = do
guard (BS.length bs == 32)
pure $! unsafe_roll32 bs
{-# INLINABLE parse_int256 #-}
-- | Parse compressed secp256k1 point (33 bytes), uncompressed point (65
-- bytes), or BIP0340-style point (32 bytes).
--
-- >>> parse_point <33-byte compressed point>
-- Just <Pub>
-- >>> parse_point <65-byte uncompressed point>
-- Just <Pub>
-- >>> parse_point <32-byte bip0340 public key>
-- Just <Pub>
-- >>> parse_point <anything else>
-- Nothing
parse_point :: BS.ByteString -> Maybe Projective
parse_point bs
| len == 32 = _parse_bip0340 bs
| len == 33 = _parse_compressed h t
| len == 65 = _parse_uncompressed h t
| otherwise = Nothing
where
len = BS.length bs
h = BU.unsafeIndex bs 0 -- lazy
t = BS.drop 1 bs
-- input is guaranteed to be 32B in length
_parse_bip0340 :: BS.ByteString -> Maybe Projective
_parse_bip0340 = fmap projective . lift_vartime . C.to . unsafe_roll32
-- bytestring input is guaranteed to be 32B in length
_parse_compressed :: Word8 -> BS.ByteString -> Maybe Projective
_parse_compressed h (unsafe_roll32 -> x)
| h /= 0x02 && h /= 0x03 = Nothing
| not (fe x) = Nothing
| otherwise = do
let !mx = C.to x
!my <- C.sqrt (weierstrass mx)
let !yodd = CT.decide (W.odd (C.retr my))
!hodd = B.testBit h 0
pure $!
if hodd /= yodd
then Projective mx (negate my) 1
else Projective mx my 1
-- bytestring input is guaranteed to be 64B in length
_parse_uncompressed :: Word8 -> BS.ByteString -> Maybe Projective
_parse_uncompressed h bs = do
let (unsafe_roll32 -> x, unsafe_roll32 -> y) = BS.splitAt _CURVE_Q_BYTES bs
guard (h == 0x04)
let !p = Projective (C.to x) (C.to y) 1
guard (valid p)
pure $! p
-- | Parse an ECDSA signature encoded in 64-byte "compact" form.
--
-- >>> parse_sig <64-byte compact signature>
-- Just "<ecdsa signature>"
parse_sig :: BS.ByteString -> Maybe ECDSA
parse_sig bs = do
guard (BS.length bs == 64)
let (r0, s0) = BS.splitAt 32 bs
r <- roll32 r0
s <- roll32 s0
pure $! ECDSA r s
-- serializing ----------------------------------------------------------------
-- | Serialize a secp256k1 point in 33-byte compressed form.
--
-- >>> serialize_point pub
-- "<33-byte compressed point>"
serialize_point :: Projective -> BS.ByteString
serialize_point (affine -> Affine (C.from -> x) (C.from -> y)) =
let !(Wider (# Limb w, _, _, _ #)) = y
!b | B.testBit (GHC.Word.W# w) 0 = 0x03
| otherwise = 0x02
in BS.cons b (unroll32 x)
-- ecdh -----------------------------------------------------------------------
-- SEC1-v2 3.3.1, plus SHA256 hash
-- | Compute a shared secret, given a secret key and public secp256k1 point,
-- via Elliptic Curve Diffie-Hellman (ECDH).
--
-- The shared secret is the SHA256 hash of the x-coordinate of the
-- point obtained by scalar multiplication.
--
-- >>> let sec_alice = 0x03
-- >>> let sec_bob = 2 ^ 128 - 1
-- >>> let Just pub_alice = derive_pub sec_alice
-- >>> let Just pub_bob = derive_pub sec_bob
-- >>> let secret_as_computed_by_alice = ecdh pub_bob sec_alice
-- >>> let secret_as_computed_by_bob = ecdh pub_alice sec_bob
-- >>> secret_as_computed_by_alice == secret_as_computed_by_bob
-- True
ecdh
:: Projective -- ^ public key
-> Wider -- ^ secret key
-> Maybe BS.ByteString -- ^ shared secret
ecdh pub _SECRET = do
pt@(P _ _ (C.Montgomery -> z)) <- mul pub _SECRET
let !(Affine (C.retr -> x) _) = affine pt
!result = SHA256.hash (unroll32 x)
if CT.decide (C.eq z 0) then Nothing else Just result
-- schnorr --------------------------------------------------------------------
-- see https://github.com/bitcoin/bips/blob/master/bip-0340.mediawiki
-- | Create a 64-byte Schnorr signature for the provided message, using
-- the provided secret key.
--
-- BIP0340 recommends that 32 bytes of fresh auxiliary entropy be
-- generated and added at signing time as additional protection
-- against side-channel attacks (namely, to thwart so-called "fault
-- injection" attacks). This entropy is /supplemental/ to security,
-- and the cryptographic security of the signature scheme itself does
-- not rely on it, so it is not strictly required; 32 zero bytes can
-- be used in its stead (and can be supplied via 'mempty').
--
-- >>> import qualified System.Entropy as E
-- >>> aux <- E.getEntropy 32
-- >>> sign_schnorr sec msg aux
-- Just "<64-byte schnorr signature>"
sign_schnorr
:: Wider -- ^ secret key
-> BS.ByteString -- ^ message
-> BS.ByteString -- ^ 32 bytes of auxilliary random data
-> Maybe BS.ByteString -- ^ 64-byte Schnorr signature
sign_schnorr = _sign_schnorr (mul _CURVE_G)
-- | The same as 'sign_schnorr', except uses a 'Context' to optimise
-- internal calculations.
--
-- You can expect about a 2x performance increase when using this
-- function, compared to 'sign_schnorr'.
--
-- >>> import qualified System.Entropy as E
-- >>> aux <- E.getEntropy 32
-- >>> let !tex = precompute
-- >>> sign_schnorr' tex sec msg aux
-- Just "<64-byte schnorr signature>"
sign_schnorr'
:: Context -- ^ secp256k1 context
-> Wider -- ^ secret key
-> BS.ByteString -- ^ message
-> BS.ByteString -- ^ 32 bytes of auxilliary random data
-> Maybe BS.ByteString -- ^ 64-byte Schnorr signature
sign_schnorr' tex = _sign_schnorr (mul_wnaf tex)
_sign_schnorr
:: (Wider -> Maybe Projective) -- partially-applied multiplication function
-> Wider -- secret key
-> BS.ByteString -- message
-> BS.ByteString -- 32 bytes of auxilliary random data
-> Maybe BS.ByteString
_sign_schnorr _mul _SECRET m a = do
p <- _mul _SECRET
let Affine (C.retr -> x_p) (C.retr -> y_p) = affine p
s = S.to _SECRET
d = S.select s (negate s) (W.odd y_p)
bytes_d = unroll32 (S.retr d)
bytes_p = unroll32 x_p
t = xor bytes_d (hash_aux a)
rand = hash_nonce (t <> bytes_p <> m)
k' = S.to (unsafe_roll32 rand)
guard (k' /= 0) -- negligible probability
pt <- _mul (S.retr k')
let Affine (C.retr -> x_r) (C.retr -> y_r) = affine pt
k = S.select k' (negate k') (W.odd y_r)
bytes_r = unroll32 x_r
rand' = hash_challenge (bytes_r <> bytes_p <> m)
e = S.to (unsafe_roll32 rand')
bytes_ked = unroll32 (S.retr (k + e * d))
sig = bytes_r <> bytes_ked
-- NB for benchmarking we morally want to remove the precautionary
-- verification check here.
--
-- guard (verify_schnorr m p sig)
pure $! sig
{-# INLINE _sign_schnorr #-}
-- | Verify a 64-byte Schnorr signature for the provided message with
-- the supplied public key.
--
-- >>> verify_schnorr msg pub <valid signature>
-- True
-- >>> verify_schnorr msg pub <invalid signature>
-- False
verify_schnorr
:: BS.ByteString -- ^ message
-> Pub -- ^ public key
-> BS.ByteString -- ^ 64-byte Schnorr signature
-> Bool
verify_schnorr = _verify_schnorr (mul_vartime _CURVE_G)
-- | The same as 'verify_schnorr', except uses a 'Context' to optimise
-- internal calculations.
--
-- You can expect about a 1.5x performance increase when using this
-- function, compared to 'verify_schnorr'.
--
-- >>> let !tex = precompute
-- >>> verify_schnorr' tex msg pub <valid signature>
-- True
-- >>> verify_schnorr' tex msg pub <invalid signature>
-- False
verify_schnorr'
:: Context -- ^ secp256k1 context
-> BS.ByteString -- ^ message
-> Pub -- ^ public key
-> BS.ByteString -- ^ 64-byte Schnorr signature
-> Bool
verify_schnorr' tex = _verify_schnorr (mul_wnaf tex)
_verify_schnorr
:: (Wider -> Maybe Projective) -- partially-applied multiplication function
-> BS.ByteString
-> Pub
-> BS.ByteString
-> Bool
_verify_schnorr _mul m p sig
| BS.length sig /= 64 = False
| otherwise = M.isJust $ do
let capP = even_y_vartime p
(unsafe_roll32 -> r, unsafe_roll32 -> s) = BS.splitAt 32 sig
guard (fe r && ge s)
let Affine (C.retr -> x_P) _ = affine capP
e = modQ . unsafe_roll32 $
hash_challenge (unroll32 r <> unroll32 x_P <> m)
pt0 <- _mul s
pt1 <- mul_vartime capP e
let dif = add pt0 (neg pt1)
guard (dif /= _CURVE_ZERO)
let Affine (C.from -> x_R) (C.from -> y_R) = affine dif
guard $ not (CT.decide (W.odd y_R) || x_R /= r) -- XX
{-# INLINE _verify_schnorr #-}
-- hardcoded tag of BIP0340/aux
--
-- \x -> let h = SHA256.hash "BIP0340/aux"
-- in SHA256.hash (h <> h <> x)
hash_aux :: BS.ByteString -> BS.ByteString
hash_aux x = SHA256.hash $
"\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
{-# INLINE hash_aux #-}
-- hardcoded tag of BIP0340/nonce
hash_nonce :: BS.ByteString -> BS.ByteString
hash_nonce x = SHA256.hash $
"\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
{-# INLINE hash_nonce #-}
-- hardcoded tag of BIP0340/challenge
hash_challenge :: BS.ByteString -> BS.ByteString
hash_challenge x = SHA256.hash $
"{\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
{-# INLINE hash_challenge #-}
-- ecdsa ----------------------------------------------------------------------
-- see https://www.rfc-editor.org/rfc/rfc6979, https://secg.org/sec1-v2.pdf
-- RFC6979 2.3.2
bits2int :: BS.ByteString -> Wider
bits2int = unsafe_roll32
{-# INLINABLE bits2int #-}
-- RFC6979 2.3.3
int2octets :: Wider -> BS.ByteString
int2octets = unroll32
{-# INLINABLE int2octets #-}
-- RFC6979 2.3.4
bits2octets :: BS.ByteString -> BS.ByteString
bits2octets bs =
let z1 = bits2int bs
z2 = modQ z1
in int2octets z2
-- | An ECDSA signature.
data ECDSA = ECDSA {
ecdsa_r :: !Wider
, ecdsa_s :: !Wider
}
deriving (Eq, Generic)
instance Show ECDSA where
show _ = "<ecdsa signature>"
-- ECDSA signature type.
data SigType =
LowS
| Unrestricted
deriving Show
-- Indicates whether to hash the message or assume it has already been
-- hashed.
data HashFlag =
Hash
| NoHash
deriving Show
-- Convert an ECDSA signature to low-S form.
low :: ECDSA -> ECDSA
low (ECDSA r s) = ECDSA r (W.select s (_CURVE_Q - s) (W.gt s _CURVE_QH))
{-# INLINE low #-}
-- | Produce an ECDSA signature for the provided message, using the
-- provided private key.
--
-- 'sign_ecdsa' produces a "low-s" signature, as is commonly required
-- in applications using secp256k1. If you need a generic ECDSA
-- signature, use 'sign_ecdsa_unrestricted'.
--
-- >>> sign_ecdsa sec msg
-- Just "<ecdsa signature>"
sign_ecdsa
:: Wider -- ^ secret key
-> BS.ByteString -- ^ message
-> Maybe ECDSA
sign_ecdsa = _sign_ecdsa (mul _CURVE_G) LowS Hash
-- | The same as 'sign_ecdsa', except uses a 'Context' to optimise internal
-- calculations.
--
-- You can expect about a 10x performance increase when using this
-- function, compared to 'sign_ecdsa'.
--
-- >>> let !tex = precompute
-- >>> sign_ecdsa' tex sec msg
-- Just "<ecdsa signature>"
sign_ecdsa'
:: Context -- ^ secp256k1 context
-> Wider -- ^ secret key
-> BS.ByteString -- ^ message
-> Maybe ECDSA
sign_ecdsa' tex = _sign_ecdsa (mul_wnaf tex) LowS Hash
-- | Produce an ECDSA signature for the provided message, using the
-- provided private key.
--
-- 'sign_ecdsa_unrestricted' produces an unrestricted ECDSA signature,
-- which is less common in applications using secp256k1 due to the
-- signature's inherent malleability. If you need a conventional
-- "low-s" signature, use 'sign_ecdsa'.
--
-- >>> sign_ecdsa_unrestricted sec msg
-- Just "<ecdsa signature>"
sign_ecdsa_unrestricted
:: Wider -- ^ secret key
-> BS.ByteString -- ^ message
-> Maybe ECDSA
sign_ecdsa_unrestricted = _sign_ecdsa (mul _CURVE_G) Unrestricted Hash
-- | The same as 'sign_ecdsa_unrestricted', except uses a 'Context' to
-- optimise internal calculations.
--
-- You can expect about a 10x performance increase when using this
-- function, compared to 'sign_ecdsa_unrestricted'.
--
-- >>> let !tex = precompute
-- >>> sign_ecdsa_unrestricted' tex sec msg
-- Just "<ecdsa signature>"
sign_ecdsa_unrestricted'
:: Context -- ^ secp256k1 context
-> Wider -- ^ secret key
-> BS.ByteString -- ^ message
-> Maybe ECDSA
sign_ecdsa_unrestricted' tex = _sign_ecdsa (mul_wnaf tex) Unrestricted Hash
-- Produce a "low-s" ECDSA signature for the provided message, using
-- the provided private key. Assumes that the message has already been
-- pre-hashed.
--
-- (Useful for testing against noble-secp256k1's suite, in which messages
-- in the test vectors have already been hashed.)
_sign_ecdsa_no_hash
:: Wider -- ^ secret key
-> BS.ByteString -- ^ message digest
-> Maybe ECDSA
_sign_ecdsa_no_hash = _sign_ecdsa (mul _CURVE_G) LowS NoHash
_sign_ecdsa_no_hash'
:: Context
-> Wider
-> BS.ByteString
-> Maybe ECDSA
_sign_ecdsa_no_hash' tex = _sign_ecdsa (mul_wnaf tex) LowS NoHash
_sign_ecdsa
:: (Wider -> Maybe Projective) -- partially-applied multiplication function
-> SigType
-> HashFlag
-> Wider
-> BS.ByteString
-> Maybe ECDSA
_sign_ecdsa _mul ty hf _SECRET m = runST $ do
-- RFC6979 sec 3.3a
let entropy = int2octets _SECRET
nonce = bits2octets h
drbg <- DRBG.new SHA256.hmac entropy nonce mempty
-- RFC6979 sec 2.4
sign_loop drbg
where
d = S.to _SECRET
hm = S.to (bits2int h)
h = case hf of
Hash -> SHA256.hash m
NoHash -> m
sign_loop g = do
k <- gen_k g
let mpair = do
kg <- _mul k
let Affine (S.to . C.retr -> r) _ = affine kg
ki = S.inv (S.to k)
s = (hm + d * r) * ki
pure $! (S.retr r, S.retr s)
case mpair of
Nothing -> pure Nothing
Just (r, s)
| r == 0 -> sign_loop g -- negligible probability
| otherwise ->
let !sig = Just $! ECDSA r s
in case ty of
Unrestricted -> pure sig
LowS -> pure (fmap low sig)
{-# INLINE _sign_ecdsa #-}
-- RFC6979 sec 3.3b
gen_k :: DRBG.DRBG s -> ST s Wider
gen_k g = loop g where
loop drbg = do
bytes <- DRBG.gen mempty (fi _CURVE_Q_BYTES) drbg
let can = bits2int bytes
if can >= _CURVE_Q
then loop drbg
else pure can
{-# INLINE gen_k #-}
-- | Verify a "low-s" ECDSA signature for the provided message and
-- public key,
--
-- Fails to verify otherwise-valid "high-s" signatures. If you need to
-- verify generic ECDSA signatures, use 'verify_ecdsa_unrestricted'.
--
-- >>> verify_ecdsa msg pub valid_sig
-- True
-- >>> verify_ecdsa msg pub invalid_sig
-- False
verify_ecdsa
:: BS.ByteString -- ^ message
-> Pub -- ^ public key
-> ECDSA -- ^ signature
-> Bool
verify_ecdsa m p sig@(ECDSA _ s)
| s > _CURVE_QH = False
| otherwise = verify_ecdsa_unrestricted m p sig
-- | The same as 'verify_ecdsa', except uses a 'Context' to optimise
-- internal calculations.
--
-- You can expect about a 2x performance increase when using this
-- function, compared to 'verify_ecdsa'.
--
-- >>> let !tex = precompute
-- >>> verify_ecdsa' tex msg pub valid_sig
-- True
-- >>> verify_ecdsa' tex msg pub invalid_sig
-- False
verify_ecdsa'
:: Context -- ^ secp256k1 context
-> BS.ByteString -- ^ message
-> Pub -- ^ public key
-> ECDSA -- ^ signature
-> Bool
verify_ecdsa' tex m p sig@(ECDSA _ s)
| s > _CURVE_QH = False
| otherwise = verify_ecdsa_unrestricted' tex m p sig
-- | Verify an unrestricted ECDSA signature for the provided message and
-- public key.
--
-- >>> verify_ecdsa_unrestricted msg pub valid_sig
-- True
-- >>> verify_ecdsa_unrestricted msg pub invalid_sig
-- False
verify_ecdsa_unrestricted
:: BS.ByteString -- ^ message
-> Pub -- ^ public key
-> ECDSA -- ^ signature
-> Bool
verify_ecdsa_unrestricted = _verify_ecdsa_unrestricted (mul_vartime _CURVE_G)
-- | The same as 'verify_ecdsa_unrestricted', except uses a 'Context' to
-- optimise internal calculations.
--
-- You can expect about a 2x performance increase when using this
-- function, compared to 'verify_ecdsa_unrestricted'.
--
-- >>> let !tex = precompute
-- >>> verify_ecdsa_unrestricted' tex msg pub valid_sig
-- True
-- >>> verify_ecdsa_unrestricted' tex msg pub invalid_sig
-- False
verify_ecdsa_unrestricted'
:: Context -- ^ secp256k1 context
-> BS.ByteString -- ^ message
-> Pub -- ^ public key
-> ECDSA -- ^ signature
-> Bool
verify_ecdsa_unrestricted' tex = _verify_ecdsa_unrestricted (mul_wnaf tex)
_verify_ecdsa_unrestricted
:: (Wider -> Maybe Projective) -- partially-applied multiplication function
-> BS.ByteString
-> Pub
-> ECDSA
-> Bool
_verify_ecdsa_unrestricted _mul m p (ECDSA r0 s0) = M.isJust $ do
-- SEC1-v2 4.1.4
let h = SHA256.hash m
guard (ge r0 && ge s0)
let r = S.to r0
s = S.to s0
e = S.to (bits2int h)
si = S.inv s
u1 = S.retr (e * si)
u2 = S.retr (r * si)
pt0 <- _mul u1
pt1 <- mul_vartime p u2
let capR = add pt0 pt1
guard (capR /= _CURVE_ZERO)
let Affine (S.to . C.retr -> v) _ = affine capR
guard (v == r)
{-# INLINE _verify_ecdsa_unrestricted #-}