{-# OPTIONS_HADDOCK prune #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE ViewPatterns #-}

#include "MachDeps.h"
#if WORD_SIZE_IN_BITS != 64
#error "ppad-secp256k1 requires a 64-bit architecture"
#endif

-- |
-- Module: Crypto.Curve.Secp256k1
-- Copyright: (c) 2024 Jared Tobin
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
-- Pure [BIP0340](https://github.com/bitcoin/bips/blob/master/bip-0340.mediawiki)
-- Schnorr signatures, deterministic
-- [RFC6979](https://www.rfc-editor.org/rfc/rfc6979) ECDSA (with
-- [BIP0146](https://github.com/bitcoin/bips/blob/master/bip-0146.mediawiki)-style
-- "low-S" signatures), and ECDH shared secret computation
--  on the elliptic curve secp256k1.

module Crypto.Curve.Secp256k1 (
  -- * Field and group parameters
    _CURVE_Q
  , _CURVE_P

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

  -- * Parsing
  , parse_int256
  , parse_point
  , parse_sig

  -- * Serializing
  , serialize_point

  -- * ECDH
  , ecdh

  -- * BIP0340 Schnorr signatures
  , sign_schnorr
  , verify_schnorr

  -- * RFC6979 ECDSA
  , ECDSA(..)
  , SigType(..)
  , sign_ecdsa
  , sign_ecdsa_unrestricted
  , verify_ecdsa
  , verify_ecdsa_unrestricted

  -- * Fast variants
  , Context
  , precompute
  , sign_schnorr'
  , verify_schnorr'
  , sign_ecdsa'
  , sign_ecdsa_unrestricted'
  , verify_ecdsa'
  , verify_ecdsa_unrestricted'

  -- Elliptic curve group operations
  , neg
  , add
  , add_mixed
  , add_proj
  , double
  , mul
  , mul_vartime
  , mul_wnaf

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

  -- for testing/benchmarking
  , _precompute
  , _sign_ecdsa_no_hash
  , _sign_ecdsa_no_hash'
  , roll32
  , unsafe_roll32
  , unroll32
  , select_proj
  ) where

import Control.Monad (guard)
import Control.Monad.ST
import qualified Crypto.DRBG.HMAC as DRBG
import qualified Crypto.Hash.SHA256 as SHA256
import qualified Data.Bits as B
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BI
import qualified Data.ByteString.Unsafe as BU
import qualified Data.Choice as CT
import qualified Data.Maybe as M
import Data.Primitive.ByteArray (ByteArray(..), MutableByteArray(..))
import qualified Data.Primitive.ByteArray as BA
import Data.Word (Word8)
import Data.Word.Limb (Limb(..))
import qualified Data.Word.Limb as L
import Data.Word.Wider (Wider(..))
import qualified Data.Word.Wider as W
import qualified Foreign.Storable as Storable (pokeByteOff)
import qualified GHC.Exts as Exts
import GHC.Generics
import qualified GHC.Word (Word(..), Word8(..))
import qualified Numeric.Montgomery.Secp256k1.Curve as C
import qualified Numeric.Montgomery.Secp256k1.Scalar as S
import Prelude hiding (sqrt)

-- convenience synonyms -------------------------------------------------------

-- Unboxed Wider/Montgomery synonym.
type Limb4 = (# Limb, Limb, Limb, Limb #)

-- Unboxed Projective synonym.
type Proj = (# Limb4, Limb4, Limb4 #)

pattern Zero :: Wider
pattern $mZero :: forall {r}. Wider -> ((# #) -> r) -> ((# #) -> r) -> r
$bZero :: Wider
Zero = Wider Z

pattern Z :: Limb4
pattern $mZ :: forall {r}. Limb4 -> ((# #) -> r) -> ((# #) -> r) -> r
$bZ :: (# #) -> Limb4
Z = (# Limb 0##, Limb 0##, Limb 0##, Limb 0## #)

pattern P :: Limb4 -> Limb4 -> Limb4 -> Projective
pattern $mP :: forall {r}.
Projective -> (Limb4 -> Limb4 -> Limb4 -> r) -> ((# #) -> r) -> r
$bP :: Limb4 -> Limb4 -> Limb4 -> Projective
P x y z = Projective (C.Montgomery x) (C.Montgomery y) (C.Montgomery z)
{-# COMPLETE P #-}

-- utilities ------------------------------------------------------------------

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

-- convert a Word8 to a Limb
limb :: Word8 -> Limb
limb :: Word8 -> Limb
limb (GHC.Word.W8# (Word8# -> Word#
Exts.word8ToWord# -> Word#
w)) = Word# -> Limb
Limb Word#
w
{-# INLINABLE limb #-}

-- convert a Limb to a Word8
word8 :: Limb -> Word8
word8 :: Limb -> Word8
word8 (Limb Word#
w) = Word8# -> Word8
GHC.Word.W8# (Word# -> Word8#
Exts.wordToWord8# Word#
w)
{-# INLINABLE word8 #-}

-- convert a Limb to a Word8 after right-shifting
word8s :: Limb -> Exts.Int# -> Word8
word8s :: Limb -> Int# -> Word8
word8s Limb
l Int#
s =
  let !(Limb Word#
w) = Limb -> Int# -> Limb
L.shr# Limb
l Int#
s
  in  Word8# -> Word8
GHC.Word.W8# (Word# -> Word8#
Exts.wordToWord8# Word#
w)
{-# INLINABLE word8s #-}

-- convert a Word8 to a Wider
word8_to_wider :: Word8 -> Wider
word8_to_wider :: Word8 -> Wider
word8_to_wider Word8
w = Limb4 -> Wider
Wider (# Word8 -> Limb
limb Word8
w, Word# -> Limb
Limb Word#
0##, Word# -> Limb
Limb Word#
0##, Word# -> Limb
Limb Word#
0## #)
{-# INLINABLE word8_to_wider #-}

-- unsafely extract the first 64-bit word from a big-endian-encoded bytestring
unsafe_word0 :: BS.ByteString -> Limb
unsafe_word0 :: ByteString -> Limb
unsafe_word0 ByteString
bs =
          (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
00) Limb -> Int# -> Limb
`L.shl#` Int#
56#)
  Limb -> Limb -> Limb
`L.or#` (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
01) Limb -> Int# -> Limb
`L.shl#` Int#
48#)
  Limb -> Limb -> Limb
`L.or#` (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
02) Limb -> Int# -> Limb
`L.shl#` Int#
40#)
  Limb -> Limb -> Limb
`L.or#` (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
03) Limb -> Int# -> Limb
`L.shl#` Int#
32#)
  Limb -> Limb -> Limb
`L.or#` (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
04) Limb -> Int# -> Limb
`L.shl#` Int#
24#)
  Limb -> Limb -> Limb
`L.or#` (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
05) Limb -> Int# -> Limb
`L.shl#` Int#
16#)
  Limb -> Limb -> Limb
`L.or#` (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
06) Limb -> Int# -> Limb
`L.shl#` Int#
08#)
  Limb -> Limb -> Limb
`L.or#` (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
07))
{-# INLINABLE unsafe_word0 #-}

-- unsafely extract the second 64-bit word from a big-endian-encoded bytestring
unsafe_word1 :: BS.ByteString -> Limb
unsafe_word1 :: ByteString -> Limb
unsafe_word1 ByteString
bs =
          (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
08) Limb -> Int# -> Limb
`L.shl#` Int#
56#)
  Limb -> Limb -> Limb
`L.or#` (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
09) Limb -> Int# -> Limb
`L.shl#` Int#
48#)
  Limb -> Limb -> Limb
`L.or#` (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
10) Limb -> Int# -> Limb
`L.shl#` Int#
40#)
  Limb -> Limb -> Limb
`L.or#` (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
11) Limb -> Int# -> Limb
`L.shl#` Int#
32#)
  Limb -> Limb -> Limb
`L.or#` (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
12) Limb -> Int# -> Limb
`L.shl#` Int#
24#)
  Limb -> Limb -> Limb
`L.or#` (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
13) Limb -> Int# -> Limb
`L.shl#` Int#
16#)
  Limb -> Limb -> Limb
`L.or#` (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
14) Limb -> Int# -> Limb
`L.shl#` Int#
08#)
  Limb -> Limb -> Limb
`L.or#` (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
15))
{-# INLINABLE unsafe_word1 #-}

-- unsafely extract the third 64-bit word from a big-endian-encoded bytestring
unsafe_word2 :: BS.ByteString -> Limb
unsafe_word2 :: ByteString -> Limb
unsafe_word2 ByteString
bs =
          (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
16) Limb -> Int# -> Limb
`L.shl#` Int#
56#)
  Limb -> Limb -> Limb
`L.or#` (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
17) Limb -> Int# -> Limb
`L.shl#` Int#
48#)
  Limb -> Limb -> Limb
`L.or#` (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
18) Limb -> Int# -> Limb
`L.shl#` Int#
40#)
  Limb -> Limb -> Limb
`L.or#` (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
19) Limb -> Int# -> Limb
`L.shl#` Int#
32#)
  Limb -> Limb -> Limb
`L.or#` (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
20) Limb -> Int# -> Limb
`L.shl#` Int#
24#)
  Limb -> Limb -> Limb
`L.or#` (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
21) Limb -> Int# -> Limb
`L.shl#` Int#
16#)
  Limb -> Limb -> Limb
`L.or#` (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
22) Limb -> Int# -> Limb
`L.shl#` Int#
08#)
  Limb -> Limb -> Limb
`L.or#` (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
23))
{-# INLINABLE unsafe_word2 #-}

-- unsafely extract the fourth 64-bit word from a big-endian-encoded bytestring
unsafe_word3 :: BS.ByteString -> Limb
unsafe_word3 :: ByteString -> Limb
unsafe_word3 ByteString
bs =
          (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
24) Limb -> Int# -> Limb
`L.shl#` Int#
56#)
  Limb -> Limb -> Limb
`L.or#` (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
25) Limb -> Int# -> Limb
`L.shl#` Int#
48#)
  Limb -> Limb -> Limb
`L.or#` (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
26) Limb -> Int# -> Limb
`L.shl#` Int#
40#)
  Limb -> Limb -> Limb
`L.or#` (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
27) Limb -> Int# -> Limb
`L.shl#` Int#
32#)
  Limb -> Limb -> Limb
`L.or#` (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
28) Limb -> Int# -> Limb
`L.shl#` Int#
24#)
  Limb -> Limb -> Limb
`L.or#` (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
29) Limb -> Int# -> Limb
`L.shl#` Int#
16#)
  Limb -> Limb -> Limb
`L.or#` (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
30) Limb -> Int# -> Limb
`L.shl#` Int#
08#)
  Limb -> Limb -> Limb
`L.or#` (Word8 -> Limb
limb (ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
31))
{-# INLINABLE unsafe_word3 #-}

-- 256-bit big-endian bytestring decoding. the input size is not checked!
unsafe_roll32 :: BS.ByteString -> Wider
unsafe_roll32 :: ByteString -> Wider
unsafe_roll32 ByteString
bs =
  let !w0 :: Limb
w0 = ByteString -> Limb
unsafe_word0 ByteString
bs
      !w1 :: Limb
w1 = ByteString -> Limb
unsafe_word1 ByteString
bs
      !w2 :: Limb
w2 = ByteString -> Limb
unsafe_word2 ByteString
bs
      !w3 :: Limb
w3 = ByteString -> Limb
unsafe_word3 ByteString
bs
  in  Limb4 -> Wider
Wider (# Limb
w3, Limb
w2, Limb
w1, Limb
w0 #)
{-# INLINABLE unsafe_roll32 #-}

-- arbitrary-size big-endian bytestring decoding
roll32 :: BS.ByteString -> Maybe Wider
roll32 :: ByteString -> Maybe Wider
roll32 ByteString
bs
    | ByteString -> Int
BS.length ByteString
stripped Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
32 = Maybe Wider
forall a. Maybe a
Nothing
    | Bool
otherwise = Wider -> Maybe Wider
forall a. a -> Maybe a
Just (Wider -> Maybe Wider) -> Wider -> Maybe Wider
forall a b. (a -> b) -> a -> b
$! (Wider -> Word8 -> Wider) -> Wider -> ByteString -> Wider
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl' Wider -> Word8 -> Wider
alg Wider
0 ByteString
stripped
  where
    stripped :: ByteString
stripped = (Word8 -> Bool) -> ByteString -> ByteString
BS.dropWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) ByteString
bs
    alg :: Wider -> Word8 -> Wider
alg !Wider
a (Word8 -> Wider
word8_to_wider -> !Wider
b) = (Wider
a Wider -> Int -> Wider
`W.shl_limb` Int
8) Wider -> Wider -> Wider
`W.or` Wider
b
{-# INLINABLE roll32 #-}

-- 256-bit big-endian bytestring encoding
unroll32 :: Wider -> BS.ByteString
unroll32 :: Wider -> ByteString
unroll32 (Wider (# Limb
w0, Limb
w1, Limb
w2, Limb
w3 #)) =
  Int -> (Ptr Word8 -> IO ()) -> ByteString
BI.unsafeCreate Int
32 ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
    -- w0
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
00 (Limb -> Int# -> Word8
word8s Limb
w3 Int#
56#)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
01 (Limb -> Int# -> Word8
word8s Limb
w3 Int#
48#)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
02 (Limb -> Int# -> Word8
word8s Limb
w3 Int#
40#)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
03 (Limb -> Int# -> Word8
word8s Limb
w3 Int#
32#)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
04 (Limb -> Int# -> Word8
word8s Limb
w3 Int#
24#)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
05 (Limb -> Int# -> Word8
word8s Limb
w3 Int#
16#)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
06 (Limb -> Int# -> Word8
word8s Limb
w3 Int#
08#)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
07 (Limb -> Word8
word8 Limb
w3)
    -- w1
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
08 (Limb -> Int# -> Word8
word8s Limb
w2 Int#
56#)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
09 (Limb -> Int# -> Word8
word8s Limb
w2 Int#
48#)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
10 (Limb -> Int# -> Word8
word8s Limb
w2 Int#
40#)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
11 (Limb -> Int# -> Word8
word8s Limb
w2 Int#
32#)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
12 (Limb -> Int# -> Word8
word8s Limb
w2 Int#
24#)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
13 (Limb -> Int# -> Word8
word8s Limb
w2 Int#
16#)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
14 (Limb -> Int# -> Word8
word8s Limb
w2 Int#
08#)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
15 (Limb -> Word8
word8 Limb
w2)
    -- w2
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
16 (Limb -> Int# -> Word8
word8s Limb
w1 Int#
56#)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
17 (Limb -> Int# -> Word8
word8s Limb
w1 Int#
48#)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
18 (Limb -> Int# -> Word8
word8s Limb
w1 Int#
40#)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
19 (Limb -> Int# -> Word8
word8s Limb
w1 Int#
32#)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
20 (Limb -> Int# -> Word8
word8s Limb
w1 Int#
24#)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
21 (Limb -> Int# -> Word8
word8s Limb
w1 Int#
16#)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
22 (Limb -> Int# -> Word8
word8s Limb
w1 Int#
08#)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
23 (Limb -> Word8
word8 Limb
w1)
    -- w3
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
24 (Limb -> Int# -> Word8
word8s Limb
w0 Int#
56#)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
25 (Limb -> Int# -> Word8
word8s Limb
w0 Int#
48#)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
26 (Limb -> Int# -> Word8
word8s Limb
w0 Int#
40#)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
27 (Limb -> Int# -> Word8
word8s Limb
w0 Int#
32#)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
28 (Limb -> Int# -> Word8
word8s Limb
w0 Int#
24#)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
29 (Limb -> Int# -> Word8
word8s Limb
w0 Int#
16#)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
30 (Limb -> Int# -> Word8
word8s Limb
w0 Int#
08#)
    Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Storable.pokeByteOff Ptr Word8
ptr Int
31 (Limb -> Word8
word8 Limb
w0)
{-# INLINABLE unroll32 #-}

-- modQ via conditional subtraction
modQ :: Wider -> Wider
modQ :: Wider -> Wider
modQ Wider
x = Wider -> Wider -> Choice -> Wider
W.select Wider
x (Wider
x Wider -> Wider -> Wider
forall a. Num a => a -> a -> a
- Wider
_CURVE_Q) (Choice -> Choice
CT.not (Wider -> Wider -> Choice
W.lt Wider
x Wider
_CURVE_Q))
{-# INLINABLE modQ #-}

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

-- constants ------------------------------------------------------------------

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

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

-- | half of the secp256k1 group order.
_CURVE_QH :: Wider
_CURVE_QH :: Wider
_CURVE_QH = Wider
0x7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF5D576E7357A4501DDFE92F46681B20A0

-- 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 weierstrass form, /b/ coefficient
_CURVE_B :: Wider
_CURVE_B :: Wider
_CURVE_B = Wider
7

-- secp256k1 weierstrass form, /b/ coefficient, montgomery form
_CURVE_Bm :: C.Montgomery
_CURVE_Bm :: Montgomery
_CURVE_Bm = Montgomery
7

-- _CURVE_Bm * 3
_CURVE_Bm3 :: C.Montgomery
_CURVE_Bm3 :: Montgomery
_CURVE_Bm3 = Montgomery
21

-- Is field element?
fe :: Wider -> Bool
fe :: Wider -> Bool
fe Wider
n = case Wider -> Wider -> Ordering
W.cmp_vartime Wider
n Wider
0 of
  Ordering
GT -> case Wider -> Wider -> Ordering
W.cmp_vartime Wider
n Wider
_CURVE_P of
    Ordering
LT -> Bool
True
    Ordering
_  -> Bool
False
  Ordering
_ -> Bool
False
{-# INLINE fe #-}

-- Is group element?
ge :: Wider -> Bool
ge :: Wider -> Bool
ge (Wider Limb4
n) = Choice -> Bool
CT.decide (Limb4 -> Choice
ge# Limb4
n)
{-# INLINE ge #-}

-- curve points ---------------------------------------------------------------

-- curve point, affine coordinates
data Affine = Affine !C.Montgomery !C.Montgomery
  deriving stock (Int -> Affine -> ShowS
[Affine] -> ShowS
Affine -> String
(Int -> Affine -> ShowS)
-> (Affine -> String) -> ([Affine] -> ShowS) -> Show Affine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Affine -> ShowS
showsPrec :: Int -> Affine -> ShowS
$cshow :: Affine -> String
show :: Affine -> String
$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)

-- curve point, projective coordinates
data Projective = Projective {
    Projective -> Montgomery
px :: !C.Montgomery
  , Projective -> Montgomery
py :: !C.Montgomery
  , Projective -> Montgomery
pz :: !C.Montgomery
  }
  deriving stock (Int -> Projective -> ShowS
[Projective] -> ShowS
Projective -> String
(Int -> Projective -> ShowS)
-> (Projective -> String)
-> ([Projective] -> ShowS)
-> Show Projective
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Projective -> ShowS
showsPrec :: Int -> Projective -> ShowS
$cshow :: Projective -> String
show :: Projective -> String
$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 Montgomery
ax Montgomery
ay Montgomery
az == :: Projective -> Projective -> Bool
== Projective Montgomery
bx Montgomery
by Montgomery
bz =
    let !x1z2 :: Montgomery
x1z2 = Montgomery
ax Montgomery -> Montgomery -> Montgomery
forall a. Num a => a -> a -> a
* Montgomery
bz
        !x2z1 :: Montgomery
x2z1 = Montgomery
bx Montgomery -> Montgomery -> Montgomery
forall a. Num a => a -> a -> a
* Montgomery
az
        !y1z2 :: Montgomery
y1z2 = Montgomery
ay Montgomery -> Montgomery -> Montgomery
forall a. Num a => a -> a -> a
* Montgomery
bz
        !y2z1 :: Montgomery
y2z1 = Montgomery
by Montgomery -> Montgomery -> Montgomery
forall a. Num a => a -> a -> a
* Montgomery
az
    in  Choice -> Bool
CT.decide (Choice -> Choice -> Choice
CT.and (Montgomery -> Montgomery -> Choice
C.eq Montgomery
x1z2 Montgomery
x2z1) (Montgomery -> Montgomery -> Choice
C.eq Montgomery
y1z2 Montgomery
y2z1))

-- | An ECC-flavoured alias for a secp256k1 point.
type Pub = Projective

-- Convert to affine coordinates.
affine :: Projective -> Affine
affine :: Projective -> Affine
affine (Projective Montgomery
x Montgomery
y Montgomery
z) =
  let !iz :: Montgomery
iz = Montgomery -> Montgomery
C.inv Montgomery
z
  in  Montgomery -> Montgomery -> Affine
Affine (Montgomery
x Montgomery -> Montgomery -> Montgomery
forall a. Num a => a -> a -> a
* Montgomery
iz) (Montgomery
y Montgomery -> Montgomery -> Montgomery
forall a. Num a => a -> a -> a
* Montgomery
iz)
{-# INLINABLE affine #-}

-- Convert to projective coordinates.
projective :: Affine -> Projective
projective :: Affine -> Projective
projective (Affine Montgomery
x Montgomery
y)
  | Montgomery -> Montgomery -> Bool
C.eq_vartime Montgomery
x Montgomery
0 Bool -> Bool -> Bool
|| Montgomery -> Montgomery -> Bool
C.eq_vartime Montgomery
y Montgomery
0 = Projective
_CURVE_ZERO
  | Bool
otherwise = Montgomery -> Montgomery -> Montgomery -> Projective
Projective Montgomery
x Montgomery
y Montgomery
1

-- | secp256k1 generator point.
_CURVE_G :: Projective
_CURVE_G :: Projective
_CURVE_G = Montgomery -> Montgomery -> Montgomery -> Projective
Projective Montgomery
x Montgomery
y Montgomery
z where
  !x :: Montgomery
x = Limb4 -> Montgomery
C.Montgomery
    (# Word# -> Limb
Limb Word#
15507633332195041431##, Word# -> Limb
Limb  Word#
2530505477788034779##
    ,  Word# -> Limb
Limb Word#
10925531211367256732##, Word# -> Limb
Limb Word#
11061375339145502536## #)
  !y :: Montgomery
y = Limb4 -> Montgomery
C.Montgomery
    (# Word# -> Limb
Limb Word#
12780836216951778274##, Word# -> Limb
Limb Word#
10231155108014310989##
    ,  Word# -> Limb
Limb Word#
8121878653926228278##,  Word# -> Limb
Limb Word#
14933801261141951190## #)
  !z :: Montgomery
z = Limb4 -> Montgomery
C.Montgomery
    (# Word# -> Limb
Limb Word#
0x1000003D1##, Word# -> Limb
Limb Word#
0##, Word# -> Limb
Limb Word#
0##, Word# -> Limb
Limb Word#
0## #)

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

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

-- secp256k1 in short weierstrass form (y ^ 2 = x ^ 3 + 7)
weierstrass :: C.Montgomery -> C.Montgomery
weierstrass :: Montgomery -> Montgomery
weierstrass Montgomery
x = Montgomery -> Montgomery
C.sqr Montgomery
x Montgomery -> Montgomery -> Montgomery
forall a. Num a => a -> a -> a
* Montgomery
x Montgomery -> Montgomery -> Montgomery
forall a. Num a => a -> a -> a
+ Montgomery
_CURVE_Bm
{-# INLINE weierstrass #-}

-- Point is valid
valid :: Projective -> Bool
valid :: Projective -> Bool
valid (Projective -> Affine
affine -> Affine Montgomery
x Montgomery
y) = Montgomery -> Montgomery -> Bool
C.eq_vartime (Montgomery -> Montgomery
C.sqr Montgomery
y) (Montgomery -> Montgomery
weierstrass Montgomery
x)

-- (bip0340) return point with x coordinate == x and with even y coordinate
--
-- conceptually:
--   y ^ 2 = x ^ 3 + 7
--   y     = "+-" sqrt (x ^ 3 + 7)
--     (n.b. for solution y, p - y is also a solution)
--   y + (p - y) = p (odd)
--     (n.b. sum is odd, so one of y and p - y must be odd, and the other even)
--   if y even, return (x, y)
--   else,      return (x, p - y)
lift_vartime :: C.Montgomery -> Maybe Affine
lift_vartime :: Montgomery -> Maybe Affine
lift_vartime Montgomery
x = do
  let !c :: Montgomery
c = Montgomery -> Montgomery
weierstrass Montgomery
x
  !y <- Montgomery -> Maybe Montgomery
C.sqrt_vartime Montgomery
c
  let !y_e | Montgomery -> Bool
C.odd_vartime Montgomery
y = Montgomery -> Montgomery
forall a. Num a => a -> a
negate Montgomery
y
           | Bool
otherwise = Montgomery
y
  pure $! Affine x y_e

even_y_vartime :: Projective -> Projective
even_y_vartime :: Projective -> Projective
even_y_vartime Projective
p = case Projective -> Affine
affine Projective
p of
  Affine Montgomery
_ (Montgomery -> Wider
C.retr -> Wider
y)
    | Choice -> Bool
CT.decide (Wider -> Choice
W.odd Wider
y) -> Projective -> Projective
neg Projective
p
    | Bool
otherwise -> Projective
p

-- Constant-time selection of Projective points.
select_proj :: Projective -> Projective -> CT.Choice -> Projective
select_proj :: Projective -> Projective -> Choice -> Projective
select_proj (Projective Montgomery
ax Montgomery
ay Montgomery
az) (Projective Montgomery
bx Montgomery
by Montgomery
bz) Choice
c =
  Montgomery -> Montgomery -> Montgomery -> Projective
Projective (Montgomery -> Montgomery -> Choice -> Montgomery
C.select Montgomery
ax Montgomery
bx Choice
c) (Montgomery -> Montgomery -> Choice -> Montgomery
C.select Montgomery
ay Montgomery
by Choice
c) (Montgomery -> Montgomery -> Choice -> Montgomery
C.select Montgomery
az Montgomery
bz Choice
c)
{-# INLINE select_proj #-}

-- unboxed internals ----------------------------------------------------------

-- algo 7, renes et al, 2015
add_proj# :: Proj -> Proj -> Proj
add_proj# :: Proj -> Proj -> Proj
add_proj# (# Limb4
x1, Limb4
y1, Limb4
z1 #) (# Limb4
x2, Limb4
y2, Limb4
z2 #) =
  let !(C.Montgomery Limb4
b3) = Montgomery
_CURVE_Bm3
      !t0a :: Limb4
t0a  = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
x1 Limb4
x2
      !t1a :: Limb4
t1a  = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
y1 Limb4
y2
      !t2a :: Limb4
t2a  = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
z1 Limb4
z2
      !t3a :: Limb4
t3a  = Limb4 -> Limb4 -> Limb4
C.add# Limb4
x1 Limb4
y1
      !t4a :: Limb4
t4a  = Limb4 -> Limb4 -> Limb4
C.add# Limb4
x2 Limb4
y2
      !t3b :: Limb4
t3b  = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
t3a Limb4
t4a
      !t4b :: Limb4
t4b  = Limb4 -> Limb4 -> Limb4
C.add# Limb4
t0a Limb4
t1a
      !t3c :: Limb4
t3c  = Limb4 -> Limb4 -> Limb4
C.sub# Limb4
t3b Limb4
t4b
      !t4c :: Limb4
t4c  = Limb4 -> Limb4 -> Limb4
C.add# Limb4
y1 Limb4
z1
      !x3a :: Limb4
x3a  = Limb4 -> Limb4 -> Limb4
C.add# Limb4
y2 Limb4
z2
      !t4d :: Limb4
t4d  = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
t4c Limb4
x3a
      !x3b :: Limb4
x3b  = Limb4 -> Limb4 -> Limb4
C.add# Limb4
t1a Limb4
t2a
      !t4e :: Limb4
t4e  = Limb4 -> Limb4 -> Limb4
C.sub# Limb4
t4d Limb4
x3b
      !x3c :: Limb4
x3c  = Limb4 -> Limb4 -> Limb4
C.add# Limb4
x1 Limb4
z1
      !y3a :: Limb4
y3a  = Limb4 -> Limb4 -> Limb4
C.add# Limb4
x2 Limb4
z2
      !x3d :: Limb4
x3d  = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
x3c Limb4
y3a
      !y3b :: Limb4
y3b  = Limb4 -> Limb4 -> Limb4
C.add# Limb4
t0a Limb4
t2a
      !y3c :: Limb4
y3c  = Limb4 -> Limb4 -> Limb4
C.sub# Limb4
x3d Limb4
y3b
      !x3e :: Limb4
x3e  = Limb4 -> Limb4 -> Limb4
C.add# Limb4
t0a Limb4
t0a
      !t0b :: Limb4
t0b  = Limb4 -> Limb4 -> Limb4
C.add# Limb4
x3e Limb4
t0a
      !t2b :: Limb4
t2b  = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
b3 Limb4
t2a
      !z3a :: Limb4
z3a  = Limb4 -> Limb4 -> Limb4
C.add# Limb4
t1a Limb4
t2b
      !t1b :: Limb4
t1b  = Limb4 -> Limb4 -> Limb4
C.sub# Limb4
t1a Limb4
t2b
      !y3d :: Limb4
y3d  = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
b3 Limb4
y3c
      !x3f :: Limb4
x3f  = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
t4e Limb4
y3d
      !t2c :: Limb4
t2c  = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
t3c Limb4
t1b
      !x3g :: Limb4
x3g  = Limb4 -> Limb4 -> Limb4
C.sub# Limb4
t2c Limb4
x3f
      !y3e :: Limb4
y3e  = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
y3d Limb4
t0b
      !t1c :: Limb4
t1c  = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
t1b Limb4
z3a
      !y3f :: Limb4
y3f  = Limb4 -> Limb4 -> Limb4
C.add# Limb4
t1c Limb4
y3e
      !t0c :: Limb4
t0c  = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
t0b Limb4
t3c
      !z3b :: Limb4
z3b  = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
z3a Limb4
t4e
      !z3c :: Limb4
z3c  = Limb4 -> Limb4 -> Limb4
C.add# Limb4
z3b Limb4
t0c
  in  (# Limb4
x3g, Limb4
y3f, Limb4
z3c #)
{-# INLINE add_proj# #-}

-- algo 8, renes et al, 2015
add_mixed# :: Proj -> Proj -> Proj
add_mixed# :: Proj -> Proj -> Proj
add_mixed# (# Limb4
x1, Limb4
y1, Limb4
z1 #) (# Limb4
x2, Limb4
y2, Limb4
_z2 #) =
  let !(C.Montgomery Limb4
b3) = Montgomery
_CURVE_Bm3
      !t0a :: Limb4
t0a  = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
x1 Limb4
x2
      !t1a :: Limb4
t1a  = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
y1 Limb4
y2
      !t3a :: Limb4
t3a  = Limb4 -> Limb4 -> Limb4
C.add# Limb4
x2 Limb4
y2
      !t4a :: Limb4
t4a  = Limb4 -> Limb4 -> Limb4
C.add# Limb4
x1 Limb4
y1
      !t3b :: Limb4
t3b  = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
t3a Limb4
t4a
      !t4b :: Limb4
t4b  = Limb4 -> Limb4 -> Limb4
C.add# Limb4
t0a Limb4
t1a
      !t3c :: Limb4
t3c  = Limb4 -> Limb4 -> Limb4
C.sub# Limb4
t3b Limb4
t4b
      !t4c :: Limb4
t4c  = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
y2 Limb4
z1
      !t4d :: Limb4
t4d  = Limb4 -> Limb4 -> Limb4
C.add# Limb4
t4c Limb4
y1
      !y3a :: Limb4
y3a  = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
x2 Limb4
z1
      !y3b :: Limb4
y3b  = Limb4 -> Limb4 -> Limb4
C.add# Limb4
y3a Limb4
x1
      !x3a :: Limb4
x3a  = Limb4 -> Limb4 -> Limb4
C.add# Limb4
t0a Limb4
t0a
      !t0b :: Limb4
t0b  = Limb4 -> Limb4 -> Limb4
C.add# Limb4
x3a Limb4
t0a
      !t2a :: Limb4
t2a  = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
b3 Limb4
z1
      !z3a :: Limb4
z3a  = Limb4 -> Limb4 -> Limb4
C.add# Limb4
t1a Limb4
t2a
      !t1b :: Limb4
t1b  = Limb4 -> Limb4 -> Limb4
C.sub# Limb4
t1a Limb4
t2a
      !y3c :: Limb4
y3c  = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
b3 Limb4
y3b
      !x3b :: Limb4
x3b  = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
t4d Limb4
y3c
      !t2b :: Limb4
t2b  = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
t3c Limb4
t1b
      !x3c :: Limb4
x3c  = Limb4 -> Limb4 -> Limb4
C.sub# Limb4
t2b Limb4
x3b
      !y3d :: Limb4
y3d  = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
y3c Limb4
t0b
      !t1c :: Limb4
t1c  = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
t1b Limb4
z3a
      !y3e :: Limb4
y3e  = Limb4 -> Limb4 -> Limb4
C.add# Limb4
t1c Limb4
y3d
      !t0c :: Limb4
t0c  = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
t0b Limb4
t3c
      !z3b :: Limb4
z3b  = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
z3a Limb4
t4d
      !z3c :: Limb4
z3c  = Limb4 -> Limb4 -> Limb4
C.add# Limb4
z3b Limb4
t0c
  in  (# Limb4
x3c, Limb4
y3e, Limb4
z3c #)
{-# INLINE add_mixed# #-}

-- algo 9, renes et al, 2015
double# :: Proj -> Proj
double# :: Proj -> Proj
double# (# Limb4
x, Limb4
y, Limb4
z #) =
  let !(C.Montgomery Limb4
b3) = Montgomery
_CURVE_Bm3
      !t0 :: Limb4
t0  = Limb4 -> Limb4
C.sqr# Limb4
y
      !z3a :: Limb4
z3a = Limb4 -> Limb4 -> Limb4
C.add# Limb4
t0 Limb4
t0
      !z3b :: Limb4
z3b = Limb4 -> Limb4 -> Limb4
C.add# Limb4
z3a Limb4
z3a
      !z3c :: Limb4
z3c = Limb4 -> Limb4 -> Limb4
C.add# Limb4
z3b Limb4
z3b
      !t1 :: Limb4
t1  = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
y Limb4
z
      !t2a :: Limb4
t2a = Limb4 -> Limb4
C.sqr# Limb4
z
      !t2b :: Limb4
t2b = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
b3 Limb4
t2a
      !x3a :: Limb4
x3a = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
t2b Limb4
z3c
      !y3a :: Limb4
y3a = Limb4 -> Limb4 -> Limb4
C.add# Limb4
t0 Limb4
t2b
      !z3d :: Limb4
z3d = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
t1 Limb4
z3c
      !t1b :: Limb4
t1b = Limb4 -> Limb4 -> Limb4
C.add# Limb4
t2b Limb4
t2b
      !t2c :: Limb4
t2c = Limb4 -> Limb4 -> Limb4
C.add# Limb4
t1b Limb4
t2b
      !t0b :: Limb4
t0b = Limb4 -> Limb4 -> Limb4
C.sub# Limb4
t0 Limb4
t2c
      !y3b :: Limb4
y3b = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
t0b Limb4
y3a
      !y3c :: Limb4
y3c = Limb4 -> Limb4 -> Limb4
C.add# Limb4
x3a Limb4
y3b
      !t1c :: Limb4
t1c = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
x Limb4
y
      !x3b :: Limb4
x3b = Limb4 -> Limb4 -> Limb4
C.mul# Limb4
t0b Limb4
t1c
      !x3c :: Limb4
x3c = Limb4 -> Limb4 -> Limb4
C.add# Limb4
x3b Limb4
x3b
  in  (# Limb4
x3c, Limb4
y3c, Limb4
z3d #)
{-# INLINE double# #-}

select_proj# :: Proj -> Proj -> CT.Choice -> Proj
select_proj# :: Proj -> Proj -> Choice -> Proj
select_proj# (# Limb4
ax, Limb4
ay, Limb4
az #) (# Limb4
bx, Limb4
by, Limb4
bz #) Choice
c =
  (# Limb4 -> Limb4 -> Choice -> Limb4
W.select# Limb4
ax Limb4
bx Choice
c, Limb4 -> Limb4 -> Choice -> Limb4
W.select# Limb4
ay Limb4
by Choice
c, Limb4 -> Limb4 -> Choice -> Limb4
W.select# Limb4
az Limb4
bz Choice
c #)
{-# INLINE select_proj# #-}

neg# :: Proj -> Proj
neg# :: Proj -> Proj
neg# (# Limb4
x, Limb4
y, Limb4
z #) = (# Limb4
x, Limb4 -> Limb4
C.neg# Limb4
y, Limb4
z #)
{-# INLINE neg# #-}

mul# :: Proj -> Limb4 -> (# () | Proj #)
mul# :: Proj -> Limb4 -> (# () | Proj #)
mul# (# Limb4
px, Limb4
py, Limb4
pz #) Limb4
s
    | Choice -> Bool
CT.decide (Choice -> Choice
CT.not (Limb4 -> Choice
ge# Limb4
s)) = (# () | #)
    | Bool
otherwise =
        let !(P Limb4
gx Limb4
gy Limb4
gz) = Projective
_CURVE_G
            !(C.Montgomery Limb4
o) = Montgomery
C.one
        in  Int -> Proj -> Proj -> Proj -> Limb4 -> (# () | Proj #)
forall {a}. Int -> Proj -> Proj -> Proj -> Limb4 -> (# a | Proj #)
loop (Int
0 :: Int) (# (# #) -> Limb4
Z, Limb4
o, (# #) -> Limb4
Z #) (# Limb4
gx, Limb4
gy, Limb4
gz #) (# Limb4
px, Limb4
py, Limb4
pz #) Limb4
s
  where
    loop :: Int -> Proj -> Proj -> Proj -> Limb4 -> (# a | Proj #)
loop !Int
j !Proj
a !Proj
f !Proj
d !Limb4
_SECRET
      | Int
j Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
_CURVE_Q_BITS = (# | Proj
a #)
      | Bool
otherwise =
          let !nd :: Proj
nd = Proj -> Proj
double# Proj
d
              !(# Limb4
nm, Choice
lsb_set #) = Limb4 -> (# Limb4, Choice #)
W.shr1_c# Limb4
_SECRET
              !nacc :: Proj
nacc = Proj -> Proj -> Choice -> Proj
select_proj# Proj
a (Proj -> Proj -> Proj
add_proj# Proj
a Proj
d) Choice
lsb_set
              !nf :: Proj
nf   = Proj -> Proj -> Choice -> Proj
select_proj# (Proj -> Proj -> Proj
add_proj# Proj
f Proj
d) Proj
f Choice
lsb_set
          in  Int -> Proj -> Proj -> Proj -> Limb4 -> (# a | Proj #)
loop (Int -> Int
forall a. Enum a => a -> a
succ Int
j) Proj
nacc Proj
nf Proj
nd Limb4
nm
{-# INLINE mul# #-}

ge# :: Limb4 -> CT.Choice
ge# :: Limb4 -> Choice
ge# Limb4
n =
  let !(Wider Limb4
q) = Wider
_CURVE_Q
  in  Choice -> Choice -> Choice
CT.and (Limb4 -> Limb4 -> Choice
W.gt# Limb4
n (# #) -> Limb4
Z) (Limb4 -> Limb4 -> Choice
W.lt# Limb4
n Limb4
q)
{-# INLINE ge# #-}

mul_wnaf# :: ByteArray -> Int -> Limb4 -> (# () | Proj #)
mul_wnaf# :: ByteArray -> Int -> Limb4 -> (# () | Proj #)
mul_wnaf# ByteArray
ctxArray Int
ctxW Limb4
ls
    | Choice -> Bool
CT.decide (Choice -> Choice
CT.not (Limb4 -> Choice
ge# Limb4
ls)) = (# () | #)
    | Bool
otherwise =
        let !(P Limb4
zx Limb4
zy Limb4
zz) = Projective
_CURVE_ZERO
            !(P Limb4
gx Limb4
gy Limb4
gz) = Projective
_CURVE_G
        in  (# | Word -> Proj -> Proj -> Limb4 -> Proj
loop Word
0 (# Limb4
zx, Limb4
zy, Limb4
zz #) (# Limb4
gx, Limb4
gy, Limb4
gz #) Limb4
ls #)
  where
    !one :: Limb4
one                  = (# Word# -> Limb
Limb Word#
1##, Word# -> Limb
Limb Word#
0##, Word# -> Limb
Limb Word#
0##, Word# -> Limb
Limb Word#
0## #)
    !wins :: Word
wins                 = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fi (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 :: Word
size@(GHC.Word.W# Word#
s) = Word
2 Word -> Int -> Word
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
ctxW Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    !(GHC.Word.W# Word#
mask)   = Word
2 Word -> Int -> Word
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
ctxW Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1
    !(GHC.Word.W# Word#
texW)   = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fi Int
ctxW
    !(GHC.Word.W# Word#
mnum)   = Word
2 Word -> Int -> Word
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
ctxW

    loop :: Word -> Proj -> Proj -> Limb4 -> Proj
loop !j :: Word
j@(GHC.Word.W# Word#
w) !Proj
acc !Proj
f !n :: Limb4
n@(# Limb Word#
lo, Limb
_, Limb
_, Limb
_ #)
      | Word
j Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
wins = Proj
acc
      | Bool
otherwise =
          let !(GHC.Word.W# Word#
off0) = Word
j Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
size
              !b0 :: Word#
b0          = Word# -> Word# -> Word#
Exts.and# Word#
lo Word#
mask
              !bor :: Choice
bor         = Word# -> Word# -> Choice
CT.from_word_gt# Word#
b0 Word#
s

              !(# Limb4
n0, Limb
_ #) = Limb4 -> Int# -> (# Limb4, Limb #)
W.shr_limb# Limb4
n (Word# -> Int#
Exts.word2Int# Word#
texW)
              !n0_plus_1 :: Limb4
n0_plus_1   = Limb4 -> Limb4 -> Limb4
W.add_w# Limb4
n0 Limb4
one
              !n1 :: Limb4
n1          = Limb4 -> Limb4 -> Choice -> Limb4
W.select# Limb4
n0 Limb4
n0_plus_1 Choice
bor

              !abs_b :: Word#
abs_b       = Word# -> Word# -> Choice -> Word#
CT.select_word# Word#
b0 (Word# -> Word# -> Word#
Exts.minusWord# Word#
mnum Word#
b0) Choice
bor
              !is_zero :: Choice
is_zero     = Word# -> Word# -> Choice
CT.from_word_eq# Word#
b0 Word#
0##
              !c0 :: Choice
c0          = Word# -> Choice
CT.from_bit# (Word# -> Word# -> Word#
Exts.and# Word#
w Word#
1##)
              !off_nz :: Word#
off_nz      = Word# -> Word# -> Word#
Exts.minusWord# (Word# -> Word# -> Word#
Exts.plusWord# Word#
off0 Word#
abs_b) Word#
1##
              !off :: Word#
off         = Word# -> Word# -> Choice -> Word#
CT.select_word# Word#
off0 Word#
off_nz (Choice -> Choice
CT.not Choice
is_zero)

              !pr :: Proj
pr          = ByteArray -> Word# -> Word# -> Word# -> Proj
ct_index_proj# ByteArray
ctxArray Word#
off0 Word#
s Word#
off
              !neg_pr :: Proj
neg_pr      = Proj -> Proj
neg# Proj
pr
              !pt_zero :: Proj
pt_zero     = Proj -> Proj -> Choice -> Proj
select_proj# Proj
pr Proj
neg_pr Choice
c0
              !pt_nonzero :: Proj
pt_nonzero  = Proj -> Proj -> Choice -> Proj
select_proj# Proj
pr Proj
neg_pr Choice
bor

              !f_added :: Proj
f_added     = Proj -> Proj -> Proj
add_proj# Proj
f Proj
pt_zero
              !acc_added :: Proj
acc_added   = Proj -> Proj -> Proj
add_proj# Proj
acc Proj
pt_nonzero
              !nacc :: Proj
nacc        = Proj -> Proj -> Choice -> Proj
select_proj# Proj
acc_added Proj
acc Choice
is_zero
              !nf :: Proj
nf          = Proj -> Proj -> Choice -> Proj
select_proj# Proj
f Proj
f_added Choice
is_zero
          in  Word -> Proj -> Proj -> Limb4 -> Proj
loop (Word -> Word
forall a. Enum a => a -> a
succ Word
j) Proj
nacc Proj
nf Limb4
n1
{-# INLINE mul_wnaf# #-}

-- retrieve a point (as an unboxed tuple) from a context array
index_proj# :: ByteArray -> Exts.Int# -> Proj
index_proj# :: ByteArray -> Int# -> Proj
index_proj# (ByteArray ByteArray#
arr#) Int#
i# =
  let !base# :: Int#
base# = Int#
i# Int# -> Int# -> Int#
Exts.*# Int#
12#
      !x :: Limb4
x = (# Word# -> Limb
Limb (ByteArray# -> Int# -> Word#
Exts.indexWordArray# ByteArray#
arr# Int#
base#)
            , Word# -> Limb
Limb (ByteArray# -> Int# -> Word#
Exts.indexWordArray# ByteArray#
arr# (Int#
base# Int# -> Int# -> Int#
Exts.+# Int#
01#))
            , Word# -> Limb
Limb (ByteArray# -> Int# -> Word#
Exts.indexWordArray# ByteArray#
arr# (Int#
base# Int# -> Int# -> Int#
Exts.+# Int#
02#))
            , Word# -> Limb
Limb (ByteArray# -> Int# -> Word#
Exts.indexWordArray# ByteArray#
arr# (Int#
base# Int# -> Int# -> Int#
Exts.+# Int#
03#)) #)
      !y :: Limb4
y = (# Word# -> Limb
Limb (ByteArray# -> Int# -> Word#
Exts.indexWordArray# ByteArray#
arr# (Int#
base# Int# -> Int# -> Int#
Exts.+# Int#
04#))
            , Word# -> Limb
Limb (ByteArray# -> Int# -> Word#
Exts.indexWordArray# ByteArray#
arr# (Int#
base# Int# -> Int# -> Int#
Exts.+# Int#
05#))
            , Word# -> Limb
Limb (ByteArray# -> Int# -> Word#
Exts.indexWordArray# ByteArray#
arr# (Int#
base# Int# -> Int# -> Int#
Exts.+# Int#
06#))
            , Word# -> Limb
Limb (ByteArray# -> Int# -> Word#
Exts.indexWordArray# ByteArray#
arr# (Int#
base# Int# -> Int# -> Int#
Exts.+# Int#
07#)) #)
      !z :: Limb4
z = (# Word# -> Limb
Limb (ByteArray# -> Int# -> Word#
Exts.indexWordArray# ByteArray#
arr# (Int#
base# Int# -> Int# -> Int#
Exts.+# Int#
08#))
            , Word# -> Limb
Limb (ByteArray# -> Int# -> Word#
Exts.indexWordArray# ByteArray#
arr# (Int#
base# Int# -> Int# -> Int#
Exts.+# Int#
09#))
            , Word# -> Limb
Limb (ByteArray# -> Int# -> Word#
Exts.indexWordArray# ByteArray#
arr# (Int#
base# Int# -> Int# -> Int#
Exts.+# Int#
10#))
            , Word# -> Limb
Limb (ByteArray# -> Int# -> Word#
Exts.indexWordArray# ByteArray#
arr# (Int#
base# Int# -> Int# -> Int#
Exts.+# Int#
11#)) #)
  in  (# Limb4
x, Limb4
y, Limb4
z #)
{-# INLINE index_proj# #-}

-- Constant-time table lookup within a window.
--
-- Unconditionally scans all entries from 'base' to 'base + size - 1',
-- selecting the one where 'index' equals 'target'.
ct_index_proj#
  :: ByteArray
  -> Exts.Word#  -- ^ base index
  -> Exts.Word#  -- ^ size of window
  -> Exts.Word#  -- ^ target index
  -> Proj
ct_index_proj# :: ByteArray -> Word# -> Word# -> Word# -> Proj
ct_index_proj# ByteArray
arr Word#
base Word#
size Word#
target = Word# -> Proj -> Proj
loop Word#
0## (# (# #) -> Limb4
Z, (# #) -> Limb4
Z, (# #) -> Limb4
Z #) where
  loop :: Word# -> Proj -> Proj
loop Word#
i Proj
acc
    | Int# -> Bool
Exts.isTrue# (Word#
i Word# -> Word# -> Int#
`Exts.geWord#` Word#
size) = Proj
acc
    | Bool
otherwise =
        let !idx :: Word#
idx  = Word# -> Word# -> Word#
Exts.plusWord# Word#
base Word#
i
            !pt :: Proj
pt   = ByteArray -> Int# -> Proj
index_proj# ByteArray
arr (Word# -> Int#
Exts.word2Int# Word#
idx)
            !eq :: Choice
eq   = Word# -> Word# -> Choice
CT.from_word_eq# Word#
idx Word#
target
            !nacc :: Proj
nacc = Proj -> Proj -> Choice -> Proj
select_proj# Proj
acc Proj
pt Choice
eq
        in  Word# -> Proj -> Proj
loop (Word# -> Word# -> Word#
Exts.plusWord# Word#
i Word#
1##) Proj
nacc
{-# INLINE ct_index_proj# #-}

-- ec arithmetic --------------------------------------------------------------

-- Negate secp256k1 point.
neg :: Projective -> Projective
neg :: Projective -> Projective
neg (P Limb4
x Limb4
y Limb4
z) =
  let !(# Limb4
px, Limb4
py, Limb4
pz #) = Proj -> Proj
neg# (# Limb4
x, Limb4
y, Limb4
z #)
  in  Limb4 -> Limb4 -> Limb4 -> Projective
P Limb4
px Limb4
py Limb4
pz
{-# INLINABLE neg #-}

-- Elliptic curve addition on secp256k1.
add :: Projective -> Projective -> Projective
add :: Projective -> Projective -> Projective
add Projective
p Projective
q = Projective -> Projective -> Projective
add_proj Projective
p Projective
q
{-# INLINABLE add #-}

-- algo 7, "complete addition formulas for prime order elliptic curves,"
-- renes et al, 2015
--
-- https://eprint.iacr.org/2015/1060.pdf
add_proj :: Projective -> Projective -> Projective
add_proj :: Projective -> Projective -> Projective
add_proj (P Limb4
ax Limb4
ay Limb4
az) (P Limb4
bx Limb4
by Limb4
bz) =
  let !(# Limb4
x, Limb4
y, Limb4
z #) = Proj -> Proj -> Proj
add_proj# (# Limb4
ax, Limb4
ay, Limb4
az #) (# Limb4
bx, Limb4
by, Limb4
bz #)
  in  Limb4 -> Limb4 -> Limb4 -> Projective
P Limb4
x Limb4
y Limb4
z
{-# INLINABLE add_proj #-}

-- algo 8, renes et al, 2015
add_mixed :: Projective -> Projective -> Projective
add_mixed :: Projective -> Projective -> Projective
add_mixed (P Limb4
ax Limb4
ay Limb4
az) (P Limb4
bx Limb4
by Limb4
bz) =
  let !(# Limb4
x, Limb4
y, Limb4
z #) = Proj -> Proj -> Proj
add_mixed# (# Limb4
ax, Limb4
ay, Limb4
az #) (# Limb4
bx, Limb4
by, Limb4
bz #)
  in  Limb4 -> Limb4 -> Limb4 -> Projective
P Limb4
x Limb4
y Limb4
z
{-# INLINABLE add_mixed #-}

-- algo 9, renes et al, 2015
double :: Projective -> Projective
double :: Projective -> Projective
double (Projective (C.Montgomery Limb4
ax) (C.Montgomery Limb4
ay) (C.Montgomery Limb4
az)) =
  let !(# Limb4
x, Limb4
y, Limb4
z #) = Proj -> Proj
double# (# Limb4
ax, Limb4
ay, Limb4
az #)
  in  Limb4 -> Limb4 -> Limb4 -> Projective
P Limb4
x Limb4
y Limb4
z
{-# INLINABLE double #-}

-- Timing-safe scalar multiplication of secp256k1 points.
mul :: Projective -> Wider -> Maybe Projective
mul :: Projective -> Wider -> Maybe Projective
mul (P Limb4
x Limb4
y Limb4
z) (Wider Limb4
s) = case Proj -> Limb4 -> (# () | Proj #)
mul# (# Limb4
x, Limb4
y, Limb4
z #) Limb4
s of
  (# () | #)               -> Maybe Projective
forall a. Maybe a
Nothing
  (# | (# Limb4
px, Limb4
py, Limb4
pz #) #) -> Projective -> Maybe Projective
forall a. a -> Maybe a
Just (Projective -> Maybe Projective) -> Projective -> Maybe Projective
forall a b. (a -> b) -> a -> b
$! Limb4 -> Limb4 -> Limb4 -> Projective
P Limb4
px Limb4
py Limb4
pz
{-# INLINABLE mul #-}

-- Timing-unsafe scalar multiplication of secp256k1 points.
--
-- Don't use this function if the scalar could potentially be a secret.
mul_vartime :: Projective -> Wider -> Maybe Projective
mul_vartime :: Projective -> Wider -> Maybe Projective
mul_vartime Projective
p = \case
    Wider
Zero -> Projective -> Maybe Projective
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Projective
_CURVE_ZERO
    Wider
n | Bool -> Bool
not (Wider -> Bool
ge Wider
n) -> Maybe Projective
forall a. Maybe a
Nothing
      | Bool
otherwise  -> 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
$! Projective -> Projective -> Wider -> Projective
loop Projective
_CURVE_ZERO Projective
p Wider
n
  where
    loop :: Projective -> Projective -> Wider -> Projective
loop !Projective
r !Projective
d = \case
      Wider
Zero -> Projective
r
      Wider
m ->
        let !nd :: Projective
nd = Projective -> Projective
double Projective
d
            !(# Wider
nm, Choice
lsb_set #) = Wider -> (# Wider, Choice #)
W.shr1_c Wider
m
            !nr :: Projective
nr = if Choice -> Bool
CT.decide Choice
lsb_set then Projective -> Projective -> Projective
add Projective
r Projective
d else Projective
r
        in  Projective -> Projective -> Wider -> Projective
loop Projective
nr Projective
nd Wider
nm

-- | Precomputed multiples of the secp256k1 base or generator point.
data Context = Context {
    Context -> Int
ctxW     :: {-# UNPACK #-} !Int
  , Context -> ByteArray
ctxArray :: {-# UNPACK #-} !ByteArray
  } deriving (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 -> String
show Context {} = String
"<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
4

-- This is a highly-optimized version of a function originally
-- translated from noble-secp256k1's "precompute". Points are stored in
-- a ByteArray by arranging each limb into slices of 12 consecutive
-- slots (each Projective point consists of three Montgomery values,
-- each of which consists of four limbs, summing to twelve limbs in
-- total).
--
-- Each point takes 96 bytes to store in this fashion, so the total size of
-- the ByteArray is (size * 96) bytes.
_precompute :: Int -> Context
_precompute :: Int -> Context
_precompute Int
ctxW = Context {Int
ByteArray
ctxW :: Int
ctxArray :: ByteArray
ctxW :: Int
ctxArray :: ByteArray
..} where
  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

  -- construct the context array
  ctxArray :: ByteArray
ctxArray = (forall s. ST s ByteArray) -> ByteArray
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ByteArray) -> ByteArray)
-> (forall s. ST s ByteArray) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
    marr <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
BA.newByteArray (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
96)
    loop_w marr _CURVE_G 0
    BA.unsafeFreezeByteArray marr

  -- write a point into the i^th 12-slot slice in the array
  write :: MutableByteArray s -> Int -> Projective -> ST s ()
  write :: forall s. MutableByteArray s -> Int -> Projective -> ST s ()
write MutableByteArray s
marr Int
i
      (P (# Limb Word#
x0, Limb Word#
x1, Limb Word#
x2, Limb Word#
x3 #)
         (# Limb Word#
y0, Limb Word#
y1, Limb Word#
y2, Limb Word#
y3 #)
         (# Limb Word#
z0, Limb Word#
z1, Limb Word#
z2, Limb Word#
z3 #)) = do
    let !base :: Int
base = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
12
    MutableByteArray (PrimState (ST s)) -> Int -> Word -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
BA.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
marr (Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
00) (Word# -> Word
GHC.Word.W# Word#
x0)
    MutableByteArray (PrimState (ST s)) -> Int -> Word -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
BA.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
marr (Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
01) (Word# -> Word
GHC.Word.W# Word#
x1)
    MutableByteArray (PrimState (ST s)) -> Int -> Word -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
BA.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
marr (Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
02) (Word# -> Word
GHC.Word.W# Word#
x2)
    MutableByteArray (PrimState (ST s)) -> Int -> Word -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
BA.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
marr (Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
03) (Word# -> Word
GHC.Word.W# Word#
x3)
    MutableByteArray (PrimState (ST s)) -> Int -> Word -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
BA.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
marr (Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
04) (Word# -> Word
GHC.Word.W# Word#
y0)
    MutableByteArray (PrimState (ST s)) -> Int -> Word -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
BA.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
marr (Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
05) (Word# -> Word
GHC.Word.W# Word#
y1)
    MutableByteArray (PrimState (ST s)) -> Int -> Word -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
BA.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
marr (Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
06) (Word# -> Word
GHC.Word.W# Word#
y2)
    MutableByteArray (PrimState (ST s)) -> Int -> Word -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
BA.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
marr (Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
07) (Word# -> Word
GHC.Word.W# Word#
y3)
    MutableByteArray (PrimState (ST s)) -> Int -> Word -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
BA.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
marr (Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
08) (Word# -> Word
GHC.Word.W# Word#
z0)
    MutableByteArray (PrimState (ST s)) -> Int -> Word -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
BA.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
marr (Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
09) (Word# -> Word
GHC.Word.W# Word#
z1)
    MutableByteArray (PrimState (ST s)) -> Int -> Word -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
BA.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
marr (Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10) (Word# -> Word
GHC.Word.W# Word#
z2)
    MutableByteArray (PrimState (ST s)) -> Int -> Word -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
BA.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
marr (Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
11) (Word# -> Word
GHC.Word.W# Word#
z3)

  -- loop over windows
  loop_w :: MutableByteArray s -> Projective -> Int -> ST s ()
  loop_w :: forall s. MutableByteArray s -> Projective -> Int -> ST s ()
loop_w !MutableByteArray s
marr !Projective
p !Int
w
    | Int
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ws = () -> ST s ()
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    | Bool
otherwise = do
        nb <- MutableByteArray s
-> Projective -> Projective -> Int -> Int -> ST s Projective
forall s.
MutableByteArray s
-> Projective -> Projective -> Int -> Int -> ST s Projective
loop_j MutableByteArray s
marr Projective
p Projective
p (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
capJ) Int
0
        let np = Projective -> Projective
double Projective
nb
        loop_w marr np (succ w)

  -- loop within windows
  loop_j
    :: MutableByteArray s
    -> Projective
    -> Projective
    -> Int
    -> Int
    -> ST s Projective
  loop_j :: forall s.
MutableByteArray s
-> Projective -> Projective -> Int -> Int -> ST s Projective
loop_j !MutableByteArray s
marr !Projective
p !Projective
b !Int
idx !Int
j = do
    MutableByteArray s -> Int -> Projective -> ST s ()
forall s. MutableByteArray s -> Int -> Projective -> ST s ()
write MutableByteArray s
marr Int
idx Projective
b
    if   Int
j Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
capJ Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    then Projective -> ST s Projective
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Projective
b
    else do
      let !nb :: Projective
nb = Projective -> Projective -> Projective
add Projective
b Projective
p
      MutableByteArray s
-> Projective -> Projective -> Int -> Int -> ST s Projective
forall s.
MutableByteArray s
-> Projective -> Projective -> Int -> Int -> ST s Projective
loop_j MutableByteArray s
marr Projective
p Projective
nb (Int -> Int
forall a. Enum a => a -> a
succ Int
idx) (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 -> Wider -> Maybe Projective
mul_wnaf :: Context -> Wider -> Maybe Projective
mul_wnaf Context {Int
ByteArray
ctxW :: Context -> Int
ctxArray :: Context -> ByteArray
ctxW :: Int
ctxArray :: ByteArray
..} (Wider Limb4
s) = case ByteArray -> Int -> Limb4 -> (# () | Proj #)
mul_wnaf# ByteArray
ctxArray Int
ctxW Limb4
s of
  (# () | #)               -> Maybe Projective
forall a. Maybe a
Nothing
  (# | (# Limb4
px, Limb4
py, Limb4
pz #) #) -> Projective -> Maybe Projective
forall a. a -> Maybe a
Just (Projective -> Maybe Projective) -> Projective -> Maybe Projective
forall a b. (a -> b) -> a -> b
$! Limb4 -> Limb4 -> Limb4 -> Projective
P Limb4
px Limb4
py Limb4
pz
{-# INLINABLE mul_wnaf #-}

-- | Derive a public key (i.e., a secp256k1 point) from the provided
--   secret.
--
--   >>> import qualified System.Entropy as E
--   >>> sk <- fmap parse_int256 (E.getEntropy 32)
--   >>> derive_pub sk
--   Just "<secp256k1 point>"
derive_pub :: Wider -> Maybe Pub
derive_pub :: Wider -> Maybe Projective
derive_pub = Projective -> Wider -> Maybe Projective
mul Projective
_CURVE_G
{-# NOINLINE derive_pub #-}

-- | The same as 'derive_pub', except uses a 'Context' to optimise
--   internal calculations.
--
--   >>> import qualified System.Entropy as E
--   >>> sk <- fmap parse_int256 (E.getEntropy 32)
--   >>> let !tex = precompute
--   >>> derive_pub' tex sk
--   Just "<secp256k1 point>"
derive_pub' :: Context -> Wider -> Maybe Pub
derive_pub' :: Context -> Wider -> Maybe Projective
derive_pub' = Context -> Wider -> Maybe Projective
mul_wnaf
{-# NOINLINE derive_pub' #-}

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

-- | Parse a 'Wider', /e.g./ a Schnorr or ECDSA secret key.
--
--   >>> import qualified Data.ByteString as BS
--   >>> parse_int256 (BS.replicate 32 0xFF)
--   Just <2^256 - 1>
parse_int256 :: BS.ByteString -> Maybe Wider
parse_int256 :: ByteString -> Maybe Wider
parse_int256 ByteString
bs = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32)
  Wider -> Maybe Wider
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Wider -> Maybe Wider) -> Wider -> Maybe Wider
forall a b. (a -> b) -> a -> b
$! ByteString -> Wider
unsafe_roll32 ByteString
bs
{-# INLINABLE parse_int256 #-}

-- | Parse compressed secp256k1 point (33 bytes), uncompressed point (65
--   bytes), or BIP0340-style point (32 bytes).
--
--   >>> parse_point <33-byte compressed point>
--   Just <Pub>
--   >>> parse_point <65-byte uncompressed point>
--   Just <Pub>
--   >>> parse_point <32-byte bip0340 public key>
--   Just <Pub>
--   >>> parse_point <anything else>
--   Nothing
parse_point :: BS.ByteString -> Maybe Projective
parse_point :: 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
. Montgomery -> Maybe Affine
lift_vartime (Montgomery -> Maybe Affine)
-> (ByteString -> Montgomery) -> ByteString -> Maybe Affine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wider -> Montgomery
C.to (Wider -> Montgomery)
-> (ByteString -> Wider) -> ByteString -> Montgomery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Wider
unsafe_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 -> Wider
unsafe_roll32 -> Wider
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 (Wider -> Bool
fe Wider
x) = Maybe Projective
forall a. Maybe a
Nothing
  | Bool
otherwise = do
      let !mx :: Montgomery
mx = Wider -> Montgomery
C.to Wider
x
      !my <- Montgomery -> Maybe Montgomery
C.sqrt_vartime (Montgomery -> Montgomery
weierstrass Montgomery
mx)
      let !yodd = Choice -> Bool
CT.decide (Wider -> Choice
W.odd (Montgomery -> Wider
C.retr Montgomery
my))
          !hodd = Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
B.testBit Word8
h Int
0
      pure $!
        if   hodd /= yodd
        then Projective mx (negate my) 1
        else Projective mx my 1

-- bytestring input is guaranteed to be 64B in length
_parse_uncompressed :: Word8 -> BS.ByteString -> Maybe Projective
_parse_uncompressed :: Word8 -> ByteString -> Maybe Projective
_parse_uncompressed Word8
h ByteString
bs = do
  let (ByteString -> Wider
unsafe_roll32 -> Wider
x, ByteString -> Wider
unsafe_roll32 -> Wider
y) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
_CURVE_Q_BYTES ByteString
bs
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Word8
h Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x04)
  let !p :: Projective
p = Montgomery -> Montgomery -> Montgomery -> Projective
Projective (Wider -> Montgomery
C.to Wider
x) (Wider -> Montgomery
C.to Wider
y) Montgomery
1
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Projective -> Bool
valid Projective
p)
  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
$! Projective
p

-- | Parse an ECDSA signature encoded in 64-byte "compact" form.
--
--   >>> parse_sig <64-byte compact signature>
--   Just "<ecdsa signature>"
parse_sig :: BS.ByteString -> Maybe ECDSA
parse_sig :: ByteString -> Maybe ECDSA
parse_sig ByteString
bs = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
64)
  let (ByteString
r0, ByteString
s0) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
32 ByteString
bs
  r <- ByteString -> Maybe Wider
roll32 ByteString
r0
  s <- roll32 s0
  pure $! ECDSA r s

-- serializing ----------------------------------------------------------------

-- | Serialize a secp256k1 point in 33-byte compressed form.
--
--   >>> serialize_point pub
--   "<33-byte compressed point>"
serialize_point :: Projective -> BS.ByteString
serialize_point :: Projective -> ByteString
serialize_point (Projective -> Affine
affine -> Affine (Montgomery -> Wider
C.from -> Wider
x) (Montgomery -> Wider
C.from -> Wider
y)) =
  let !(Wider (# Limb Word#
w, Limb
_, Limb
_, Limb
_ #)) = Wider
y
      !b :: Word8
b | Word -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
B.testBit (Word# -> Word
GHC.Word.W# Word#
w) Int
0 = Word8
0x03
         | Bool
otherwise = Word8
0x02
  in  Word8 -> ByteString -> ByteString
BS.cons Word8
b (Wider -> ByteString
unroll32 Wider
x)

-- ecdh -----------------------------------------------------------------------

-- SEC1-v2 3.3.1, plus SHA256 hash

-- | Compute a shared secret, given a secret key and public secp256k1 point,
--   via Elliptic Curve Diffie-Hellman (ECDH).
--
--   The shared secret is the SHA256 hash of the x-coordinate of the
--   point obtained by scalar multiplication.
--
--   >>> let sec_alice = 0x03
--   >>> let sec_bob   = 2 ^ 128 - 1
--   >>> let Just pub_alice = derive_pub sec_alice
--   >>> let Just pub_bob   = derive_pub sec_bob
--   >>> let secret_as_computed_by_alice = ecdh pub_bob sec_alice
--   >>> let secret_as_computed_by_bob   = ecdh pub_alice sec_bob
--   >>> secret_as_computed_by_alice == secret_as_computed_by_bob
--   True
ecdh
  :: Projective          -- ^ public key
  -> Wider               -- ^ secret key
  -> Maybe BS.ByteString -- ^ shared secret
ecdh :: Projective -> Wider -> Maybe ByteString
ecdh Projective
pub Wider
_SECRET = do
  pt@(P _ _ (C.Montgomery -> z)) <- Projective -> Wider -> Maybe Projective
mul Projective
pub Wider
_SECRET
  let !(Affine (C.retr -> x) _) = affine pt
      !result = ByteString -> ByteString
SHA256.hash (Wider -> ByteString
unroll32 Wider
x)
  if CT.decide (C.eq z 0) then Nothing else Just result

-- schnorr --------------------------------------------------------------------
-- see https://github.com/bitcoin/bips/blob/master/bip-0340.mediawiki

-- | Create a 64-byte Schnorr signature for the provided message, using
--   the provided secret key.
--
--   BIP0340 recommends that 32 bytes of fresh auxiliary entropy be
--   generated and added at signing time as additional protection
--   against side-channel attacks (namely, to thwart so-called "fault
--   injection" attacks). This entropy is /supplemental/ to security,
--   and the cryptographic security of the signature scheme itself does
--   not rely on it, so it is not strictly required; 32 zero bytes can
--   be used in its stead (and can be supplied via 'mempty').
--
--   >>> import qualified System.Entropy as E
--   >>> aux <- E.getEntropy 32
--   >>> sign_schnorr sec msg aux
--   Just "<64-byte schnorr signature>"
sign_schnorr
  :: Wider          -- ^ secret key
  -> BS.ByteString  -- ^ message
  -> BS.ByteString  -- ^ 32 bytes of auxilliary random data
  -> Maybe BS.ByteString  -- ^ 64-byte Schnorr signature
sign_schnorr :: Wider -> ByteString -> ByteString -> Maybe ByteString
sign_schnorr = (Wider -> Maybe Projective)
-> Wider -> ByteString -> ByteString -> Maybe ByteString
_sign_schnorr (Projective -> Wider -> Maybe 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
--   Just "<64-byte schnorr signature>"
sign_schnorr'
  :: Context        -- ^ secp256k1 context
  -> Wider          -- ^ secret key
  -> BS.ByteString  -- ^ message
  -> BS.ByteString  -- ^ 32 bytes of auxilliary random data
  -> Maybe BS.ByteString  -- ^ 64-byte Schnorr signature
sign_schnorr' :: Context -> Wider -> ByteString -> ByteString -> Maybe ByteString
sign_schnorr' Context
tex = (Wider -> Maybe Projective)
-> Wider -> ByteString -> ByteString -> Maybe ByteString
_sign_schnorr (Context -> Wider -> Maybe Projective
mul_wnaf Context
tex)

_sign_schnorr
  :: (Wider -> Maybe Projective)  -- partially-applied multiplication function
  -> Wider                        -- secret key
  -> BS.ByteString                -- message
  -> BS.ByteString                -- 32 bytes of auxilliary random data
  -> Maybe BS.ByteString
_sign_schnorr :: (Wider -> Maybe Projective)
-> Wider -> ByteString -> ByteString -> Maybe ByteString
_sign_schnorr Wider -> Maybe Projective
_mul Wider
_SECRET ByteString
m ByteString
a = do
  p <- Wider -> Maybe Projective
_mul Wider
_SECRET
  let Affine (C.retr -> x_p) (C.retr -> y_p) = affine p
      s       = Wider -> Montgomery
S.to Wider
_SECRET
      d       = Montgomery -> Montgomery -> Choice -> Montgomery
S.select Montgomery
s (Montgomery -> Montgomery
forall a. Num a => a -> a
negate Montgomery
s) (Wider -> Choice
W.odd Wider
y_p)
      bytes_d = Wider -> ByteString
unroll32 (Montgomery -> Wider
S.retr Montgomery
d)
      bytes_p = Wider -> ByteString
unroll32 Wider
x_p
      t       = ByteString -> ByteString -> ByteString
xor ByteString
bytes_d (ByteString -> ByteString
hash_aux ByteString
a)
      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'      = Wider -> Montgomery
S.to (ByteString -> Wider
unsafe_roll32 ByteString
rand)
  guard (not (S.eq_vartime k' 0)) -- negligible probability
  pt <- _mul (S.retr k')
  let Affine (C.retr -> x_r) (C.retr -> y_r) = affine pt
      k         = Montgomery -> Montgomery -> Choice -> Montgomery
S.select Montgomery
k' (Montgomery -> Montgomery
forall a. Num a => a -> a
negate Montgomery
k') (Wider -> Choice
W.odd Wider
y_r)
      bytes_r   = Wider -> ByteString
unroll32 Wider
x_r
      rand'     = ByteString -> ByteString
hash_challenge (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)
      e         = Wider -> Montgomery
S.to (ByteString -> Wider
unsafe_roll32 ByteString
rand')
      bytes_ked = Wider -> ByteString
unroll32 (Montgomery -> Wider
S.retr (Montgomery
k Montgomery -> Montgomery -> Montgomery
forall a. Num a => a -> a -> a
+ Montgomery
e Montgomery -> Montgomery -> Montgomery
forall a. Num a => a -> a -> a
* Montgomery
d))
      sig       = ByteString
bytes_r ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bytes_ked
  -- NB for benchmarking we morally want to remove the precautionary
  --    verification check here.
  --
  -- guard (verify_schnorr m p sig)
  pure $! sig
{-# INLINE _sign_schnorr #-}

-- | Verify a 64-byte Schnorr signature for the provided message with
--   the supplied public key.
--
--   >>> verify_schnorr msg pub <valid signature>
--   True
--   >>> verify_schnorr msg pub <invalid signature>
--   False
verify_schnorr
  :: BS.ByteString  -- ^ message
  -> Pub            -- ^ public key
  -> BS.ByteString  -- ^ 64-byte Schnorr signature
  -> Bool
verify_schnorr :: ByteString -> Projective -> ByteString -> Bool
verify_schnorr = (Wider -> Maybe Projective)
-> ByteString -> Projective -> ByteString -> Bool
_verify_schnorr (Projective -> Wider -> Maybe Projective
mul_vartime 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 = (Wider -> Maybe Projective)
-> ByteString -> Projective -> ByteString -> Bool
_verify_schnorr (Context -> Wider -> Maybe Projective
mul_wnaf Context
tex)

_verify_schnorr
  :: (Wider -> Maybe Projective) -- partially-applied multiplication function
  -> BS.ByteString
  -> Pub
  -> BS.ByteString
  -> Bool
_verify_schnorr :: (Wider -> Maybe Projective)
-> ByteString -> Projective -> ByteString -> Bool
_verify_schnorr Wider -> Maybe Projective
_mul ByteString
m Projective
p ByteString
sig
  | ByteString -> Int
BS.length ByteString
sig Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
64 = Bool
False
  | Bool
otherwise = Maybe () -> Bool
forall a. Maybe a -> Bool
M.isJust (Maybe () -> Bool) -> Maybe () -> Bool
forall a b. (a -> b) -> a -> b
$ do
      let capP :: Projective
capP = Projective -> Projective
even_y_vartime Projective
p
          (ByteString -> Wider
unsafe_roll32 -> Wider
r, ByteString -> Wider
unsafe_roll32 -> Wider
s) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
32 ByteString
sig
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Wider -> Bool
fe Wider
r Bool -> Bool -> Bool
&& Wider -> Bool
ge Wider
s)
      let Affine (Montgomery -> Wider
C.retr -> Wider
x_P) Montgomery
_ = Projective -> Affine
affine Projective
capP
          e :: Wider
e = Wider -> Wider
modQ (Wider -> Wider) -> (ByteString -> Wider) -> ByteString -> Wider
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Wider
unsafe_roll32 (ByteString -> Wider) -> ByteString -> Wider
forall a b. (a -> b) -> a -> b
$
            ByteString -> ByteString
hash_challenge (Wider -> ByteString
unroll32 Wider
r ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Wider -> ByteString
unroll32 Wider
x_P ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
m)
      pt0 <- Wider -> Maybe Projective
_mul Wider
s
      pt1 <- mul_vartime capP e
      let dif = Projective -> Projective -> Projective
add Projective
pt0 (Projective -> Projective
neg Projective
pt1)
      guard (dif /= _CURVE_ZERO)
      let Affine (C.from -> x_R) (C.from -> y_R) = affine dif
      guard $ not (CT.decide (W.odd y_R) || not (W.eq_vartime x_R 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 -> Wider
bits2int :: ByteString -> Wider
bits2int = ByteString -> Wider
unsafe_roll32
{-# INLINABLE bits2int #-}

-- RFC6979 2.3.3
int2octets :: Wider -> BS.ByteString
int2octets :: Wider -> ByteString
int2octets = Wider -> ByteString
unroll32
{-# INLINABLE int2octets #-}

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

-- | An ECDSA signature.
data ECDSA = ECDSA {
    ECDSA -> Wider
ecdsa_r :: !Wider
  , ECDSA -> Wider
ecdsa_s :: !Wider
  }
  deriving ((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 -> String
show ECDSA
_ = String
"<ecdsa signature>"

-- ECDSA signature type.
data SigType =
    LowS
  | Unrestricted
  deriving Int -> SigType -> ShowS
[SigType] -> ShowS
SigType -> String
(Int -> SigType -> ShowS)
-> (SigType -> String) -> ([SigType] -> ShowS) -> Show SigType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SigType -> ShowS
showsPrec :: Int -> SigType -> ShowS
$cshow :: SigType -> String
show :: SigType -> String
$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 -> String
(Int -> HashFlag -> ShowS)
-> (HashFlag -> String) -> ([HashFlag] -> ShowS) -> Show HashFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HashFlag -> ShowS
showsPrec :: Int -> HashFlag -> ShowS
$cshow :: HashFlag -> String
show :: HashFlag -> String
$cshowList :: [HashFlag] -> ShowS
showList :: [HashFlag] -> ShowS
Show

-- Convert an ECDSA signature to low-S form.
low :: ECDSA -> ECDSA
low :: ECDSA -> ECDSA
low (ECDSA Wider
r Wider
s) = Wider -> Wider -> ECDSA
ECDSA Wider
r (Wider -> Wider -> Choice -> Wider
W.select Wider
s (Wider
_CURVE_Q Wider -> Wider -> Wider
forall a. Num a => a -> a -> a
- Wider
s) (Wider -> Wider -> Choice
W.gt Wider
s Wider
_CURVE_QH))
{-# INLINE low #-}

-- | Produce an ECDSA signature for the provided message, using the
--   provided private key.
--
--   'sign_ecdsa' produces a "low-s" signature, as is commonly required
--   in applications using secp256k1. If you need a generic ECDSA
--   signature, use 'sign_ecdsa_unrestricted'.
--
--   >>> sign_ecdsa sec msg
--   Just "<ecdsa signature>"
sign_ecdsa
  :: Wider         -- ^ secret key
  -> BS.ByteString -- ^ message
  -> Maybe ECDSA
sign_ecdsa :: Wider -> ByteString -> Maybe ECDSA
sign_ecdsa = (Wider -> Maybe Projective)
-> SigType -> HashFlag -> Wider -> ByteString -> Maybe ECDSA
_sign_ecdsa (Projective -> Wider -> Maybe 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
--   Just "<ecdsa signature>"
sign_ecdsa'
  :: Context       -- ^ secp256k1 context
  -> Wider         -- ^ secret key
  -> BS.ByteString -- ^ message
  -> Maybe ECDSA
sign_ecdsa' :: Context -> Wider -> ByteString -> Maybe ECDSA
sign_ecdsa' Context
tex = (Wider -> Maybe Projective)
-> SigType -> HashFlag -> Wider -> ByteString -> Maybe ECDSA
_sign_ecdsa (Context -> Wider -> Maybe 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
--   Just "<ecdsa signature>"
sign_ecdsa_unrestricted
  :: Wider         -- ^ secret key
  -> BS.ByteString -- ^ message
  -> Maybe ECDSA
sign_ecdsa_unrestricted :: Wider -> ByteString -> Maybe ECDSA
sign_ecdsa_unrestricted = (Wider -> Maybe Projective)
-> SigType -> HashFlag -> Wider -> ByteString -> Maybe ECDSA
_sign_ecdsa (Projective -> Wider -> Maybe 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
--   Just "<ecdsa signature>"
sign_ecdsa_unrestricted'
  :: Context       -- ^ secp256k1 context
  -> Wider         -- ^ secret key
  -> BS.ByteString -- ^ message
  -> Maybe ECDSA
sign_ecdsa_unrestricted' :: Context -> Wider -> ByteString -> Maybe ECDSA
sign_ecdsa_unrestricted' Context
tex = (Wider -> Maybe Projective)
-> SigType -> HashFlag -> Wider -> ByteString -> Maybe ECDSA
_sign_ecdsa (Context -> Wider -> Maybe 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
  :: Wider         -- ^ secret key
  -> BS.ByteString -- ^ message digest
  -> Maybe ECDSA
_sign_ecdsa_no_hash :: Wider -> ByteString -> Maybe ECDSA
_sign_ecdsa_no_hash = (Wider -> Maybe Projective)
-> SigType -> HashFlag -> Wider -> ByteString -> Maybe ECDSA
_sign_ecdsa (Projective -> Wider -> Maybe Projective
mul Projective
_CURVE_G) SigType
LowS HashFlag
NoHash

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

_sign_ecdsa
  :: (Wider -> Maybe Projective) -- partially-applied multiplication function
  -> SigType
  -> HashFlag
  -> Wider
  -> BS.ByteString
  -> Maybe ECDSA
_sign_ecdsa :: (Wider -> Maybe Projective)
-> SigType -> HashFlag -> Wider -> ByteString -> Maybe ECDSA
_sign_ecdsa Wider -> Maybe Projective
_mul SigType
ty HashFlag
hf Wider
_SECRET ByteString
m = (forall s. ST s (Maybe ECDSA)) -> Maybe ECDSA
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Maybe ECDSA)) -> Maybe ECDSA)
-> (forall s. ST s (Maybe ECDSA)) -> Maybe ECDSA
forall a b. (a -> b) -> a -> b
$ do
    -- RFC6979 sec 3.3a
    let entropy :: ByteString
entropy = Wider -> ByteString
int2octets Wider
_SECRET
        nonce :: ByteString
nonce   = ByteString -> ByteString
bits2octets ByteString
h
    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
    sign_loop drbg
  where
    d :: Montgomery
d  = Wider -> Montgomery
S.to Wider
_SECRET
    hm :: Montgomery
hm = Wider -> Montgomery
S.to (ByteString -> Wider
bits2int ByteString
h)
    h :: ByteString
h  = case HashFlag
hf of
      HashFlag
Hash -> ByteString -> ByteString
SHA256.hash ByteString
m
      HashFlag
NoHash -> ByteString
m

    sign_loop :: DRBG s -> ST s (Maybe ECDSA)
sign_loop DRBG s
g = do
      k <- DRBG s -> ST s Wider
forall s. DRBG s -> ST s Wider
gen_k DRBG s
g
      let mpair = do
            kg <- Wider -> Maybe Projective
_mul Wider
k
            let Affine (S.to . C.retr -> r) _ = affine kg
                ki = Montgomery -> Montgomery
S.inv (Wider -> Montgomery
S.to Wider
k)
                s  = (Montgomery
hm Montgomery -> Montgomery -> Montgomery
forall a. Num a => a -> a -> a
+ Montgomery
d Montgomery -> Montgomery -> Montgomery
forall a. Num a => a -> a -> a
* Montgomery
r) Montgomery -> Montgomery -> Montgomery
forall a. Num a => a -> a -> a
* Montgomery
ki
            pure $! (S.retr r, S.retr s)
      case mpair of
        Maybe (Wider, Wider)
Nothing -> Maybe ECDSA -> ST s (Maybe ECDSA)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ECDSA
forall a. Maybe a
Nothing
        Just (Wider
r, Wider
s)
          | Wider -> Wider -> Bool
W.eq_vartime Wider
r Wider
0 -> DRBG s -> ST s (Maybe ECDSA)
sign_loop DRBG s
g -- negligible probability
          | Bool
otherwise ->
              let !sig :: Maybe ECDSA
sig = ECDSA -> Maybe ECDSA
forall a. a -> Maybe a
Just (ECDSA -> Maybe ECDSA) -> ECDSA -> Maybe ECDSA
forall a b. (a -> b) -> a -> b
$! Wider -> Wider -> ECDSA
ECDSA Wider
r Wider
s
              in  case SigType
ty of
                    SigType
Unrestricted -> Maybe ECDSA -> ST s (Maybe ECDSA)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ECDSA
sig
                    SigType
LowS -> Maybe ECDSA -> ST s (Maybe ECDSA)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ECDSA -> ECDSA) -> Maybe ECDSA -> Maybe ECDSA
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ECDSA -> ECDSA
low Maybe ECDSA
sig)
{-# INLINE _sign_ecdsa #-}

-- RFC6979 sec 3.3b
gen_k :: DRBG.DRBG s -> ST s Wider
gen_k :: forall s. DRBG s -> ST s Wider
gen_k DRBG s
g = DRBG (PrimState (ST s)) -> ST s Wider
forall {m :: * -> *}. PrimMonad m => DRBG (PrimState m) -> m Wider
loop DRBG s
DRBG (PrimState (ST s))
g where
  loop :: DRBG (PrimState m) -> m Wider
loop DRBG (PrimState m)
drbg = do
    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 = ByteString -> Wider
bits2int ByteString
bytes
    case W.cmp_vartime can _CURVE_Q of
      Ordering
LT -> Wider -> m Wider
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Wider
can
      Ordering
_  -> DRBG (PrimState m) -> m Wider
loop DRBG (PrimState m)
drbg -- 2 ^ -128 probability
{-# INLINE gen_k #-}

-- | Verify a "low-s" ECDSA signature for the provided message and
--   public key,
--
--   Fails to verify otherwise-valid "high-s" signatures. If you need to
--   verify generic ECDSA signatures, use 'verify_ecdsa_unrestricted'.
--
--   >>> verify_ecdsa msg pub valid_sig
--   True
--   >>> verify_ecdsa msg pub invalid_sig
--   False
verify_ecdsa
  :: BS.ByteString -- ^ message
  -> Pub           -- ^ public key
  -> ECDSA         -- ^ signature
  -> Bool
verify_ecdsa :: ByteString -> Projective -> ECDSA -> Bool
verify_ecdsa ByteString
m Projective
p sig :: ECDSA
sig@(ECDSA Wider
_ Wider
s)
  | Choice -> Bool
CT.decide (Wider -> Wider -> Choice
W.gt Wider
s Wider
_CURVE_QH) = 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 Wider
_ Wider
s)
  | Choice -> Bool
CT.decide (Wider -> Wider -> Choice
W.gt Wider
s Wider
_CURVE_QH) = 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 = (Wider -> Maybe Projective)
-> ByteString -> Projective -> ECDSA -> Bool
_verify_ecdsa_unrestricted (Projective -> Wider -> Maybe Projective
mul_vartime 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 = (Wider -> Maybe Projective)
-> ByteString -> Projective -> ECDSA -> Bool
_verify_ecdsa_unrestricted (Context -> Wider -> Maybe Projective
mul_wnaf Context
tex)

_verify_ecdsa_unrestricted
  :: (Wider -> Maybe Projective) -- partially-applied multiplication function
  -> BS.ByteString
  -> Pub
  -> ECDSA
  -> Bool
_verify_ecdsa_unrestricted :: (Wider -> Maybe Projective)
-> ByteString -> Projective -> ECDSA -> Bool
_verify_ecdsa_unrestricted Wider -> Maybe Projective
_mul ByteString
m Projective
p (ECDSA Wider
r0 Wider
s0) = Maybe () -> Bool
forall a. Maybe a -> Bool
M.isJust (Maybe () -> Bool) -> Maybe () -> Bool
forall a b. (a -> b) -> a -> b
$ do
  -- SEC1-v2 4.1.4
  let h :: ByteString
h = ByteString -> ByteString
SHA256.hash ByteString
m
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Wider -> Bool
ge Wider
r0 Bool -> Bool -> Bool
&& Wider -> Bool
ge Wider
s0)
  let r :: Montgomery
r  = Wider -> Montgomery
S.to Wider
r0
      s :: Montgomery
s  = Wider -> Montgomery
S.to Wider
s0
      e :: Montgomery
e  = Wider -> Montgomery
S.to (ByteString -> Wider
bits2int ByteString
h)
      si :: Montgomery
si = Montgomery -> Montgomery
S.inv Montgomery
s
      u1 :: Wider
u1 = Montgomery -> Wider
S.retr (Montgomery
e Montgomery -> Montgomery -> Montgomery
forall a. Num a => a -> a -> a
* Montgomery
si)
      u2 :: Wider
u2 = Montgomery -> Wider
S.retr (Montgomery
r Montgomery -> Montgomery -> Montgomery
forall a. Num a => a -> a -> a
* Montgomery
si)
  pt0 <- Wider -> Maybe Projective
_mul Wider
u1
  pt1 <- mul_vartime p u2
  let capR = Projective -> Projective -> Projective
add Projective
pt0 Projective
pt1
  guard (capR /= _CURVE_ZERO)
  let Affine (S.to . C.retr -> v) _ = affine capR
  guard (S.eq_vartime v r)
{-# INLINE _verify_ecdsa_unrestricted #-}