{-# OPTIONS_HADDOCK prune #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UnboxedSums #-}
{-# 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
  , remQ
  , modQ

  -- * secp256k1 points
  , Pub
  , derive_pub
  , derive_pub'
  , _CURVE_G
  , _CURVE_ZERO

  -- * 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
  , double
  , mul
  , mul_unsafe
  , mul_wnaf

  -- Coordinate systems and transformations
  , Affine(..)
  , Projective(..)
  , affine
  , projective
  , valid

  -- for testing/benchmarking
  , _sign_ecdsa_no_hash
  , _sign_ecdsa_no_hash'
  ) where

import Control.Monad (when)
import Control.Monad.ST
import qualified Crypto.DRBG.HMAC as DRBG
import qualified Crypto.Hash.SHA256 as SHA256
import Data.Bits ((.|.))
import qualified Data.Bits as B
import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BU
import qualified Data.Primitive.Array as A
import Data.STRef
import Data.Word (Word8, Word64)
import GHC.Generics
import GHC.Natural
import qualified GHC.Num.Integer as I

-- note the use of GHC.Num.Integer-qualified functions throughout this
-- module; in some cases explicit use of these functions (especially
-- I.integerPowMod# and I.integerRecipMod#) yields tremendous speedups
-- compared to more general versions

-- keystroke savers & other utilities -----------------------------------------

fi :: (Integral a, Num b) => a -> b
fi :: forall a b. (Integral a, Num b) => a -> b
fi = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE fi #-}

-- generic modular exponentiation
-- b ^ e mod m
modexp :: Integer -> Natural -> Natural -> Integer
modexp :: Integer -> Natural -> Natural -> Integer
modexp Integer
b (Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fi -> Integer
e) Natural
m = case Integer -> Integer -> Natural -> (# Natural | () #)
I.integerPowMod# Integer
b Integer
e Natural
m of
  (# Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fi -> Integer
n | #) -> Integer
n
  (# | ()
_ #) -> [Char] -> Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"negative power impossible"
{-# INLINE modexp #-}

-- generic modular inverse
-- for a, m return x such that ax = 1 mod m
modinv :: Integer -> Natural -> Maybe Integer
modinv :: Integer -> Natural -> Maybe Integer
modinv Integer
a Natural
m = case Integer -> Natural -> (# Natural | () #)
I.integerRecipMod# Integer
a Natural
m of
  (# Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fi -> Integer
n | #) -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$! Integer
n
  (# | ()
_ #) -> Maybe Integer
forall a. Maybe a
Nothing
{-# INLINE modinv #-}

-- bytewise xor
xor :: BS.ByteString -> BS.ByteString -> BS.ByteString
xor :: ByteString -> ByteString -> ByteString
xor = (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> ByteString
BS.packZipWith Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
B.xor

-- arbitrary-size big-endian bytestring decoding
roll :: BS.ByteString -> Integer
roll :: ByteString -> Integer
roll = (Integer -> Word8 -> Integer) -> Integer -> ByteString -> Integer
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl' Integer -> Word8 -> Integer
forall {a}. Integral a => Integer -> a -> Integer
alg Integer
0 where
  alg :: Integer -> a -> Integer
alg !Integer
a (a -> Integer
forall a b. (Integral a, Num b) => a -> b
fi -> !Integer
b) = (Integer
a Integer -> Word -> Integer
`I.integerShiftL` Word
8) Integer -> Integer -> Integer
`I.integerOr` Integer
b

-- /Note:/ there can be substantial differences in execution time
-- when this function is called with "extreme" inputs. For example: a
-- bytestring consisting entirely of 0x00 bytes will parse more quickly
-- than one consisting of entirely 0xFF bytes. For appropriately-random
-- inputs, timings should be indistinguishable.
--
-- 256-bit big-endian bytestring decoding. the input size is not checked!
roll32 :: BS.ByteString -> Integer
roll32 :: ByteString -> Integer
roll32 ByteString
bs = Word64 -> Word64 -> Word64 -> Word64 -> Int -> Integer
forall {t} {t} {t} {t} {a}.
(Integral t, Integral t, Integral t, Integral t, Bits a, Bits t,
 Bits t, Bits t, Bits t, Num a) =>
t -> t -> t -> t -> Int -> a
go (Word64
0 :: Word64) (Word64
0 :: Word64) (Word64
0 :: Word64) (Word64
0 :: Word64) Int
0 where
  go :: t -> t -> t -> t -> Int -> a
go !t
acc0 !t
acc1 !t
acc2 !t
acc3 !Int
j
    | Int
j Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32  =
            (t -> a
forall a b. (Integral a, Num b) => a -> b
fi t
acc0 a -> Int -> a
forall a. Bits a => a -> Int -> a
`B.unsafeShiftL` Int
192)
        a -> a -> a
forall a. Bits a => a -> a -> a
.|. (t -> a
forall a b. (Integral a, Num b) => a -> b
fi t
acc1 a -> Int -> a
forall a. Bits a => a -> Int -> a
`B.unsafeShiftL` Int
128)
        a -> a -> a
forall a. Bits a => a -> a -> a
.|. (t -> a
forall a b. (Integral a, Num b) => a -> b
fi t
acc2 a -> Int -> a
forall a. Bits a => a -> Int -> a
`B.unsafeShiftL` Int
64)
        a -> a -> a
forall a. Bits a => a -> a -> a
.|. t -> a
forall a b. (Integral a, Num b) => a -> b
fi t
acc3
    | Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8    =
        let b :: t
b = Word8 -> t
forall a b. (Integral a, Num b) => a -> b
fi (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
j)
        in  t -> t -> t -> t -> Int -> a
go ((t
acc0 t -> Int -> t
forall a. Bits a => a -> Int -> a
`B.unsafeShiftL` Int
8) t -> t -> t
forall a. Bits a => a -> a -> a
.|. t
b) t
acc1 t
acc2 t
acc3 (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    | Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
16   =
        let b :: t
b = Word8 -> t
forall a b. (Integral a, Num b) => a -> b
fi (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
j)
        in t -> t -> t -> t -> Int -> a
go t
acc0 ((t
acc1 t -> Int -> t
forall a. Bits a => a -> Int -> a
`B.unsafeShiftL` Int
8) t -> t -> t
forall a. Bits a => a -> a -> a
.|. t
b) t
acc2 t
acc3 (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    | Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
24   =
        let b :: t
b = Word8 -> t
forall a b. (Integral a, Num b) => a -> b
fi (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
j)
        in t -> t -> t -> t -> Int -> a
go t
acc0 t
acc1 ((t
acc2 t -> Int -> t
forall a. Bits a => a -> Int -> a
`B.unsafeShiftL` Int
8) t -> t -> t
forall a. Bits a => a -> a -> a
.|. t
b) t
acc3 (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    | Bool
otherwise =
        let b :: t
b = Word8 -> t
forall a b. (Integral a, Num b) => a -> b
fi (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
j)
        in t -> t -> t -> t -> Int -> a
go t
acc0 t
acc1 t
acc2 ((t
acc3 t -> Int -> t
forall a. Bits a => a -> Int -> a
`B.unsafeShiftL` Int
8) t -> t -> t
forall a. Bits a => a -> a -> a
.|. t
b) (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINE roll32 #-}

-- this "looks" inefficient due to the call to reverse, but it's
-- actually really fast

-- big-endian bytestring encoding
unroll :: Integer -> BS.ByteString
unroll :: Integer -> ByteString
unroll Integer
i = case Integer
i of
    Integer
0 -> Word8 -> ByteString
BS.singleton Word8
0
    Integer
_ -> ByteString -> ByteString
BS.reverse (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (Integer -> Maybe (Word8, Integer)) -> Integer -> ByteString
forall a. (a -> Maybe (Word8, a)) -> a -> ByteString
BS.unfoldr Integer -> Maybe (Word8, Integer)
forall {a}. Num a => Integer -> Maybe (a, Integer)
step Integer
i
  where
    step :: Integer -> Maybe (a, Integer)
step Integer
0 = Maybe (a, Integer)
forall a. Maybe a
Nothing
    step Integer
m = (a, Integer) -> Maybe (a, Integer)
forall a. a -> Maybe a
Just (Integer -> a
forall a b. (Integral a, Num b) => a -> b
fi Integer
m, Integer
m Integer -> Word -> Integer
`I.integerShiftR` Word
8)

-- big-endian bytestring encoding for 256-bit ints, left-padding with
-- zeros if necessary. the size of the integer is not checked.
unroll32 :: Integer -> BS.ByteString
unroll32 :: Integer -> ByteString
unroll32 (Integer -> ByteString
unroll -> ByteString
u)
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
32 = Int -> Word8 -> ByteString
BS.replicate (Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) Word8
0 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
u
    | Bool
otherwise = ByteString
u
  where
    l :: Int
l = ByteString -> Int
BS.length ByteString
u

-- (bip0340) return point with x coordinate == x and with even y coordinate
lift :: Integer -> Maybe Affine
lift :: Integer -> Maybe Affine
lift Integer
x
  | Bool -> Bool
not (Integer -> Bool
fe Integer
x) = Maybe Affine
forall a. Maybe a
Nothing
  | Bool
otherwise =
      let c :: Integer
c = Integer -> Integer
remP (Integer -> Natural -> Natural -> Integer
modexp Integer
x Natural
3 (Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fi Integer
_CURVE_P) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
7) -- modexp always nonnegative
          e :: Integer
e = (Integer
_CURVE_P Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) Integer -> Integer -> Integer
`I.integerQuot` Integer
4
          y :: Integer
y = Integer -> Natural -> Natural -> Integer
modexp Integer
c (Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fi Integer
e) (Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fi Integer
_CURVE_P)
          y_p :: Integer
y_p | Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
B.testBit Integer
y Int
0 = Integer
_CURVE_P Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
y
              | Bool
otherwise = Integer
y
      in  if   Integer
c Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer -> Natural -> Natural -> Integer
modexp Integer
y Natural
2 (Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fi Integer
_CURVE_P)
          then Maybe Affine
forall a. Maybe a
Nothing
          else Affine -> Maybe Affine
forall a. a -> Maybe a
Just (Affine -> Maybe Affine) -> Affine -> Maybe Affine
forall a b. (a -> b) -> a -> b
$! Integer -> Integer -> Affine
Affine Integer
x Integer
y_p

-- coordinate systems & transformations ---------------------------------------

-- curve point, affine coordinates
data Affine = Affine !Integer !Integer
  deriving stock (Int -> Affine -> ShowS
[Affine] -> ShowS
Affine -> [Char]
(Int -> Affine -> ShowS)
-> (Affine -> [Char]) -> ([Affine] -> ShowS) -> Show Affine
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Affine -> ShowS
showsPrec :: Int -> Affine -> ShowS
$cshow :: Affine -> [Char]
show :: Affine -> [Char]
$cshowList :: [Affine] -> ShowS
showList :: [Affine] -> ShowS
Show, (forall x. Affine -> Rep Affine x)
-> (forall x. Rep Affine x -> Affine) -> Generic Affine
forall x. Rep Affine x -> Affine
forall x. Affine -> Rep Affine x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Affine -> Rep Affine x
from :: forall x. Affine -> Rep Affine x
$cto :: forall x. Rep Affine x -> Affine
to :: forall x. Rep Affine x -> Affine
Generic)

instance Eq Affine where
  Affine Integer
x1 Integer
y1 == :: Affine -> Affine -> Bool
== Affine Integer
x2 Integer
y2 =
    Integer -> Integer
modP Integer
x1 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Integer
modP Integer
x2 Bool -> Bool -> Bool
&& Integer -> Integer
modP Integer
y1 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Integer
modP Integer
y2

-- curve point, projective coordinates
data Projective = Projective {
    Projective -> Integer
px :: !Integer
  , Projective -> Integer
py :: !Integer
  , Projective -> Integer
pz :: !Integer
  }
  deriving stock (Int -> Projective -> ShowS
[Projective] -> ShowS
Projective -> [Char]
(Int -> Projective -> ShowS)
-> (Projective -> [Char])
-> ([Projective] -> ShowS)
-> Show Projective
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Projective -> ShowS
showsPrec :: Int -> Projective -> ShowS
$cshow :: Projective -> [Char]
show :: Projective -> [Char]
$cshowList :: [Projective] -> ShowS
showList :: [Projective] -> ShowS
Show, (forall x. Projective -> Rep Projective x)
-> (forall x. Rep Projective x -> Projective) -> Generic Projective
forall x. Rep Projective x -> Projective
forall x. Projective -> Rep Projective x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Projective -> Rep Projective x
from :: forall x. Projective -> Rep Projective x
$cto :: forall x. Rep Projective x -> Projective
to :: forall x. Rep Projective x -> Projective
Generic)

instance Eq Projective where
  Projective Integer
ax Integer
ay Integer
az == :: Projective -> Projective -> Bool
== Projective Integer
bx Integer
by Integer
bz =
    let x1z2 :: Integer
x1z2 = Integer -> Integer
modP (Integer
ax Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
bz)
        x2z1 :: Integer
x2z1 = Integer -> Integer
modP (Integer
bx Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
az)
        y1z2 :: Integer
y1z2 = Integer -> Integer
modP (Integer
ay Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
bz)
        y2z1 :: Integer
y2z1 = Integer -> Integer
modP (Integer
by Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
az)
    in  Integer
x1z2 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
x2z1 Bool -> Bool -> Bool
&& Integer
y1z2 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
y2z1

-- | A Schnorr and ECDSA-flavoured alias for a secp256k1 point.
type Pub = Projective

-- Convert to affine coordinates.
affine :: Projective -> Affine
affine :: Projective -> Affine
affine p :: Projective
p@(Projective Integer
x Integer
y Integer
z)
  | Projective
p Projective -> Projective -> Bool
forall a. Eq a => a -> a -> Bool
== Projective
_CURVE_ZERO = Integer -> Integer -> Affine
Affine Integer
0 Integer
0
  | Integer
z Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1     = Integer -> Integer -> Affine
Affine Integer
x Integer
y
  | Bool
otherwise  = case Integer -> Natural -> Maybe Integer
modinv Integer
z (Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fi Integer
_CURVE_P) of
      Maybe Integer
Nothing -> [Char] -> Affine
forall a. HasCallStack => [Char] -> a
error [Char]
"ppad-secp256k1 (affine): impossible point"
      Just Integer
iz -> Integer -> Integer -> Affine
Affine (Integer -> Integer
modP (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
iz)) (Integer -> Integer
modP (Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
iz))

-- Convert to projective coordinates.
projective :: Affine -> Projective
projective :: Affine -> Projective
projective (Affine Integer
x Integer
y)
  | Integer
x Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 Bool -> Bool -> Bool
&& Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = Projective
_CURVE_ZERO
  | Bool
otherwise = Integer -> Integer -> Integer -> Projective
Projective Integer
x Integer
y Integer
1

-- Point is valid
valid :: Projective -> Bool
valid :: Projective -> Bool
valid Projective
p = case Projective -> Affine
affine Projective
p of
  Affine Integer
x Integer
y
    | Bool -> Bool
not (Integer -> Bool
fe Integer
x) Bool -> Bool -> Bool
|| Bool -> Bool
not (Integer -> Bool
fe Integer
y) -> Bool
False
    | Integer -> Integer
modP (Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer -> Integer
weierstrass Integer
x -> Bool
False
    | Bool
otherwise -> Bool
True

-- curve parameters -----------------------------------------------------------
-- see https://www.secg.org/sec2-v2.pdf for parameter specs

-- ~ 2^256 - 2^32 - 2^9 - 2^8 - 2^7 - 2^6 - 2^4 - 1

-- | secp256k1 field prime.
_CURVE_P :: Integer
_CURVE_P :: Integer
_CURVE_P = Integer
0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2F

-- | secp256k1 group order.
_CURVE_Q :: Integer
_CURVE_Q :: Integer
_CURVE_Q = Integer
0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141

-- bitlength of group order
--
-- = smallest integer such that _CURVE_Q < 2 ^ _CURVE_Q_BITS
_CURVE_Q_BITS :: Int
_CURVE_Q_BITS :: Int
_CURVE_Q_BITS = Int
256

-- bytelength of _CURVE_Q
--
-- = _CURVE_Q_BITS / 8
_CURVE_Q_BYTES :: Int
_CURVE_Q_BYTES :: Int
_CURVE_Q_BYTES = Int
32

-- secp256k1 short weierstrass form, /a/ coefficient
_CURVE_A :: Integer
_CURVE_A :: Integer
_CURVE_A = Integer
0

-- secp256k1 weierstrass form, /b/ coefficient
_CURVE_B :: Integer
_CURVE_B :: Integer
_CURVE_B = Integer
7

-- ~ parse_point . B16.decode $
--     "0279BE667EF9DCBBAC55A06295CE870B07029BFCDB2DCE28D959F2815B16F81798"

-- | secp256k1 generator point.
_CURVE_G :: Projective
_CURVE_G :: Projective
_CURVE_G = Integer -> Integer -> Integer -> Projective
Projective Integer
x Integer
y Integer
1 where
  x :: Integer
x = Integer
0x79be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798
  y :: Integer
y = Integer
0x483ada7726a3c4655da4fbfc0e1108a8fd17b448a68554199c47d08ffb10d4b8

-- | secp256k1 zero point, point at infinity, or monoidal identity.
_CURVE_ZERO :: Projective
_CURVE_ZERO :: Projective
_CURVE_ZERO = Integer -> Integer -> Integer -> Projective
Projective Integer
0 Integer
1 Integer
0

-- secp256k1 zero point, point at infinity, or monoidal identity
_ZERO :: Projective
_ZERO :: Projective
_ZERO = Integer -> Integer -> Integer -> Projective
Projective Integer
0 Integer
1 Integer
0
{-# DEPRECATED _ZERO "use _CURVE_ZERO instead" #-}

-- secp256k1 in prime order j-invariant 0 form (i.e. a == 0).
weierstrass :: Integer -> Integer
weierstrass :: Integer -> Integer
weierstrass Integer
x = Integer -> Integer
remP (Integer -> Integer
remP (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
_CURVE_B)
{-# INLINE weierstrass #-}

-- field, group operations ----------------------------------------------------

-- Division modulo secp256k1 field prime.
modP :: Integer -> Integer
modP :: Integer -> Integer
modP Integer
a = Integer -> Integer -> Integer
I.integerMod Integer
a Integer
_CURVE_P
{-# INLINE modP #-}

-- Division modulo secp256k1 field prime, when argument is nonnegative.
-- (more efficient than modP)
remP :: Integer -> Integer
remP :: Integer -> Integer
remP Integer
a = Integer -> Integer -> Integer
I.integerRem Integer
a Integer
_CURVE_P
{-# INLINE remP #-}

-- | Division modulo secp256k1 group order.
modQ :: Integer -> Integer
modQ :: Integer -> Integer
modQ Integer
a = Integer -> Integer -> Integer
I.integerMod Integer
a Integer
_CURVE_Q
{-# INLINE modQ #-}

-- | Division modulo secp256k1 group order, when argument is nonnegative.
remQ :: Integer -> Integer
remQ :: Integer -> Integer
remQ Integer
a = Integer -> Integer -> Integer
I.integerRem Integer
a Integer
_CURVE_Q
{-# INLINE remQ #-}

-- Is field element?
fe :: Integer -> Bool
fe :: Integer -> Bool
fe Integer
n = Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
n Bool -> Bool -> Bool
&& Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
_CURVE_P
{-# INLINE fe #-}

-- Is group element?
ge :: Integer -> Bool
ge :: Integer -> Bool
ge Integer
n = Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
n Bool -> Bool -> Bool
&& Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
_CURVE_Q
{-# INLINE ge #-}

-- Square root (Shanks-Tonelli) modulo secp256k1 field prime.
--
-- For a, return x such that a = x x mod _CURVE_P.
modsqrtP :: Integer -> Maybe Integer
modsqrtP :: Integer -> Maybe Integer
modsqrtP Integer
n = (forall s. ST s (Maybe Integer)) -> Maybe Integer
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Maybe Integer)) -> Maybe Integer)
-> (forall s. ST s (Maybe Integer)) -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ do
  STRef s Integer
r   <- Integer -> ST s (STRef s Integer)
forall a s. a -> ST s (STRef s a)
newSTRef Integer
1
  STRef s Integer
num <- Integer -> ST s (STRef s Integer)
forall a s. a -> ST s (STRef s a)
newSTRef Integer
n
  STRef s Integer
e   <- Integer -> ST s (STRef s Integer)
forall a s. a -> ST s (STRef s a)
newSTRef ((Integer
_CURVE_P Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) Integer -> Integer -> Integer
`I.integerQuot` Integer
4)

  let loop :: ST s ()
loop = do
        Integer
ev <- STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
e
        Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
ev Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
          Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer -> Word -> Bool
I.integerTestBit Integer
ev Word
0) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ do
            Integer
numv <- STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
num
            STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
r (\Integer
rv -> Integer -> Integer
remP (Integer
rv Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
numv))
          STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
num (\Integer
numv -> Integer -> Integer
remP (Integer
numv Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
numv))
          STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
e (Integer -> Word -> Integer
`I.integerShiftR` Word
1)
          ST s ()
loop

  ST s ()
loop
  Integer
rv  <- STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
r
  Maybe Integer -> ST s (Maybe Integer)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Integer -> ST s (Maybe Integer))
-> Maybe Integer -> ST s (Maybe Integer)
forall a b. (a -> b) -> a -> b
$
    if   Integer -> Integer
remP (Integer
rv Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
rv) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
n
    then Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$! Integer
rv
    else Maybe Integer
forall a. Maybe a
Nothing

-- ec point operations --------------------------------------------------------

-- Negate secp256k1 point.
neg :: Projective -> Projective
neg :: Projective -> Projective
neg (Projective Integer
x Integer
y Integer
z) = Integer -> Integer -> Integer -> Projective
Projective Integer
x (Integer -> Integer
modP (Integer -> Integer
forall a. Num a => a -> a
negate Integer
y)) Integer
z

-- Elliptic curve addition on secp256k1.
add :: Projective -> Projective -> Projective
add :: Projective -> Projective -> Projective
add Projective
p q :: Projective
q@(Projective Integer
_ Integer
_ Integer
z)
  | Projective
p Projective -> Projective -> Bool
forall a. Eq a => a -> a -> Bool
== Projective
q = Projective -> Projective
double Projective
p        -- algo 9
  | Integer
z Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 = Projective -> Projective -> Projective
add_mixed Projective
p Projective
q   -- algo 8
  | Bool
otherwise = Projective -> Projective -> Projective
add_proj Projective
p Projective
q -- algo 7

-- 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 :: Projective -> Projective -> Projective
add_proj (Projective Integer
x1 Integer
y1 Integer
z1) (Projective Integer
x2 Integer
y2 Integer
z2) = (forall s. ST s Projective) -> Projective
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Projective) -> Projective)
-> (forall s. ST s Projective) -> Projective
forall a b. (a -> b) -> a -> b
$ do
  STRef s Integer
x3 <- Integer -> ST s (STRef s Integer)
forall a s. a -> ST s (STRef s a)
newSTRef Integer
0
  STRef s Integer
y3 <- Integer -> ST s (STRef s Integer)
forall a s. a -> ST s (STRef s a)
newSTRef Integer
0
  STRef s Integer
z3 <- Integer -> ST s (STRef s Integer)
forall a s. a -> ST s (STRef s a)
newSTRef Integer
0
  let b3 :: Integer
b3 = Integer -> Integer
remP (Integer
_CURVE_B Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
3)
  STRef s Integer
t0 <- Integer -> ST s (STRef s Integer)
forall a s. a -> ST s (STRef s a)
newSTRef (Integer -> Integer
modP (Integer
x1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x2)) -- 1
  STRef s Integer
t1 <- Integer -> ST s (STRef s Integer)
forall a s. a -> ST s (STRef s a)
newSTRef (Integer -> Integer
modP (Integer
y1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y2))
  STRef s Integer
t2 <- Integer -> ST s (STRef s Integer)
forall a s. a -> ST s (STRef s a)
newSTRef (Integer -> Integer
modP (Integer
z1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
z2))
  STRef s Integer
t3 <- Integer -> ST s (STRef s Integer)
forall a s. a -> ST s (STRef s a)
newSTRef (Integer -> Integer
modP (Integer
x1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
y1)) -- 4
  STRef s Integer
t4 <- Integer -> ST s (STRef s Integer)
forall a s. a -> ST s (STRef s a)
newSTRef (Integer -> Integer
modP (Integer
x2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
y2))
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t4 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r4 ->
    STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
t3 (\Integer
r3 -> Integer -> Integer
modP (Integer
r3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
r4))
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t0 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r0 ->
    STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t1 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r1 ->
    STRef s Integer -> Integer -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Integer
t4 (Integer -> Integer
modP (Integer
r0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
r1))
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t4 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r4 ->
    STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
t3 (\Integer
r3 -> Integer -> Integer
modP (Integer
r3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
r4)) -- 8
  STRef s Integer -> Integer -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Integer
t4 (Integer -> Integer
modP (Integer
y1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
z1))
  STRef s Integer -> Integer -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Integer
x3 (Integer -> Integer
modP (Integer
y2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
z2))
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
x3 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
rx3 ->
    STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
t4 (\Integer
r4 -> Integer -> Integer
modP (Integer
r4 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
rx3))
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t1 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r1 ->
    STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t2 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r2 ->
    STRef s Integer -> Integer -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Integer
x3 (Integer -> Integer
modP (Integer
r1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
r2)) -- 12
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
x3 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
rx3 ->
    STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
t4 (\Integer
r4 -> Integer -> Integer
modP (Integer
r4 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
rx3))
  STRef s Integer -> Integer -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Integer
x3 (Integer -> Integer
modP (Integer
x1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
z1))
  STRef s Integer -> Integer -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Integer
y3 (Integer -> Integer
modP (Integer
x2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
z2))
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
y3 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
ry3 ->
    STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
x3 (\Integer
rx3 -> Integer -> Integer
modP (Integer
rx3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
ry3)) -- 16
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t0 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r0 ->
    STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t2 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r2 ->
    STRef s Integer -> Integer -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Integer
y3 (Integer -> Integer
modP (Integer
r0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
r2))
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
x3 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
rx3 ->
    STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
y3 (\Integer
ry3 -> Integer -> Integer
modP (Integer
rx3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
ry3))
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t0 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r0 ->
    STRef s Integer -> Integer -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Integer
x3 (Integer -> Integer
modP (Integer
r0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
r0))
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
x3 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
rx3 ->
    STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Integer
t0 (\Integer
r0 -> Integer -> Integer
modP (Integer
rx3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
r0)) -- 20
  STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
t2 (\Integer
r2 -> Integer -> Integer
modP (Integer
b3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
r2))
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t1 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r1 ->
    STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t2 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r2 ->
    STRef s Integer -> Integer -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Integer
z3 (Integer -> Integer
modP (Integer
r1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
r2))
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t2 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r2 ->
    STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
t1 (\Integer
r1 -> Integer -> Integer
modP (Integer
r1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
r2))
  STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
y3 (\Integer
ry3 -> Integer -> Integer
modP (Integer
b3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
ry3)) -- 24
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t4 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r4 ->
    STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
y3 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
ry3 ->
    STRef s Integer -> Integer -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Integer
x3 (Integer -> Integer
modP (Integer
r4 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
ry3))
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t3 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r3 ->
    STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t1 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r1 ->
    STRef s Integer -> Integer -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Integer
t2 (Integer -> Integer
modP (Integer
r3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
r1))
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t2 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r2 ->
    STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
x3 (\Integer
rx3 -> Integer -> Integer
modP (Integer
r2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
rx3))
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t0 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r0 ->
    STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
y3 (\Integer
ry3 -> Integer -> Integer
modP (Integer
ry3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
r0)) -- 28
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
z3 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
rz3 ->
    STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
t1 (\Integer
r1 -> Integer -> Integer
modP (Integer
r1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
rz3))
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t1 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r1 ->
    STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
y3 (\Integer
ry3 -> Integer -> Integer
modP (Integer
r1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
ry3))
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t3 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r3 ->
    STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
t0 (\Integer
r0 -> Integer -> Integer
modP (Integer
r0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
r3))
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t4 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r4 ->
    STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
z3 (\Integer
rz3 -> Integer -> Integer
modP (Integer
rz3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
r4)) -- 32
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t0 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r0 ->
    STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
z3 (\Integer
rz3 -> Integer -> Integer
modP (Integer
rz3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
r0))
  Integer -> Integer -> Integer -> Projective
Projective (Integer -> Integer -> Integer -> Projective)
-> ST s Integer -> ST s (Integer -> Integer -> Projective)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
x3 ST s (Integer -> Integer -> Projective)
-> ST s Integer -> ST s (Integer -> Projective)
forall a b. ST s (a -> b) -> ST s a -> ST s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
y3 ST s (Integer -> Projective) -> ST s Integer -> ST s Projective
forall a b. ST s (a -> b) -> ST s a -> ST s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
z3

-- algo 8, renes et al, 2015
add_mixed :: Projective -> Projective -> Projective
add_mixed :: Projective -> Projective -> Projective
add_mixed (Projective Integer
x1 Integer
y1 Integer
z1) (Projective Integer
x2 Integer
y2 Integer
z2)
  | Integer
z2 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
1   = [Char] -> Projective
forall a. HasCallStack => [Char] -> a
error [Char]
"ppad-secp256k1: internal error"
  | Bool
otherwise = (forall s. ST s Projective) -> Projective
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Projective) -> Projective)
-> (forall s. ST s Projective) -> Projective
forall a b. (a -> b) -> a -> b
$ do
      STRef s Integer
x3 <- Integer -> ST s (STRef s Integer)
forall a s. a -> ST s (STRef s a)
newSTRef Integer
0
      STRef s Integer
y3 <- Integer -> ST s (STRef s Integer)
forall a s. a -> ST s (STRef s a)
newSTRef Integer
0
      STRef s Integer
z3 <- Integer -> ST s (STRef s Integer)
forall a s. a -> ST s (STRef s a)
newSTRef Integer
0
      let b3 :: Integer
b3 = Integer -> Integer
remP (Integer
_CURVE_B Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
3)
      STRef s Integer
t0 <- Integer -> ST s (STRef s Integer)
forall a s. a -> ST s (STRef s a)
newSTRef (Integer -> Integer
modP (Integer
x1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x2)) -- 1
      STRef s Integer
t1 <- Integer -> ST s (STRef s Integer)
forall a s. a -> ST s (STRef s a)
newSTRef (Integer -> Integer
modP (Integer
y1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y2))
      STRef s Integer
t3 <- Integer -> ST s (STRef s Integer)
forall a s. a -> ST s (STRef s a)
newSTRef (Integer -> Integer
modP (Integer
x2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
y2))
      STRef s Integer
t4 <- Integer -> ST s (STRef s Integer)
forall a s. a -> ST s (STRef s a)
newSTRef (Integer -> Integer
modP (Integer
x1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
y1)) -- 4
      STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t4 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r4 ->
        STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
t3 (\Integer
r3 -> Integer -> Integer
modP (Integer
r3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
r4))
      STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t0 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r0 ->
        STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t1 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r1 ->
        STRef s Integer -> Integer -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Integer
t4 (Integer -> Integer
modP (Integer
r0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
r1))
      STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t4 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r4 ->
        STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
t3 (\Integer
r3 -> Integer -> Integer
modP (Integer
r3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
r4)) -- 7
      STRef s Integer -> Integer -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Integer
t4 (Integer -> Integer
modP (Integer
y2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
z1))
      STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
t4 (\Integer
r4 -> Integer -> Integer
modP (Integer
r4 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
y1))
      STRef s Integer -> Integer -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Integer
y3 (Integer -> Integer
modP (Integer
x2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
z1)) -- 10
      STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
y3 (\Integer
ry3 -> Integer -> Integer
modP (Integer
ry3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
x1))
      STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t0 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r0 ->
        STRef s Integer -> Integer -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Integer
x3 (Integer -> Integer
modP (Integer
r0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
r0))
      STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
x3 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
rx3 ->
        STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
t0 (\Integer
r0 -> Integer -> Integer
modP (Integer
rx3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
r0)) -- 13
      STRef s Integer
t2 <- Integer -> ST s (STRef s Integer)
forall a s. a -> ST s (STRef s a)
newSTRef (Integer -> Integer
modP (Integer
b3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
z1))
      STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t1 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r1 ->
        STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t2 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r2 ->
        STRef s Integer -> Integer -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Integer
z3 (Integer -> Integer
modP (Integer
r1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
r2))
      STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t2 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r2 ->
        STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
t1 (\Integer
r1 -> Integer -> Integer
modP (Integer
r1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
r2)) -- 16
      STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
y3 (\Integer
ry3 -> Integer -> Integer
modP (Integer
b3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
ry3))
      STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t4 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r4 ->
        STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
y3 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
ry3 ->
        STRef s Integer -> Integer -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Integer
x3 (Integer -> Integer
modP (Integer
r4 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
ry3))
      STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t3 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r3 ->
        STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t1 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r1 ->
        STRef s Integer -> Integer -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Integer
t2 (Integer -> Integer
modP (Integer
r3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
r1)) -- 19
      STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t2 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r2 ->
        STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
x3 (\Integer
rx3 -> Integer -> Integer
modP (Integer
r2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
rx3))
      STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t0 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r0 ->
        STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
y3 (\Integer
ry3 -> Integer -> Integer
modP (Integer
ry3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
r0))
      STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
z3 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
rz3 ->
        STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
t1 (\Integer
r1 -> Integer -> Integer
modP (Integer
r1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
rz3)) -- 22
      STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t1 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r1 ->
        STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
y3 (\Integer
ry3 -> Integer -> Integer
modP (Integer
r1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
ry3))
      STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t3 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r3 ->
        STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
t0 (\Integer
r0 -> Integer -> Integer
modP (Integer
r0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
r3))
      STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t4 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r4 ->
        STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
z3 (\Integer
rz3 -> Integer -> Integer
modP (Integer
rz3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
r4)) -- 25
      STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t0 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r0 ->
        STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
z3 (\Integer
rz3 -> Integer -> Integer
modP (Integer
rz3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
r0))
      Integer -> Integer -> Integer -> Projective
Projective (Integer -> Integer -> Integer -> Projective)
-> ST s Integer -> ST s (Integer -> Integer -> Projective)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
x3 ST s (Integer -> Integer -> Projective)
-> ST s Integer -> ST s (Integer -> Projective)
forall a b. ST s (a -> b) -> ST s a -> ST s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
y3 ST s (Integer -> Projective) -> ST s Integer -> ST s Projective
forall a b. ST s (a -> b) -> ST s a -> ST s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
z3

-- algo 9, renes et al, 2015
double :: Projective -> Projective
double :: Projective -> Projective
double (Projective Integer
x Integer
y Integer
z) = (forall s. ST s Projective) -> Projective
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Projective) -> Projective)
-> (forall s. ST s Projective) -> Projective
forall a b. (a -> b) -> a -> b
$ do
  STRef s Integer
x3 <- Integer -> ST s (STRef s Integer)
forall a s. a -> ST s (STRef s a)
newSTRef Integer
0
  STRef s Integer
y3 <- Integer -> ST s (STRef s Integer)
forall a s. a -> ST s (STRef s a)
newSTRef Integer
0
  STRef s Integer
z3 <- Integer -> ST s (STRef s Integer)
forall a s. a -> ST s (STRef s a)
newSTRef Integer
0
  let b3 :: Integer
b3 = Integer -> Integer
remP (Integer
_CURVE_B Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
3)
  STRef s Integer
t0 <- Integer -> ST s (STRef s Integer)
forall a s. a -> ST s (STRef s a)
newSTRef (Integer -> Integer
modP (Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y)) -- 1
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t0 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r0 ->
    STRef s Integer -> Integer -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Integer
z3 (Integer -> Integer
modP (Integer
r0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
r0))
  STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
z3 (\Integer
rz3 -> Integer -> Integer
modP (Integer
rz3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
rz3))
  STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
z3 (\Integer
rz3 -> Integer -> Integer
modP (Integer
rz3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
rz3)) -- 4
  STRef s Integer
t1 <- Integer -> ST s (STRef s Integer)
forall a s. a -> ST s (STRef s a)
newSTRef (Integer -> Integer
modP (Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
z))
  STRef s Integer
t2 <- Integer -> ST s (STRef s Integer)
forall a s. a -> ST s (STRef s a)
newSTRef (Integer -> Integer
modP (Integer
z Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
z))
  STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Integer
t2 (\Integer
r2 -> Integer -> Integer
modP (Integer
b3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
r2)) -- 7
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
z3 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
rz3 ->
    STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t2 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r2 ->
    STRef s Integer -> Integer -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Integer
x3 (Integer -> Integer
modP (Integer
r2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
rz3))
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t0 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r0 ->
    STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t2 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r2 ->
    STRef s Integer -> Integer -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Integer
y3 (Integer -> Integer
modP (Integer
r0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
r2))
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t1 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r1 ->
    STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
z3 (\Integer
rz3 -> Integer -> Integer
modP (Integer
r1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
rz3)) -- 10
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t2 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r2 ->
    STRef s Integer -> Integer -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Integer
t1 (Integer -> Integer
modP (Integer
r2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
r2))
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t1 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r1 ->
    STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
t2 (\Integer
r2 -> Integer -> Integer
modP (Integer
r1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
r2))
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t2 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r2 ->
    STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
t0 (\Integer
r0 -> Integer -> Integer
modP (Integer
r0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
r2)) -- 13
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t0 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r0 ->
    STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
y3 (\Integer
ry3 -> Integer -> Integer
modP (Integer
r0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
ry3))
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
x3 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
rx3 ->
    STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
y3 (\Integer
ry3 -> Integer -> Integer
modP (Integer
rx3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
ry3))
  STRef s Integer -> Integer -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Integer
t1 (Integer -> Integer
modP (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y)) -- 16
  STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t0 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r0 ->
    STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
t1 ST s Integer -> (Integer -> ST s ()) -> ST s ()
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
r1 ->
    STRef s Integer -> Integer -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Integer
x3 (Integer -> Integer
modP (Integer
r0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
r1))
  STRef s Integer -> (Integer -> Integer) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s Integer
x3 (\Integer
rx3 -> Integer -> Integer
modP (Integer
rx3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
rx3))
  Integer -> Integer -> Integer -> Projective
Projective (Integer -> Integer -> Integer -> Projective)
-> ST s Integer -> ST s (Integer -> Integer -> Projective)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
x3 ST s (Integer -> Integer -> Projective)
-> ST s Integer -> ST s (Integer -> Projective)
forall a b. ST s (a -> b) -> ST s a -> ST s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
y3 ST s (Integer -> Projective) -> ST s Integer -> ST s Projective
forall a b. ST s (a -> b) -> ST s a -> ST s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
z3

-- Timing-safe scalar multiplication of secp256k1 points.
mul :: Projective -> Integer -> Projective
mul :: Projective -> Integer -> Projective
mul Projective
p Integer
_SECRET
    | Bool -> Bool
not (Integer -> Bool
ge Integer
_SECRET) = [Char] -> Projective
forall a. HasCallStack => [Char] -> a
error [Char]
"ppad-secp256k1 (mul): scalar not in group"
    | Bool
otherwise  = Int
-> Projective -> Projective -> Projective -> Integer -> Projective
loop (Int
0 :: Int) Projective
_CURVE_ZERO Projective
_CURVE_G Projective
p Integer
_SECRET
  where
    loop :: Int
-> Projective -> Projective -> Projective -> Integer -> Projective
loop !Int
j !Projective
acc !Projective
f !Projective
d !Integer
m
      | Int
j Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
_CURVE_Q_BITS = Projective
acc
      | Bool
otherwise =
          let nd :: Projective
nd = Projective -> Projective
double Projective
d
              nm :: Integer
nm = Integer -> Word -> Integer
I.integerShiftR Integer
m Word
1
          in  if   Integer -> Word -> Bool
I.integerTestBit Integer
m Word
0
              then Int
-> Projective -> Projective -> Projective -> Integer -> Projective
loop (Int -> Int
forall a. Enum a => a -> a
succ Int
j) (Projective -> Projective -> Projective
add Projective
acc Projective
d) Projective
f Projective
nd Integer
nm
              else Int
-> Projective -> Projective -> Projective -> Integer -> Projective
loop (Int -> Int
forall a. Enum a => a -> a
succ Int
j) Projective
acc (Projective -> Projective -> Projective
add Projective
f Projective
d) Projective
nd Integer
nm
{-# INLINE mul #-}

-- Timing-unsafe scalar multiplication of secp256k1 points.
--
-- Don't use this function if the scalar could potentially be a secret.
mul_unsafe :: Projective -> Integer -> Projective
mul_unsafe :: Projective -> Integer -> Projective
mul_unsafe Projective
p Integer
n
    | Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = Projective
_CURVE_ZERO
    | Bool -> Bool
not (Integer -> Bool
ge Integer
n) =
        [Char] -> Projective
forall a. HasCallStack => [Char] -> a
error [Char]
"ppad-secp256k1 (mul_unsafe): scalar not in group"
    | Bool
otherwise  = Projective -> Projective -> Integer -> Projective
loop Projective
_CURVE_ZERO Projective
p Integer
n
  where
    loop :: Projective -> Projective -> Integer -> Projective
loop !Projective
r !Projective
d Integer
m
      | Integer
m Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 = Projective
r
      | Bool
otherwise =
          let nd :: Projective
nd = Projective -> Projective
double Projective
d
              nm :: Integer
nm = Integer -> Word -> Integer
I.integerShiftR Integer
m Word
1
              nr :: Projective
nr = if Integer -> Word -> Bool
I.integerTestBit Integer
m Word
0 then Projective -> Projective -> Projective
add Projective
r Projective
d else Projective
r
          in  Projective -> Projective -> Integer -> Projective
loop Projective
nr Projective
nd Integer
nm

-- | Precomputed multiples of the secp256k1 base or generator point.
data Context = Context {
    Context -> Int
ctxW     :: {-# UNPACK #-} !Int
  , Context -> Array Projective
ctxArray :: !(A.Array Projective)
  } deriving (Context -> Context -> Bool
(Context -> Context -> Bool)
-> (Context -> Context -> Bool) -> Eq Context
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Context -> Context -> Bool
== :: Context -> Context -> Bool
$c/= :: Context -> Context -> Bool
/= :: Context -> Context -> Bool
Eq, (forall x. Context -> Rep Context x)
-> (forall x. Rep Context x -> Context) -> Generic Context
forall x. Rep Context x -> Context
forall x. Context -> Rep Context x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Context -> Rep Context x
from :: forall x. Context -> Rep Context x
$cto :: forall x. Rep Context x -> Context
to :: forall x. Rep Context x -> Context
Generic)

instance Show Context where
  show :: Context -> [Char]
show Context {} = [Char]
"<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 :: Context
precompute = Int -> Context
_precompute Int
8

-- dumb strict pair
data Pair a b = Pair !a !b

-- translation of noble-secp256k1's 'precompute'
_precompute :: Int -> Context
_precompute :: Int -> Context
_precompute Int
ctxW = Context {Int
Array Projective
ctxW :: Int
ctxArray :: Array Projective
ctxW :: Int
ctxArray :: Array Projective
..} where
  ctxArray :: Array Projective
ctxArray = Int -> [Projective] -> Array Projective
forall a. Int -> [a] -> Array a
A.arrayFromListN Int
size ([Projective] -> Projective -> Int -> [Projective]
loop_w [Projective]
forall a. Monoid a => a
mempty Projective
_CURVE_G Int
0)
  capJ :: Int
capJ = (Int
2 :: Int) Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
ctxW Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  ws :: Int
ws = Int
256 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
ctxW Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
  size :: Int
size = Int
ws Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
capJ

  loop_w :: [Projective] -> Projective -> Int -> [Projective]
loop_w ![Projective]
acc !Projective
p !Int
w
    | Int
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ws = [Projective] -> [Projective]
forall a. [a] -> [a]
reverse [Projective]
acc
    | Bool
otherwise =
        let b :: Projective
b = Projective
p
            !(Pair [Projective]
nacc Projective
nb) = Projective
-> [Projective]
-> Projective
-> Int
-> Pair [Projective] Projective
loop_j Projective
p (Projective
b Projective -> [Projective] -> [Projective]
forall a. a -> [a] -> [a]
: [Projective]
acc) Projective
b Int
1
            np :: Projective
np = Projective -> Projective
double Projective
nb
        in  [Projective] -> Projective -> Int -> [Projective]
loop_w [Projective]
nacc Projective
np (Int -> Int
forall a. Enum a => a -> a
succ Int
w)

  loop_j :: Projective
-> [Projective]
-> Projective
-> Int
-> Pair [Projective] Projective
loop_j !Projective
p ![Projective]
acc !Projective
b !Int
j
    | Int
j Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
capJ = [Projective] -> Projective -> Pair [Projective] Projective
forall a b. a -> b -> Pair a b
Pair [Projective]
acc Projective
b
    | Bool
otherwise =
        let nb :: Projective
nb = Projective -> Projective -> Projective
add Projective
b Projective
p
        in  Projective
-> [Projective]
-> Projective
-> Int
-> Pair [Projective] Projective
loop_j Projective
p (Projective
nb Projective -> [Projective] -> [Projective]
forall a. a -> [a] -> [a]
: [Projective]
acc) Projective
nb (Int -> Int
forall a. Enum a => a -> a
succ Int
j)

-- Timing-safe wNAF (w-ary non-adjacent form) scalar multiplication of
-- secp256k1 points.
mul_wnaf :: Context -> Integer -> Projective
mul_wnaf :: Context -> Integer -> Projective
mul_wnaf Context {Int
Array Projective
ctxW :: Context -> Int
ctxArray :: Context -> Array Projective
ctxW :: Int
ctxArray :: Array Projective
..} Integer
_SECRET =
    Int -> Projective -> Projective -> Integer -> Projective
loop Int
0 Projective
_CURVE_ZERO Projective
_CURVE_G Integer
_SECRET
  where
    wins :: Int
wins = Int
256 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
ctxW Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    wsize :: Integer
wsize = Integer
2 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
ctxW Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    mask :: Integer
mask = Integer
2 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
ctxW Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
    mnum :: Integer
mnum = Integer
2 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
ctxW

    loop :: Int -> Projective -> Projective -> Integer -> Projective
loop !Int
w !Projective
acc !Projective
f !Integer
n
      | Int
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
wins = Projective
acc
      | Bool
otherwise =
          let !off0 :: Int
off0 = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fi Integer
wsize

              !b0 :: Integer
b0 = Integer
n Integer -> Integer -> Integer
`I.integerAnd` Integer
mask
              !n0 :: Integer
n0 = Integer
n Integer -> Word -> Integer
`I.integerShiftR` Int -> Word
forall a b. (Integral a, Num b) => a -> b
fi Int
ctxW

              !(Pair Integer
b1 Integer
n1) | Integer
b0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
wsize = Integer -> Integer -> Pair Integer Integer
forall a b. a -> b -> Pair a b
Pair (Integer
b0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
mnum) (Integer
n0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
                            | Bool
otherwise  = Integer -> Integer -> Pair Integer Integer
forall a b. a -> b -> Pair a b
Pair Integer
b0 Integer
n0

              !c0 :: Bool
c0 = Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
B.testBit Int
w Int
0
              !c1 :: Bool
c1 = Integer
b1 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0

              !off1 :: Int
off1 = Int
off0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fi (Integer -> Integer
forall a. Num a => a -> a
abs Integer
b1) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

          in  if   Integer
b1 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
              then let !pr :: Projective
pr = Array Projective -> Int -> Projective
forall a. Array a -> Int -> a
A.indexArray Array Projective
ctxArray Int
off0
                       !pt :: Projective
pt | Bool
c0 = Projective -> Projective
neg Projective
pr
                           | Bool
otherwise = Projective
pr
                   in  Int -> Projective -> Projective -> Integer -> Projective
loop (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Projective
acc (Projective -> Projective -> Projective
add Projective
f Projective
pt) Integer
n1
              else let !pr :: Projective
pr = Array Projective -> Int -> Projective
forall a. Array a -> Int -> a
A.indexArray Array Projective
ctxArray Int
off1
                       !pt :: Projective
pt | Bool
c1 = Projective -> Projective
neg Projective
pr
                           | Bool
otherwise = Projective
pr
                   in  Int -> Projective -> Projective -> Integer -> Projective
loop (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Projective -> Projective -> Projective
add Projective
acc Projective
pt) Projective
f Integer
n1
{-# INLINE 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
--   "<secp256k1 point>"
derive_pub :: Integer -> Pub
derive_pub :: Integer -> Projective
derive_pub Integer
_SECRET
  | Bool -> Bool
not (Integer -> Bool
ge Integer
_SECRET) =
      [Char] -> Projective
forall a. HasCallStack => [Char] -> a
error [Char]
"ppad-secp256k1 (derive_pub): invalid secret key"
  | Bool
otherwise =
      Projective -> Integer -> Projective
mul Projective
_CURVE_G Integer
_SECRET
{-# 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
--   "<secp256k1 point>"
derive_pub' :: Context -> Integer -> Pub
derive_pub' :: Context -> Integer -> Projective
derive_pub' Context
tex Integer
_SECRET
  | Bool -> Bool
not (Integer -> Bool
ge Integer
_SECRET) =
      [Char] -> Projective
forall a. HasCallStack => [Char] -> a
error [Char]
"ppad-secp256k1 (derive_pub): invalid secret key"
  | Bool
otherwise =
      Context -> Integer -> Projective
mul_wnaf Context
tex Integer
_SECRET
{-# NOINLINE derive_pub' #-}

-- parsing --------------------------------------------------------------------

-- | Parse a positive 256-bit 'Integer', /e.g./ a Schnorr or ECDSA
--   secret key.
--
--   >>> import qualified Data.ByteString as BS
--   >>> parse_int256 (BS.replicate 32 0xFF)
--   <2^256 - 1>
parse_int256 :: BS.ByteString -> Integer
parse_int256 :: ByteString -> Integer
parse_int256 ByteString
bs
  | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
32 =
      [Char] -> Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"ppad-secp256k1 (parse_int256): requires exactly 32-byte input"
  | Bool
otherwise = ByteString -> Integer
roll32 ByteString
bs

-- | 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 :: ByteString -> Maybe Projective
parse_point ByteString
bs
    | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32 = ByteString -> Maybe Projective
_parse_bip0340 ByteString
bs
    | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
33 = Word8 -> ByteString -> Maybe Projective
_parse_compressed Word8
h ByteString
t
    | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
65 = Word8 -> ByteString -> Maybe Projective
_parse_uncompressed Word8
h ByteString
t
    | Bool
otherwise = Maybe Projective
forall a. Maybe a
Nothing
  where
    len :: Int
len = ByteString -> Int
BS.length ByteString
bs
    h :: Word8
h = ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
0 -- lazy
    t :: ByteString
t = Int -> ByteString -> ByteString
BS.drop Int
1 ByteString
bs

-- input is guaranteed to be 32B in length
_parse_bip0340 :: BS.ByteString -> Maybe Projective
_parse_bip0340 :: ByteString -> Maybe Projective
_parse_bip0340 = (Affine -> Projective) -> Maybe Affine -> Maybe Projective
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Affine -> Projective
projective (Maybe Affine -> Maybe Projective)
-> (ByteString -> Maybe Affine) -> ByteString -> Maybe Projective
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Maybe Affine
lift (Integer -> Maybe Affine)
-> (ByteString -> Integer) -> ByteString -> Maybe Affine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Integer
roll32

-- bytestring input is guaranteed to be 32B in length
_parse_compressed :: Word8 -> BS.ByteString -> Maybe Projective
_parse_compressed :: Word8 -> ByteString -> Maybe Projective
_parse_compressed Word8
h (ByteString -> Integer
roll32 -> Integer
x)
  | Word8
h Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x02 Bool -> Bool -> Bool
&& Word8
h Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x03 = Maybe Projective
forall a. Maybe a
Nothing
  | Bool -> Bool
not (Integer -> Bool
fe Integer
x) = Maybe Projective
forall a. Maybe a
Nothing
  | Bool
otherwise = do
      Integer
y <- Integer -> Maybe Integer
modsqrtP (Integer -> Integer
weierstrass Integer
x)
      let yodd :: Bool
yodd = Integer -> Word -> Bool
I.integerTestBit Integer
y Word
0
          hodd :: Bool
hodd = Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
B.testBit Word8
h Int
0
      Projective -> Maybe Projective
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Projective -> Maybe Projective) -> Projective -> Maybe Projective
forall a b. (a -> b) -> a -> b
$!
        if   Bool
hodd Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
yodd
        then Integer -> Integer -> Integer -> Projective
Projective Integer
x (Integer -> Integer
modP (Integer -> Integer
forall a. Num a => a -> a
negate Integer
y)) Integer
1
        else Integer -> Integer -> Integer -> Projective
Projective Integer
x Integer
y Integer
1

-- bytestring input is guaranteed to be 64B in length
_parse_uncompressed :: Word8 -> BS.ByteString -> Maybe Projective
_parse_uncompressed :: Word8 -> ByteString -> Maybe Projective
_parse_uncompressed Word8
h (Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
_CURVE_Q_BYTES -> (ByteString -> Integer
roll32 -> Integer
x, ByteString -> Integer
roll32 -> Integer
y))
  | Word8
h Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x04 = Maybe Projective
forall a. Maybe a
Nothing
  | Bool
otherwise =
      let p :: Projective
p = Integer -> Integer -> Integer -> Projective
Projective Integer
x Integer
y Integer
1
      in  if   Projective -> Bool
valid Projective
p
          then Projective -> Maybe Projective
forall a. a -> Maybe a
Just (Projective -> Maybe Projective) -> Projective -> Maybe Projective
forall a b. (a -> b) -> a -> b
$! Projective
p
          else Maybe Projective
forall a. Maybe a
Nothing

-- | Parse an ECDSA signature encoded in 64-byte "compact" form.
--
--   >>> parse_sig <64-byte compact signature>
--   "<ecdsa signature>"
parse_sig :: BS.ByteString -> Maybe ECDSA
parse_sig :: ByteString -> Maybe ECDSA
parse_sig ByteString
bs
  | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
64 = Maybe ECDSA
forall a. Maybe a
Nothing
  | Bool
otherwise = ECDSA -> Maybe ECDSA
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ECDSA -> Maybe ECDSA) -> ECDSA -> Maybe ECDSA
forall a b. (a -> b) -> a -> b
$
      let (ByteString -> Integer
roll -> Integer
r, ByteString -> Integer
roll -> Integer
s) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
32 ByteString
bs
      in  Integer -> Integer -> ECDSA
ECDSA Integer
r Integer
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 :: Projective -> ByteString
serialize_point (Projective -> Affine
affine -> Affine Integer
x Integer
y) = Word8 -> ByteString -> ByteString
BS.cons Word8
b (Integer -> ByteString
unroll32 Integer
x) where
  b :: Word8
b | Integer -> Word -> Bool
I.integerTestBit Integer
y Word
0 = Word8
0x03
    | Bool
otherwise = Word8
0x02

-- 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
--   "<64-byte schnorr signature>"
sign_schnorr
  :: Integer        -- ^ secret key
  -> BS.ByteString  -- ^ message
  -> BS.ByteString  -- ^ 32 bytes of auxilliary random data
  -> BS.ByteString  -- ^ 64-byte Schnorr signature
sign_schnorr :: Integer -> ByteString -> ByteString -> ByteString
sign_schnorr = (Integer -> Projective)
-> Integer -> ByteString -> ByteString -> ByteString
_sign_schnorr (Projective -> Integer -> Projective
mul Projective
_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
--   "<64-byte schnorr signature>"
sign_schnorr'
  :: Context        -- ^ secp256k1 context
  -> Integer        -- ^ secret key
  -> BS.ByteString  -- ^ message
  -> BS.ByteString  -- ^ 32 bytes of auxilliary random data
  -> BS.ByteString  -- ^ 64-byte Schnorr signature
sign_schnorr' :: Context -> Integer -> ByteString -> ByteString -> ByteString
sign_schnorr' Context
tex = (Integer -> Projective)
-> Integer -> ByteString -> ByteString -> ByteString
_sign_schnorr (Context -> Integer -> Projective
mul_wnaf Context
tex)

_sign_schnorr
  :: (Integer -> Projective)  -- partially-applied multiplication function
  -> Integer                  -- secret key
  -> BS.ByteString            -- message
  -> BS.ByteString            -- 32 bytes of auxilliary random data
  -> BS.ByteString
_sign_schnorr :: (Integer -> Projective)
-> Integer -> ByteString -> ByteString -> ByteString
_sign_schnorr Integer -> Projective
_mul Integer
_SECRET ByteString
m ByteString
a
  | Bool -> Bool
not (Integer -> Bool
ge Integer
_SECRET) = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"ppad-secp256k1 (sign_schnorr): invalid secret key"
  | Bool
otherwise  =
      let p_proj :: Projective
p_proj = Integer -> Projective
_mul Integer
_SECRET
          Affine Integer
x_p Integer
y_p = Projective -> Affine
affine Projective
p_proj
          d :: Integer
d | Integer -> Word -> Bool
I.integerTestBit Integer
y_p Word
0 = Integer
_CURVE_Q Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
_SECRET
            | Bool
otherwise = Integer
_SECRET

          bytes_d :: ByteString
bytes_d = Integer -> ByteString
unroll32 Integer
d
          h_a :: ByteString
h_a = ByteString -> ByteString
hash_aux ByteString
a
          t :: ByteString
t = ByteString -> ByteString -> ByteString
xor ByteString
bytes_d ByteString
h_a

          bytes_p :: ByteString
bytes_p = Integer -> ByteString
unroll32 Integer
x_p
          rand :: ByteString
rand = ByteString -> ByteString
hash_nonce (ByteString
t ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bytes_p ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
m)

          k' :: Integer
k' = Integer -> Integer
modQ (ByteString -> Integer
roll32 ByteString
rand)

      in  if   Integer
k' Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 -- negligible probability
          then [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"ppad-secp256k1 (sign_schnorr): invalid k"
          else
            let Affine Integer
x_r Integer
y_r = Projective -> Affine
affine (Integer -> Projective
_mul Integer
k')
                k :: Integer
k | Integer -> Word -> Bool
I.integerTestBit Integer
y_r Word
0 = Integer
_CURVE_Q Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
k'
                  | Bool
otherwise = Integer
k'

                bytes_r :: ByteString
bytes_r = Integer -> ByteString
unroll32 Integer
x_r
                e :: Integer
e = Integer -> Integer
modQ (Integer -> Integer)
-> (ByteString -> Integer) -> ByteString -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Integer
roll32 (ByteString -> Integer)
-> (ByteString -> ByteString) -> ByteString -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
hash_challenge
                  (ByteString -> Integer) -> ByteString -> Integer
forall a b. (a -> b) -> a -> b
$ ByteString
bytes_r ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bytes_p ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
m

                bytes_ked :: ByteString
bytes_ked = Integer -> ByteString
unroll32 (Integer -> Integer
modQ (Integer
k Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
e Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
d))

                sig :: ByteString
sig = ByteString
bytes_r ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bytes_ked

            in  if   ByteString -> Projective -> ByteString -> Bool
verify_schnorr ByteString
m Projective
p_proj ByteString
sig
                then ByteString
sig
                else [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"ppad-secp256k1 (sign_schnorr): invalid signature"
{-# 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 :: ByteString -> Projective -> ByteString -> Bool
verify_schnorr = (Integer -> Projective)
-> ByteString -> Projective -> ByteString -> Bool
_verify_schnorr (Projective -> Integer -> Projective
mul_unsafe Projective
_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' :: Context -> ByteString -> Projective -> ByteString -> Bool
verify_schnorr' Context
tex = (Integer -> Projective)
-> ByteString -> Projective -> ByteString -> Bool
_verify_schnorr (Context -> Integer -> Projective
mul_wnaf Context
tex)

_verify_schnorr
  :: (Integer -> Projective) -- partially-applied multiplication function
  -> BS.ByteString
  -> Pub
  -> BS.ByteString
  -> Bool
_verify_schnorr :: (Integer -> Projective)
-> ByteString -> Projective -> ByteString -> Bool
_verify_schnorr Integer -> Projective
_mul ByteString
m (Projective -> Affine
affine -> Affine Integer
x_p Integer
_) ByteString
sig
  | ByteString -> Int
BS.length ByteString
sig Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
64 = Bool
False
  | Bool
otherwise = case Integer -> Maybe Affine
lift Integer
x_p of
      Maybe Affine
Nothing -> Bool
False
      Just capP :: Affine
capP@(Affine Integer
x_P Integer
_) ->
        let (ByteString -> Integer
roll32 -> Integer
r, ByteString -> Integer
roll32 -> Integer
s) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
32 ByteString
sig
        in  if   Integer
r Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
_CURVE_P Bool -> Bool -> Bool
|| Integer
s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
_CURVE_Q
            then Bool
False
            else let e :: Integer
e = Integer -> Integer
modQ (Integer -> Integer)
-> (ByteString -> Integer) -> ByteString -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Integer
roll32 (ByteString -> Integer) -> ByteString -> Integer
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
hash_challenge
                           (Integer -> ByteString
unroll32 Integer
r ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Integer -> ByteString
unroll32 Integer
x_P ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
m)
                     dif :: Projective
dif = Projective -> Projective -> Projective
add (Integer -> Projective
_mul Integer
s)
                               (Projective -> Projective
neg (Projective -> Integer -> Projective
mul_unsafe (Affine -> Projective
projective Affine
capP) Integer
e))
                 in  if   Projective
dif Projective -> Projective -> Bool
forall a. Eq a => a -> a -> Bool
== Projective
_CURVE_ZERO
                     then Bool
False
                     else let Affine Integer
x_R Integer
y_R = Projective -> Affine
affine Projective
dif
                          in  Bool -> Bool
not (Integer -> Word -> Bool
I.integerTestBit Integer
y_R Word
0 Bool -> Bool -> Bool
|| Integer
x_R Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
r)
{-# 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 :: ByteString -> ByteString
hash_aux ByteString
x = ByteString -> ByteString
SHA256.hash (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
  ByteString
"\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" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
x
{-# INLINE hash_aux #-}

-- hardcoded tag of BIP0340/nonce
hash_nonce :: BS.ByteString -> BS.ByteString
hash_nonce :: ByteString -> ByteString
hash_nonce ByteString
x = ByteString -> ByteString
SHA256.hash (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
  ByteString
"\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/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
x
{-# INLINE hash_nonce #-}

-- hardcoded tag of BIP0340/challenge
hash_challenge :: BS.ByteString -> BS.ByteString
hash_challenge :: ByteString -> ByteString
hash_challenge ByteString
x = ByteString -> ByteString
SHA256.hash (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
  ByteString
"{\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|" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
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 -> Integer
bits2int :: ByteString -> Integer
bits2int ByteString
bs =
  let (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fi -> Word
blen) = ByteString -> Int
BS.length ByteString
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8
      (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fi -> Word
qlen) = Int
_CURVE_Q_BITS
      del :: Word
del = Word
blen Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
qlen
  in  if   Word
del Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
0
      then ByteString -> Integer
roll ByteString
bs Integer -> Word -> Integer
`I.integerShiftR` Word
del
      else ByteString -> Integer
roll ByteString
bs

-- RFC6979 2.3.3
int2octets :: Integer -> BS.ByteString
int2octets :: Integer -> ByteString
int2octets Integer
i = ByteString -> ByteString
pad (Integer -> ByteString
unroll Integer
i) where
  pad :: ByteString -> ByteString
pad ByteString
bs
    | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
_CURVE_Q_BYTES = ByteString -> ByteString
pad (Word8 -> ByteString -> ByteString
BS.cons Word8
0 ByteString
bs)
    | Bool
otherwise = ByteString
bs

-- RFC6979 2.3.4
bits2octets :: BS.ByteString -> BS.ByteString
bits2octets :: ByteString -> ByteString
bits2octets ByteString
bs =
  let z1 :: Integer
z1 = ByteString -> Integer
bits2int ByteString
bs
      z2 :: Integer
z2 = Integer -> Integer
modQ Integer
z1
  in  Integer -> ByteString
int2octets Integer
z2

-- | An ECDSA signature.
data ECDSA = ECDSA {
    ECDSA -> Integer
ecdsa_r :: !Integer
  , ECDSA -> Integer
ecdsa_s :: !Integer
  }
  deriving (ECDSA -> ECDSA -> Bool
(ECDSA -> ECDSA -> Bool) -> (ECDSA -> ECDSA -> Bool) -> Eq ECDSA
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ECDSA -> ECDSA -> Bool
== :: ECDSA -> ECDSA -> Bool
$c/= :: ECDSA -> ECDSA -> Bool
/= :: ECDSA -> ECDSA -> Bool
Eq, (forall x. ECDSA -> Rep ECDSA x)
-> (forall x. Rep ECDSA x -> ECDSA) -> Generic ECDSA
forall x. Rep ECDSA x -> ECDSA
forall x. ECDSA -> Rep ECDSA x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ECDSA -> Rep ECDSA x
from :: forall x. ECDSA -> Rep ECDSA x
$cto :: forall x. Rep ECDSA x -> ECDSA
to :: forall x. Rep ECDSA x -> ECDSA
Generic)

instance Show ECDSA where
  show :: ECDSA -> [Char]
show ECDSA
_ = [Char]
"<ecdsa signature>"

-- ECDSA signature type.
data SigType =
    LowS
  | Unrestricted
  deriving Int -> SigType -> ShowS
[SigType] -> ShowS
SigType -> [Char]
(Int -> SigType -> ShowS)
-> (SigType -> [Char]) -> ([SigType] -> ShowS) -> Show SigType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SigType -> ShowS
showsPrec :: Int -> SigType -> ShowS
$cshow :: SigType -> [Char]
show :: SigType -> [Char]
$cshowList :: [SigType] -> ShowS
showList :: [SigType] -> ShowS
Show

-- Indicates whether to hash the message or assume it has already been
-- hashed.
data HashFlag =
    Hash
  | NoHash
  deriving Int -> HashFlag -> ShowS
[HashFlag] -> ShowS
HashFlag -> [Char]
(Int -> HashFlag -> ShowS)
-> (HashFlag -> [Char]) -> ([HashFlag] -> ShowS) -> Show HashFlag
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HashFlag -> ShowS
showsPrec :: Int -> HashFlag -> ShowS
$cshow :: HashFlag -> [Char]
show :: HashFlag -> [Char]
$cshowList :: [HashFlag] -> ShowS
showList :: [HashFlag] -> ShowS
Show

-- | 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
--   "<ecdsa signature>"
sign_ecdsa
  :: Integer         -- ^ secret key
  -> BS.ByteString   -- ^ message
  -> ECDSA
sign_ecdsa :: Integer -> ByteString -> ECDSA
sign_ecdsa = (Integer -> Projective)
-> SigType -> HashFlag -> Integer -> ByteString -> ECDSA
_sign_ecdsa (Projective -> Integer -> Projective
mul Projective
_CURVE_G) SigType
LowS HashFlag
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
--   "<ecdsa signature>"
sign_ecdsa'
  :: Context         -- ^ secp256k1 context
  -> Integer         -- ^ secret key
  -> BS.ByteString   -- ^ message
  -> ECDSA
sign_ecdsa' :: Context -> Integer -> ByteString -> ECDSA
sign_ecdsa' Context
tex = (Integer -> Projective)
-> SigType -> HashFlag -> Integer -> ByteString -> ECDSA
_sign_ecdsa (Context -> Integer -> Projective
mul_wnaf Context
tex) SigType
LowS HashFlag
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
--   "<ecdsa signature>"
sign_ecdsa_unrestricted
  :: Integer        -- ^ secret key
  -> BS.ByteString  -- ^ message
  -> ECDSA
sign_ecdsa_unrestricted :: Integer -> ByteString -> ECDSA
sign_ecdsa_unrestricted = (Integer -> Projective)
-> SigType -> HashFlag -> Integer -> ByteString -> ECDSA
_sign_ecdsa (Projective -> Integer -> Projective
mul Projective
_CURVE_G) SigType
Unrestricted HashFlag
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
--   "<ecdsa signature>"
sign_ecdsa_unrestricted'
  :: Context        -- ^ secp256k1 context
  -> Integer        -- ^ secret key
  -> BS.ByteString  -- ^ message
  -> ECDSA
sign_ecdsa_unrestricted' :: Context -> Integer -> ByteString -> ECDSA
sign_ecdsa_unrestricted' Context
tex = (Integer -> Projective)
-> SigType -> HashFlag -> Integer -> ByteString -> ECDSA
_sign_ecdsa (Context -> Integer -> Projective
mul_wnaf Context
tex) SigType
Unrestricted HashFlag
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
  :: Integer        -- ^ secret key
  -> BS.ByteString  -- ^ message digest
  -> ECDSA
_sign_ecdsa_no_hash :: Integer -> ByteString -> ECDSA
_sign_ecdsa_no_hash = (Integer -> Projective)
-> SigType -> HashFlag -> Integer -> ByteString -> ECDSA
_sign_ecdsa (Projective -> Integer -> Projective
mul Projective
_CURVE_G) SigType
LowS HashFlag
NoHash

_sign_ecdsa_no_hash'
  :: Context
  -> Integer
  -> BS.ByteString
  -> ECDSA
_sign_ecdsa_no_hash' :: Context -> Integer -> ByteString -> ECDSA
_sign_ecdsa_no_hash' Context
tex = (Integer -> Projective)
-> SigType -> HashFlag -> Integer -> ByteString -> ECDSA
_sign_ecdsa (Context -> Integer -> Projective
mul_wnaf Context
tex) SigType
LowS HashFlag
NoHash

_sign_ecdsa
  :: (Integer -> Projective) -- partially-applied multiplication function
  -> SigType
  -> HashFlag
  -> Integer
  -> BS.ByteString
  -> ECDSA
_sign_ecdsa :: (Integer -> Projective)
-> SigType -> HashFlag -> Integer -> ByteString -> ECDSA
_sign_ecdsa Integer -> Projective
_mul SigType
ty HashFlag
hf Integer
_SECRET ByteString
m
  | Bool -> Bool
not (Integer -> Bool
ge Integer
_SECRET) = [Char] -> ECDSA
forall a. HasCallStack => [Char] -> a
error [Char]
"ppad-secp256k1 (sign_ecdsa): invalid secret key"
  | Bool
otherwise  = (forall s. ST s ECDSA) -> ECDSA
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ECDSA) -> ECDSA)
-> (forall s. ST s ECDSA) -> ECDSA
forall a b. (a -> b) -> a -> b
$ do
      -- RFC6979 sec 3.3a
      let entropy :: ByteString
entropy = Integer -> ByteString
int2octets Integer
_SECRET
          nonce :: ByteString
nonce   = ByteString -> ByteString
bits2octets ByteString
h
      DRBG s
drbg <- (ByteString -> ByteString -> ByteString)
-> ByteString
-> ByteString
-> ByteString
-> ST s (DRBG (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
(ByteString -> ByteString -> ByteString)
-> ByteString -> ByteString -> ByteString -> m (DRBG (PrimState m))
DRBG.new ByteString -> ByteString -> ByteString
SHA256.hmac ByteString
entropy ByteString
nonce ByteString
forall a. Monoid a => a
mempty
      -- RFC6979 sec 2.4
      DRBG s -> ST s ECDSA
forall {s}. DRBG s -> ST s ECDSA
sign_loop DRBG s
drbg
    where
      h :: ByteString
h = case HashFlag
hf of
        HashFlag
Hash -> ByteString -> ByteString
SHA256.hash ByteString
m
        HashFlag
NoHash -> ByteString
m

      h_modQ :: Integer
h_modQ = Integer -> Integer
remQ (ByteString -> Integer
bits2int ByteString
h) -- bits2int yields nonnegative

      sign_loop :: DRBG s -> ST s ECDSA
sign_loop DRBG s
g = do
        Integer
k <- DRBG s -> ST s Integer
forall s. DRBG s -> ST s Integer
gen_k DRBG s
g
        let kg :: Projective
kg = Integer -> Projective
_mul Integer
k
            Affine (Integer -> Integer
modQ -> Integer
r) Integer
_ = Projective -> Affine
affine Projective
kg
            s :: Integer
s = case Integer -> Natural -> Maybe Integer
modinv Integer
k (Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fi Integer
_CURVE_Q) of
              Maybe Integer
Nothing   -> [Char] -> Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"ppad-secp256k1 (sign_ecdsa): bad k value"
              Just Integer
kinv -> Integer -> Integer
remQ (Integer -> Integer
remQ (Integer
h_modQ Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer -> Integer
remQ (Integer
_SECRET Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
r)) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
kinv)
        if   Integer
r Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 -- negligible probability
        then DRBG s -> ST s ECDSA
sign_loop DRBG s
g
        else let !sig :: ECDSA
sig = Integer -> Integer -> ECDSA
ECDSA Integer
r Integer
s
             in  case SigType
ty of
                   SigType
Unrestricted -> ECDSA -> ST s ECDSA
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ECDSA
sig
                   SigType
LowS -> ECDSA -> ST s ECDSA
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ECDSA -> ECDSA
low ECDSA
sig)
{-# INLINE _sign_ecdsa #-}

-- RFC6979 sec 3.3b
gen_k :: DRBG.DRBG s -> ST s Integer
gen_k :: forall s. DRBG s -> ST s Integer
gen_k DRBG s
g = DRBG (PrimState (ST s)) -> ST s Integer
forall {m :: * -> *}.
PrimMonad m =>
DRBG (PrimState m) -> m Integer
loop DRBG s
DRBG (PrimState (ST s))
g where
  loop :: DRBG (PrimState m) -> m Integer
loop DRBG (PrimState m)
drbg = do
    ByteString
bytes <- ByteString -> Word64 -> DRBG (PrimState m) -> m ByteString
forall (m :: * -> *).
PrimMonad m =>
ByteString -> Word64 -> DRBG (PrimState m) -> m ByteString
DRBG.gen ByteString
forall a. Monoid a => a
mempty (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fi Int
_CURVE_Q_BYTES) DRBG (PrimState m)
drbg
    let can :: Integer
can = ByteString -> Integer
bits2int ByteString
bytes
    if   Integer
can Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
_CURVE_Q
    then DRBG (PrimState m) -> m Integer
loop DRBG (PrimState m)
drbg
    else Integer -> m Integer
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
can
{-# INLINE gen_k #-}

-- Convert an ECDSA signature to low-S form.
low :: ECDSA -> ECDSA
low :: ECDSA -> ECDSA
low (ECDSA Integer
r Integer
s) = Integer -> Integer -> ECDSA
ECDSA Integer
r Integer
ms where
  ms :: Integer
ms
    | Integer
s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
B.unsafeShiftR Integer
_CURVE_Q Int
1 = Integer -> Integer
modQ (Integer -> Integer
forall a. Num a => a -> a
negate Integer
s)
    | Bool
otherwise = Integer
s
{-# INLINE low #-}

-- | 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 :: ByteString -> Projective -> ECDSA -> Bool
verify_ecdsa ByteString
m Projective
p sig :: ECDSA
sig@(ECDSA Integer
_ Integer
s)
  | Integer
s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
B.unsafeShiftR Integer
_CURVE_Q Int
1 = Bool
False
  | Bool
otherwise = ByteString -> Projective -> ECDSA -> Bool
verify_ecdsa_unrestricted ByteString
m Projective
p ECDSA
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' :: Context -> ByteString -> Projective -> ECDSA -> Bool
verify_ecdsa' Context
tex ByteString
m Projective
p sig :: ECDSA
sig@(ECDSA Integer
_ Integer
s)
  | Integer
s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
B.unsafeShiftR Integer
_CURVE_Q Int
1 = Bool
False
  | Bool
otherwise = Context -> ByteString -> Projective -> ECDSA -> Bool
verify_ecdsa_unrestricted' Context
tex ByteString
m Projective
p ECDSA
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 :: ByteString -> Projective -> ECDSA -> Bool
verify_ecdsa_unrestricted = (Integer -> Projective)
-> ByteString -> Projective -> ECDSA -> Bool
_verify_ecdsa_unrestricted (Projective -> Integer -> Projective
mul_unsafe Projective
_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' :: Context -> ByteString -> Projective -> ECDSA -> Bool
verify_ecdsa_unrestricted' Context
tex = (Integer -> Projective)
-> ByteString -> Projective -> ECDSA -> Bool
_verify_ecdsa_unrestricted (Context -> Integer -> Projective
mul_wnaf Context
tex)

_verify_ecdsa_unrestricted
  :: (Integer -> Projective) -- partially-applied multiplication function
  -> BS.ByteString
  -> Pub
  -> ECDSA
  -> Bool
_verify_ecdsa_unrestricted :: (Integer -> Projective)
-> ByteString -> Projective -> ECDSA -> Bool
_verify_ecdsa_unrestricted Integer -> Projective
_mul (ByteString -> ByteString
SHA256.hash -> ByteString
h) Projective
p (ECDSA Integer
r Integer
s)
  -- SEC1-v2 4.1.4
  | Bool -> Bool
not (Integer -> Bool
ge Integer
r) Bool -> Bool -> Bool
|| Bool -> Bool
not (Integer -> Bool
ge Integer
s) = Bool
False
  | Bool
otherwise =
      let e :: Integer
e     = Integer -> Integer
remQ (ByteString -> Integer
bits2int ByteString
h)
          s_inv :: Integer
s_inv = case Integer -> Natural -> Maybe Integer
modinv Integer
s (Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fi Integer
_CURVE_Q) of
            -- 'ge s' assures existence of inverse
            Maybe Integer
Nothing ->
              [Char] -> Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"ppad-secp256k1 (verify_ecdsa_unrestricted): no inverse"
            Just Integer
si -> Integer
si
          u1 :: Integer
u1   = Integer -> Integer
remQ (Integer
e Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
s_inv)
          u2 :: Integer
u2   = Integer -> Integer
remQ (Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
s_inv)
          capR :: Projective
capR = Projective -> Projective -> Projective
add (Integer -> Projective
_mul Integer
u1) (Projective -> Integer -> Projective
mul_unsafe Projective
p Integer
u2)
      in  if   Projective
capR Projective -> Projective -> Bool
forall a. Eq a => a -> a -> Bool
== Projective
_CURVE_ZERO
          then Bool
False
          else let Affine (Integer -> Integer
modQ -> Integer
v) Integer
_ = Projective -> Affine
affine Projective
capR
               in  Integer
v Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
r
{-# INLINE _verify_ecdsa_unrestricted #-}

-- 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                   -- contrived
--   >>> let sec_bob   = 2 ^ 128 - 1            -- contrived
--   >>> let pub_alice = derive_pub sec_alice
--   >>> let 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
  -> Integer       -- ^ secret key
  -> BS.ByteString -- ^ shared secret
ecdh :: Projective -> Integer -> ByteString
ecdh Projective
pub Integer
_SECRET
  | Bool -> Bool
not (Integer -> Bool
ge Integer
_SECRET) = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"ppad-secp256k1 (ecdh): invalid secret key"
  | Bool
otherwise =
      let pt :: Projective
pt = Projective -> Integer -> Projective
mul Projective
pub Integer
_SECRET
      in  if   Projective
pt Projective -> Projective -> Bool
forall a. Eq a => a -> a -> Bool
== Projective
_CURVE_ZERO
          then [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"ppad-secp256k1 (ecdh): invalid public key"
          else let Affine Integer
x Integer
_ = Projective -> Affine
affine Projective
pt
               in  ByteString -> ByteString
SHA256.hash (Integer -> ByteString
unroll32 Integer
x)