secp256k1

Pure Haskell Schnorr, ECDSA on the elliptic curve secp256k1 (docs.ppad.tech/secp256k1).
git clone git://git.ppad.tech/secp256k1.git
Log | Files | Refs | README | LICENSE

Secp256k1.hs (39253B)


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