{-# 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 #-}