{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-x-partial #-}

{- |
Module: Crypto.Curve.Secp256k1.MuSig2
Copyright: (c) 2025 Jose Storopoli
License: MIT
Maintainer: Jose Storopoli <jose@storopoli.com>

Pure [BIP0327](https://github.com/bitcoin/bips/blob/master/bip-0327.mediawiki)
[MuSig2](https://github.com/bitcoin/bips/blob/master/bip-0327.mediawiki)
(partial)signatures with tweak support on the elliptic curve secp256k1.

== Usage

A sample GHCi session:

@
> -- pragmas and b16 import for illustration only; not required
> :set -XOverloadedStrings
> :set -XBangPatterns
> import qualified Data.ByteString.Base16 as B16
>
> -- import qualified
> import qualified Crypto.Curve.Secp256k1.MuSig2 as MuSig2
> import qualified Crypto.Curve.Secp256k1 as Secp256k1
>
> -- secret keys for a 2-of-2 multisig
> let sec1 = MuSig2.SecKey 0xB7E151628AED2A6ABF7158809CF4F3C762E7160F38B4DA56A784D9045190CFEF
> let sec2 = MuSig2.SecKey 0x68E151628AED2A6ABF7158809CF4F3C762E7160F38B4DA56A784D9045190CFEF
>
> -- derive public keys
> let pub1 = Secp256k1.derive_pub 0xB7E151628AED2A6ABF7158809CF4F3C762E7160F38B4DA56A784D9045190CFEF
> let pub2 = Secp256k1.derive_pub 0x68E151628AED2A6ABF7158809CF4F3C762E7160F38B4DA56A784D9045190CFEF
> let pubkeys = [pub1, pub2]
>
> -- create key aggregation context
> let keyagg_ctx = MuSig2.mkKeyAggContext pubkeys Nothing
> let agg_pk = MuSig2.aggregatedPubkey keyagg_ctx
>
> -- message to sign
> let msg = "i approve of this message"
>
> -- generate nonces for each signer
> let params1 = MuSig2.defaultSecNonceGenParams pub1
> let params2 = MuSig2.defaultSecNonceGenParams pub2
> secnonce1 <- MuSig2.secNonceGen params1
> secnonce2 <- MuSig2.secNonceGen params2
> let pubnonce1 = MuSig2.publicNonce secnonce1
> let pubnonce2 = MuSig2.publicNonce secnonce2
> let pubnonces = [pubnonce1, pubnonce2]
>
> -- aggregate nonces and create session context
> let Just aggnonce = MuSig2.aggNonces pubnonces
> let session_ctx = MuSig2.mkSessionContext aggnonce pubkeys [] msg
>
> -- each signer creates a partial signature
> let psig1 = MuSig2.sign secnonce1 sec1 session_ctx
> let psig2 = MuSig2.sign secnonce2 sec2 session_ctx
> let psigs = [psig1, psig2]
>
> -- aggregate partial signatures into final signature
> let final_sig = MuSig2.aggPartials psigs session_ctx
>
> -- verify the aggregated signature
> Secp256k1.verify_schnorr msg agg_pk final_sig
> True
@
-}
module Crypto.Curve.Secp256k1.MuSig2 (
  -- Main types and functions
  sign,
  SecKey (..),
  PartialSignature,
  partialSigVerify,
  aggPartials,
  -- MuSig2 Session
  SessionContext,
  mkSessionContext,
  -- Key aggregation
  KeyAggContext,
  mkKeyAggContext,
  aggregatedPubkey,
  -- tweak functions
  applyTweak,
  Tweak (..),
  sortPublicKeys,
  -- nonces
  SecNonce (..),
  mkSecNonce,
  SecNonceGenParams (..),
  defaultSecNonceGenParams,
  secNonceGen,
  secNonceGenWithRand,
  PubNonce (..),
  publicNonce,
  aggNonces,
) where

import Control.Exception (ErrorCall (..), evaluate, throwIO, try)
import Crypto.Curve.Secp256k1 (Projective, Pub, add, derive_pub, modQ, mul, neg, serialize_point, _CURVE_G, _CURVE_Q, _CURVE_ZERO)
import Crypto.Curve.Secp256k1.MuSig2.Internal
import Data.Binary.Put (
  putWord32be,
  putWord64be,
  runPut,
 )
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.Foldable (toList)
import Data.List (isPrefixOf)
import Data.Maybe (fromJust, fromMaybe)
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Traversable ()
import Data.Word (Word32, Word64, Word8)
import GHC.Generics (Generic)
import System.Entropy (getEntropy)

-- | Aggregates 'PartialSignature's into a 64-byte Schnorr signature.
aggPartials ::
  (Traversable t) =>
  -- | Partial signatures.
  t PartialSignature ->
  -- | Session context.
  SessionContext ->
  -- | 64-byte Schnorr signature.
  ByteString
aggPartials :: forall (t :: * -> *).
Traversable t =>
t Integer -> SessionContext -> ByteString
aggPartials t Integer
partials SessionContext
ctx =
  let
    publicKeys :: Seq Projective
publicKeys = SessionContext -> Seq Projective
pks SessionContext
ctx
    tweaks' :: Seq Tweak
tweaks' = SessionContext -> Seq Tweak
tweaks SessionContext
ctx
    nonce :: Projective
nonce = SessionContext -> Projective
getSigningNonce SessionContext
ctx
    e :: Integer
e = ByteString -> Integer
bytesToInteger (ByteString -> Integer) -> ByteString -> Integer
forall a b. (a -> b) -> a -> b
$ SessionContext -> ByteString
getSigningHash SessionContext
ctx
    keyCtx :: KeyAggContext
keyCtx = if Seq Tweak -> Bool
forall a. Seq a -> Bool
Seq.null Seq Tweak
tweaks' then Seq Projective -> Maybe Tweak -> KeyAggContext
forall (t :: * -> *).
Traversable t =>
t Projective -> Maybe Tweak -> KeyAggContext
mkKeyAggContext Seq Projective
publicKeys Maybe Tweak
forall a. Maybe a
Nothing else (KeyAggContext -> Tweak -> KeyAggContext)
-> KeyAggContext -> Seq Tweak -> KeyAggContext
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl KeyAggContext -> Tweak -> KeyAggContext
applyTweak (Seq Projective -> Maybe Tweak -> KeyAggContext
forall (t :: * -> *).
Traversable t =>
t Projective -> Maybe Tweak -> KeyAggContext
mkKeyAggContext Seq Projective
publicKeys Maybe Tweak
forall a. Maybe a
Nothing) Seq Tweak
tweaks'
    aggPk :: Projective
aggPk = KeyAggContext -> Projective
q KeyAggContext
keyCtx
    taccVal :: Integer
taccVal = Integer -> (Tweak -> Integer) -> Maybe Tweak -> Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Integer
0 Tweak -> Integer
getTweak (Maybe Tweak -> Integer) -> Maybe Tweak -> Integer
forall a b. (a -> b) -> a -> b
$ KeyAggContext -> Maybe Tweak
tacc KeyAggContext
keyCtx
    gaccVal :: Integer
gaccVal = KeyAggContext -> Integer
gacc KeyAggContext
keyCtx
    -- BIP 327: Let g = 1 if has_even_y(Q), otherwise let g = -1 mod n
    g :: Integer
g = if Projective -> Bool
isEvenPub Projective
aggPk then Integer
1 else Integer
_CURVE_Q Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
    -- Apply accumulated parity factor
    g' :: Integer
g' = Integer -> Integer
modQ (Integer
g Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
gaccVal)
    sSum :: Integer
sSum = Integer -> Integer
modQ (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ t Integer -> Integer
forall a. Num a => t a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum t Integer
partials
    -- BIP 327: Let s = s₁ + ... + sᵤ + e⋅g'⋅tacc mod n
    s :: Integer
s = Integer -> Integer
modQ (Integer
sSum Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
e Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
g' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
taccVal)
    left :: ByteString
left = Projective -> ByteString
xBytes Projective
nonce
    right :: ByteString
right = Integer -> ByteString
integerToBytes32 Integer
s
   in
    ByteString
left ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
right

{- | Compute a partial signature on a message.

The partial signature returned from this function is a potentially-zero
scalar value which can then be passed to other signers for verification
and aggregation.
-}
sign ::
  -- | Secret nonce.
  SecNonce ->
  -- | Secret key.
  SecKey ->
  -- | Session context.
  SessionContext ->
  -- | Partial signature.
  PartialSignature
sign :: SecNonce -> SecKey -> SessionContext -> Integer
sign SecNonce
secnonce SecKey
sk SessionContext
ctx =
  let
    publicKeys :: Seq Projective
publicKeys = SessionContext -> Seq Projective
pks SessionContext
ctx
    tweaks' :: Seq Tweak
tweaks' = SessionContext -> Seq Tweak
tweaks SessionContext
ctx
    nonce :: Projective
nonce = SessionContext -> Projective
getSigningNonce SessionContext
ctx
    e :: Integer
e = ByteString -> Integer
bytesToInteger (ByteString -> Integer) -> ByteString -> Integer
forall a b. (a -> b) -> a -> b
$ SessionContext -> ByteString
getSigningHash SessionContext
ctx
    keyCtx :: KeyAggContext
keyCtx = if Seq Tweak -> Bool
forall a. Seq a -> Bool
Seq.null Seq Tweak
tweaks' then Seq Projective -> Maybe Tweak -> KeyAggContext
forall (t :: * -> *).
Traversable t =>
t Projective -> Maybe Tweak -> KeyAggContext
mkKeyAggContext Seq Projective
publicKeys Maybe Tweak
forall a. Maybe a
Nothing else (KeyAggContext -> Tweak -> KeyAggContext)
-> KeyAggContext -> Seq Tweak -> KeyAggContext
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl KeyAggContext -> Tweak -> KeyAggContext
applyTweak (Seq Projective -> Maybe Tweak -> KeyAggContext
forall (t :: * -> *).
Traversable t =>
t Projective -> Maybe Tweak -> KeyAggContext
mkKeyAggContext Seq Projective
publicKeys Maybe Tweak
forall a. Maybe a
Nothing) Seq Tweak
tweaks'
    aggPk :: Projective
aggPk = KeyAggContext -> Projective
q KeyAggContext
keyCtx
    oddAggPk :: Bool
oddAggPk = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Projective -> Bool
isEvenPub Projective
aggPk
    gaccVal :: Integer
gaccVal = KeyAggContext -> Integer
gacc KeyAggContext
keyCtx
    k1 :: Integer
k1 = if SecNonce
secnonce.k1 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then [Char] -> Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"musig2 (sign): first secret scalar k1 is zero" else SecNonce
secnonce.k1
    k2 :: Integer
k2 = if SecNonce
secnonce.k2 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then [Char] -> Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"musig2 (sign): first secret scalar k2 is zero" else SecNonce
secnonce.k2
    d' :: Integer
d' = if SecKey -> Integer
unSecKey SecKey
sk Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then [Char] -> Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"musig2 (sign): secret key is zero" else SecKey -> Integer
unSecKey SecKey
sk
    -- `d` is negated if exactly one of the parity accumulator OR the aggregated pubkey has odd parity.
    -- gaccVal == 1 means no negation, gaccVal == n-1 means negation
    parityFromGacc :: Bool
parityFromGacc = Integer
gaccVal Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
1
    d :: Integer
d = if Bool
parityFromGacc Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
oddAggPk then Integer
_CURVE_Q Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
d' else Integer
d'
    p :: Projective
p = Integer -> Projective
derive_pub Integer
d' -- Use original secret key for public key derivation
    a :: Integer
a = Projective -> Seq Projective -> Integer
computeKeyAggCoef Projective
p Seq Projective
publicKeys
    -- if has_even_Y(R):
    --   k = k1 + b*k2
    -- else:
    --   k = (n-k1) + b(n-k2)
    --     = n - (k1 + b*k2)
    b :: Integer
b = SessionContext -> Integer
getSigningNonceCoeff SessionContext
ctx
    k :: Integer
k = if Projective -> Bool
isEvenPub Projective
nonce then Integer
k1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
k2 else Integer
_CURVE_Q Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (Integer
k1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
k2)
    s :: Integer
s = Integer -> Integer
modQ (Integer
k Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
e Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
d)
    pubNonce' :: PubNonce
pubNonce' = Projective -> Projective -> PubNonce
PubNonce (Projective -> Integer -> Projective
mul Projective
_CURVE_G SecNonce
secnonce.k1) (Projective -> Integer -> Projective
mul Projective
_CURVE_G SecNonce
secnonce.k2)
   in
    if Integer -> PubNonce -> Projective -> SessionContext -> Bool
partialSigVerifyInternal Integer
s PubNonce
pubNonce' Projective
p SessionContext
ctx then Integer
s else [Char] -> Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"musig2 (sign): could not verify partial signature against public nonce, public key and session context"

{- | A partial signature which is a scalar in the range \(0 \leq x < n\) where
\(n\) is the curve order.
-}
type PartialSignature = Integer

-- | Verifies a 'PartialSignature'.
partialSigVerify ::
  (Traversable t) =>
  -- | Partial signature to verify.
  PartialSignature ->
  -- | 'PubNonce's
  t PubNonce ->
  -- | 'Pub'lic keys.
  t Pub ->
  -- | 'Tweak's
  t Tweak ->
  -- | Message.
  ByteString ->
  -- | Index of the signer.
  Int ->
  -- | If the partial signature is valid.
  Bool
partialSigVerify :: forall (t :: * -> *).
Traversable t =>
Integer
-> t PubNonce
-> t Projective
-> t Tweak
-> ByteString
-> Int
-> Bool
partialSigVerify Integer
partial t PubNonce
nonces t Projective
pks t Tweak
tweaks ByteString
msg Int
idx =
  let aggNonce :: PubNonce
aggNonce = Maybe PubNonce -> PubNonce
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PubNonce -> PubNonce) -> Maybe PubNonce -> PubNonce
forall a b. (a -> b) -> a -> b
$ t PubNonce -> Maybe PubNonce
forall (t :: * -> *). Traversable t => t PubNonce -> Maybe PubNonce
aggNonces t PubNonce
nonces
      ctx :: SessionContext
ctx = PubNonce -> t Projective -> t Tweak -> ByteString -> SessionContext
forall (t :: * -> *).
Traversable t =>
PubNonce -> t Projective -> t Tweak -> ByteString -> SessionContext
mkSessionContext PubNonce
aggNonce t Projective
pks t Tweak
tweaks ByteString
msg
      noncesList :: [PubNonce]
noncesList = t PubNonce -> [PubNonce]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t PubNonce
nonces
      pk :: Projective
pk = if Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< t Projective -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t Projective
pks then t Projective -> [Projective]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Projective
pks [Projective] -> Int -> Projective
forall a. HasCallStack => [a] -> Int -> a
!! Int
idx else [Char] -> Projective
forall a. HasCallStack => [Char] -> a
error [Char]
"musig2 (partialSigVerify): signer index out of range of the list of public keys"
      pubnonce :: PubNonce
pubnonce = if Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [PubNonce] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PubNonce]
noncesList then [PubNonce]
noncesList [PubNonce] -> Int -> PubNonce
forall a. HasCallStack => [a] -> Int -> a
!! Int
idx else [Char] -> PubNonce
forall a. HasCallStack => [Char] -> a
error [Char]
"musig2 (partialSigVerify): signer index out of range of the list of public nonces"
   in Integer -> PubNonce -> Projective -> SessionContext -> Bool
partialSigVerifyInternal Integer
partial PubNonce
pubnonce Projective
pk SessionContext
ctx

{- | Verifies a 'PartialSignature'.

== WARNING

Internal function you should probably be using 'partialSigVerify' instead.
-}
partialSigVerifyInternal ::
  -- | Partial signature to verify.
  PartialSignature ->
  -- | Public nonce.
  PubNonce ->
  -- | 'Pub'lic key.
  Pub ->
  -- | MuSig2 session context.
  SessionContext ->
  -- | If the partial signature is valid.
  Bool
partialSigVerifyInternal :: Integer -> PubNonce -> Projective -> SessionContext -> Bool
partialSigVerifyInternal Integer
partial PubNonce
pubnonce Projective
pk SessionContext
ctx =
  let
    publicKeys :: Seq Projective
publicKeys = SessionContext -> Seq Projective
pks SessionContext
ctx
    tweaks' :: Seq Tweak
tweaks' = SessionContext -> Seq Tweak
tweaks SessionContext
ctx
    keyCtx :: KeyAggContext
keyCtx = if Seq Tweak -> Bool
forall a. Seq a -> Bool
Seq.null Seq Tweak
tweaks' then Seq Projective -> Maybe Tweak -> KeyAggContext
forall (t :: * -> *).
Traversable t =>
t Projective -> Maybe Tweak -> KeyAggContext
mkKeyAggContext Seq Projective
publicKeys Maybe Tweak
forall a. Maybe a
Nothing else (KeyAggContext -> Tweak -> KeyAggContext)
-> KeyAggContext -> Seq Tweak -> KeyAggContext
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl KeyAggContext -> Tweak -> KeyAggContext
applyTweak (Seq Projective -> Maybe Tweak -> KeyAggContext
forall (t :: * -> *).
Traversable t =>
t Projective -> Maybe Tweak -> KeyAggContext
mkKeyAggContext Seq Projective
publicKeys Maybe Tweak
forall a. Maybe a
Nothing) Seq Tweak
tweaks'
    aggPk :: Projective
aggPk = KeyAggContext -> Projective
q KeyAggContext
keyCtx
    oddAggPk :: Bool
oddAggPk = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Projective -> Bool
isEvenPub Projective
aggPk
    gaccVal :: Integer
gaccVal = KeyAggContext -> Integer
gacc KeyAggContext
keyCtx
    e :: Integer
e = ByteString -> Integer
bytesToInteger (ByteString -> Integer) -> ByteString -> Integer
forall a b. (a -> b) -> a -> b
$ SessionContext -> ByteString
getSigningHash SessionContext
ctx
    r1' :: Projective
r1' = PubNonce
pubnonce.r1
    r2' :: Projective
r2' = PubNonce
pubnonce.r2
    b :: Integer
b = SessionContext -> Integer
getSigningNonceCoeff SessionContext
ctx
    finalNonce :: Projective
finalNonce = SessionContext -> Projective
getSigningNonce SessionContext
ctx -- This is the final aggregate nonce used for evenness check
    s :: Integer
s = if Integer
partial Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Integer
partial Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
_CURVE_Q then [Char] -> Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"musig2 (partialSigVerifyInternal): partial signature must be within curve order." else Integer
partial
    -- Reconstruct the individual's effective nonce: R_s1 + b * R_s2
    re' :: Projective
re' = Projective -> Projective -> Projective
add Projective
r1' (Projective -> Projective) -> Projective -> Projective
forall a b. (a -> b) -> a -> b
$ Projective -> Integer -> Projective
mul Projective
r2' Integer
b
    -- Negate individual nonce if final aggregate nonce has odd Y
    re :: Projective
re = if Projective -> Bool
isEvenPub Projective
finalNonce then Projective
re' else Projective -> Projective
neg Projective
re'
    a :: Integer
a = Projective -> Seq Projective -> Integer
computeKeyAggCoef Projective
pk Seq Projective
publicKeys
    -- Calculate g factor: 1 if aggregate pubkey has even Y, n-1 if odd
    g :: Integer
g = if Bool
oddAggPk then Integer
_CURVE_Q Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1 else Integer
1
    -- Apply parity accumulator: gacc is accumulated parity factor
    g' :: Integer
g' = Integer -> Integer
modQ (Integer
g Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
gaccVal)
    sG :: Projective
sG = Projective -> Integer -> Projective
mul Projective
_CURVE_G Integer
s
    sG' :: Projective
sG' = Projective
re Projective -> Projective -> Projective
`add` Projective -> Integer -> Projective
mul Projective
pk (Integer -> Integer
modQ (Integer
e Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
g'))
   in
    Projective
sG Projective -> Projective -> Bool
forall a. Eq a => a -> a -> Bool
== Projective
sG'

-- | Secret key.
newtype SecKey = SecKey Integer
  deriving (ReadPrec [SecKey]
ReadPrec SecKey
Int -> ReadS SecKey
ReadS [SecKey]
(Int -> ReadS SecKey)
-> ReadS [SecKey]
-> ReadPrec SecKey
-> ReadPrec [SecKey]
-> Read SecKey
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SecKey
readsPrec :: Int -> ReadS SecKey
$creadList :: ReadS [SecKey]
readList :: ReadS [SecKey]
$creadPrec :: ReadPrec SecKey
readPrec :: ReadPrec SecKey
$creadListPrec :: ReadPrec [SecKey]
readListPrec :: ReadPrec [SecKey]
Read, SecKey -> SecKey -> Bool
(SecKey -> SecKey -> Bool)
-> (SecKey -> SecKey -> Bool) -> Eq SecKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SecKey -> SecKey -> Bool
== :: SecKey -> SecKey -> Bool
$c/= :: SecKey -> SecKey -> Bool
/= :: SecKey -> SecKey -> Bool
Eq, Eq SecKey
Eq SecKey =>
(SecKey -> SecKey -> Ordering)
-> (SecKey -> SecKey -> Bool)
-> (SecKey -> SecKey -> Bool)
-> (SecKey -> SecKey -> Bool)
-> (SecKey -> SecKey -> Bool)
-> (SecKey -> SecKey -> SecKey)
-> (SecKey -> SecKey -> SecKey)
-> Ord SecKey
SecKey -> SecKey -> Bool
SecKey -> SecKey -> Ordering
SecKey -> SecKey -> SecKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SecKey -> SecKey -> Ordering
compare :: SecKey -> SecKey -> Ordering
$c< :: SecKey -> SecKey -> Bool
< :: SecKey -> SecKey -> Bool
$c<= :: SecKey -> SecKey -> Bool
<= :: SecKey -> SecKey -> Bool
$c> :: SecKey -> SecKey -> Bool
> :: SecKey -> SecKey -> Bool
$c>= :: SecKey -> SecKey -> Bool
>= :: SecKey -> SecKey -> Bool
$cmax :: SecKey -> SecKey -> SecKey
max :: SecKey -> SecKey -> SecKey
$cmin :: SecKey -> SecKey -> SecKey
min :: SecKey -> SecKey -> SecKey
Ord, Integer -> SecKey
SecKey -> SecKey
SecKey -> SecKey -> SecKey
(SecKey -> SecKey -> SecKey)
-> (SecKey -> SecKey -> SecKey)
-> (SecKey -> SecKey -> SecKey)
-> (SecKey -> SecKey)
-> (SecKey -> SecKey)
-> (SecKey -> SecKey)
-> (Integer -> SecKey)
-> Num SecKey
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: SecKey -> SecKey -> SecKey
+ :: SecKey -> SecKey -> SecKey
$c- :: SecKey -> SecKey -> SecKey
- :: SecKey -> SecKey -> SecKey
$c* :: SecKey -> SecKey -> SecKey
* :: SecKey -> SecKey -> SecKey
$cnegate :: SecKey -> SecKey
negate :: SecKey -> SecKey
$cabs :: SecKey -> SecKey
abs :: SecKey -> SecKey
$csignum :: SecKey -> SecKey
signum :: SecKey -> SecKey
$cfromInteger :: Integer -> SecKey
fromInteger :: Integer -> SecKey
Num, (forall x. SecKey -> Rep SecKey x)
-> (forall x. Rep SecKey x -> SecKey) -> Generic SecKey
forall x. Rep SecKey x -> SecKey
forall x. SecKey -> Rep SecKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SecKey -> Rep SecKey x
from :: forall x. SecKey -> Rep SecKey x
$cto :: forall x. Rep SecKey x -> SecKey
to :: forall x. Rep SecKey x -> SecKey
Generic)

-- | Gets the secret 'Integer' from a 'SecKey'.
unSecKey :: SecKey -> Integer
unSecKey :: SecKey -> Integer
unSecKey (SecKey Integer
int) = Integer
int

-- | Key aggregation context that holds the aggregated public key and a tweak, if applicable.
data KeyAggContext = KeyAggContext
  { KeyAggContext -> Projective
q :: Projective
  -- ^ Point representing the potentially tweaked aggregate public key: an elliptic curve point.
  , KeyAggContext -> Maybe Tweak
tacc :: Maybe Tweak
  -- ^ accumulated tweak: an integer with \(0 \leq tacc < n\) where \(n\) is the curve order. 'Nothing' means \(0\).
  , KeyAggContext -> Integer
gacc :: !Integer
  -- ^ parity accumulator: 1 means \(g = 1\), \(n-1\) means \(g = n-1\) where \(n\) is the curve order.
  }

{- | Creates a 'KeyAggContext'.

The order in which the 'Pub'keys are presented will be preserved.
A specific ordering of 'Pub'keys will uniquely determine the aggregated 'Pub'key.

If the same keys are provided again in a different sorting order, a different
aggregated 'Pub'key will result. It is recommended to sort keys ahead of time
using 'sortPublicKeys' before creating a 'KeyAggContext'.

== NOTE

Internally it validates if all keys and the resulting aggregated key are not
points at infinity, if the optional tweak is within the curve order, and if
the length of the collection of keys is not bigger than 32 bits.
-}
mkKeyAggContext ::
  (Traversable t) =>
  -- | 'Pub'keys.
  t Pub ->
  -- | Optional 'Tweak' value.
  Maybe Tweak ->
  -- | Resulting 'KeyAggContext'.
  KeyAggContext
mkKeyAggContext :: forall (t :: * -> *).
Traversable t =>
t Projective -> Maybe Tweak -> KeyAggContext
mkKeyAggContext t Projective
pks Maybe Tweak
mTweak
  | Seq Projective -> Bool
forall a. Seq a -> Bool
Seq.null Seq Projective
pks' = [Char] -> KeyAggContext
forall a. HasCallStack => [Char] -> a
error [Char]
"musig2 (mkKeyAggContext): empty public key collection"
  | Seq Projective -> Int
forall a. Seq a -> Int
Seq.length Seq Projective
pks' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
forall a. Bounded a => a
maxBound :: Word32) = [Char] -> KeyAggContext
forall a. HasCallStack => [Char] -> a
error [Char]
"musig2 (mkKeyAggContext): too many public keys (max 2^32 - 1)"
  | Projective
_CURVE_ZERO Projective -> Seq Projective -> Bool
forall a. Eq a => a -> Seq a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Seq Projective
pks' = [Char] -> KeyAggContext
forall a. HasCallStack => [Char] -> a
error [Char]
"musig2 (mkKeyAggContext): public key at point of infinity"
  | Bool -> (Tweak -> Bool) -> Maybe Tweak -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0) (Integer -> Bool) -> (Tweak -> Integer) -> Tweak -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tweak -> Integer
getTweak) Maybe Tweak
mTweak = [Char] -> KeyAggContext
forall a. HasCallStack => [Char] -> a
error [Char]
"musig2 (mkKeyAggContext): tweak must be non-negative"
  | Bool -> (Tweak -> Bool) -> Maybe Tweak -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
_CURVE_Q) (Integer -> Bool) -> (Tweak -> Integer) -> Tweak -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tweak -> Integer
getTweak) Maybe Tweak
mTweak = [Char] -> KeyAggContext
forall a. HasCallStack => [Char] -> a
error [Char]
"musig2 (mkKeyAggContext): tweak must be less than curve order"
  | Bool
otherwise = case Seq Projective -> Maybe Projective
forall (t :: * -> *).
Traversable t =>
t Projective -> Maybe Projective
aggPublicKeys Seq Projective
pks' of
      Maybe Projective
Nothing -> [Char] -> KeyAggContext
forall a. HasCallStack => [Char] -> a
error [Char]
"musig2 (mkKeyAggContext): failed to aggregate public keys"
      Just Projective
aggPk
        | Projective
aggPk Projective -> Projective -> Bool
forall a. Eq a => a -> a -> Bool
== Projective
_CURVE_ZERO -> [Char] -> KeyAggContext
forall a. HasCallStack => [Char] -> a
error [Char]
"musig2 (mkKeyAggContext): aggregated public key is point at infinity"
        | Bool
otherwise ->
            let baseCtx :: KeyAggContext
baseCtx = Projective -> Maybe Tweak -> Integer -> KeyAggContext
KeyAggContext Projective
aggPk Maybe Tweak
forall a. Maybe a
Nothing Integer
1
             in case Maybe Tweak
mTweak of
                  Maybe Tweak
Nothing -> KeyAggContext
baseCtx
                  Just Tweak
tweak -> KeyAggContext -> Tweak -> KeyAggContext
applyTweak KeyAggContext
baseCtx Tweak
tweak
 where
  pks' :: Seq Projective
pks' = [Projective] -> Seq Projective
forall a. [a] -> Seq a
Seq.fromList (t Projective -> [Projective]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Projective
pks)

-- | Session aggregation context that holds the relevant context for a MuSig2 signing session.
data SessionContext = SessionContext
  { SessionContext -> PubNonce
aggNonce :: PubNonce
  -- ^ Aggregated 'PubNonce'.
  , SessionContext -> Seq Projective
pks :: Seq Pub
  -- ^ Ordered 'Seq' of 'Pub'keys.
  , SessionContext -> Seq Tweak
tweaks :: Seq Tweak
  -- ^ 'Seq' of 'Tweak's.
  , SessionContext -> ByteString
msg :: ByteString
  -- ^ Message to be signed.
  }

{- | Creates a 'SessionContext'.

The order in which the 'Pub'keys are presented will be preserved.
A specific ordering of 'Pub'keys will uniquely determine the aggregated 'Pub'key.

If the same keys are provided again in a different sorting order, a different
aggregated 'Pub'key will result. It is recommended to sort keys ahead of time
using 'sortPublicKeys' before creating a 'SessionContext'.

== NOTE

Internally it validates if all keys, the resulting aggregated key, and the
aggregated public nonce are not points at infinity, if the tweaks are within the
curve order, and if the length of the collection of keys is not bigger than 32 bits.
-}
mkSessionContext ::
  (Traversable t) =>
  -- | Aggregated 'PubNonce'.
  PubNonce ->
  -- | 'Pub'keys.
  t Pub ->
  -- | 'Tweak's.
  t Tweak ->
  -- | Message to be signed.
  ByteString ->
  -- | Resulting 'SessionContext'.
  SessionContext
mkSessionContext :: forall (t :: * -> *).
Traversable t =>
PubNonce -> t Projective -> t Tweak -> ByteString -> SessionContext
mkSessionContext PubNonce
aggNonce t Projective
pks t Tweak
tweaks ByteString
msg
  | Seq Projective -> Bool
forall a. Seq a -> Bool
Seq.null Seq Projective
pks' = [Char] -> SessionContext
forall a. HasCallStack => [Char] -> a
error [Char]
"musig2 (mkSessionContext): empty public key collection"
  | Seq Projective -> Int
forall a. Seq a -> Int
Seq.length Seq Projective
pks' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
forall a. Bounded a => a
maxBound :: Word32) = [Char] -> SessionContext
forall a. HasCallStack => [Char] -> a
error [Char]
"musig2 (mkSessionContext): too many public keys (max 2^32 - 1)"
  | Projective
_CURVE_ZERO Projective -> Seq Projective -> Bool
forall a. Eq a => a -> Seq a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Seq Projective
pks' = [Char] -> SessionContext
forall a. HasCallStack => [Char] -> a
error [Char]
"musig2 (mkSessionContext): public key at point of infinity"
  | Seq Tweak -> Int
forall a. Seq a -> Int
Seq.length Seq Tweak
tweaks' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
forall a. Bounded a => a
maxBound :: Word32) = [Char] -> SessionContext
forall a. HasCallStack => [Char] -> a
error [Char]
"musig2 (mkSessionContext): too many tweaks (max 2^32 - 1)"
  | (Tweak -> Bool) -> Seq Tweak -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Tweak -> Bool
checkNeg Seq Tweak
tweaks' = [Char] -> SessionContext
forall a. HasCallStack => [Char] -> a
error [Char]
"musig2 (mkSessionContext): tweaks must be non-negative"
  | (Tweak -> Bool) -> Seq Tweak -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Tweak -> Bool
checkOrder Seq Tweak
tweaks' = [Char] -> SessionContext
forall a. HasCallStack => [Char] -> a
error [Char]
"musig2 (mkSessionContext): tweaks must be less than curve order"
  | Bool
otherwise = case Seq Projective -> Maybe Projective
forall (t :: * -> *).
Traversable t =>
t Projective -> Maybe Projective
aggPublicKeys Seq Projective
pks' of
      Maybe Projective
Nothing -> [Char] -> SessionContext
forall a. HasCallStack => [Char] -> a
error [Char]
"musig2 (mkSessionContext): failed to aggregate public keys"
      Just Projective
aggPk
        | Projective
aggPk Projective -> Projective -> Bool
forall a. Eq a => a -> a -> Bool
== Projective
_CURVE_ZERO -> [Char] -> SessionContext
forall a. HasCallStack => [Char] -> a
error [Char]
"musig2 (mkSessionContext): aggregated public key is point at infinity"
        | Bool
otherwise -> PubNonce
-> Seq Projective -> Seq Tweak -> ByteString -> SessionContext
SessionContext PubNonce
aggNonce Seq Projective
pks' Seq Tweak
tweaks' ByteString
msg
 where
  pks' :: Seq Projective
pks' = [Projective] -> Seq Projective
forall a. [a] -> Seq a
Seq.fromList (t Projective -> [Projective]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Projective
pks)
  tweaks' :: Seq Tweak
tweaks' = [Tweak] -> Seq Tweak
forall a. [a] -> Seq a
Seq.fromList (t Tweak -> [Tweak]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Tweak
tweaks)
  checkNeg :: Tweak -> Bool
checkNeg = (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0) (Integer -> Bool) -> (Tweak -> Integer) -> Tweak -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tweak -> Integer
getTweak
  checkOrder :: Tweak -> Bool
checkOrder = (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
_CURVE_Q) (Integer -> Bool) -> (Tweak -> Integer) -> Tweak -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tweak -> Integer
getTweak

{- | Gets the signing nonce as a 'Projective' following
[BIP327 algorithm and recommendations](https://github.com/bitcoin/bips/blob/master/bip-0327.mediawiki#dealing-with-infinity-in-nonce-aggregation).
-}
getSigningNonce :: SessionContext -> Projective
getSigningNonce :: SessionContext -> Projective
getSigningNonce SessionContext
ctx =
  let
    b :: Integer
b = SessionContext -> Integer
getSigningNonceCoeff SessionContext
ctx
    aggNonce :: PubNonce
aggNonce = SessionContext
ctx.aggNonce
    aggNonce' :: PubNonce
aggNonce' = if PubNonce
aggNonce.r1 Projective -> Projective -> Bool
forall a. Eq a => a -> a -> Bool
== Projective
_CURVE_ZERO then Projective -> Projective -> PubNonce
PubNonce Projective
_CURVE_G PubNonce
aggNonce.r2 else PubNonce
aggNonce
    finalNonce :: Projective
finalNonce = Projective -> Projective -> Projective
add PubNonce
aggNonce'.r1 (Projective -> Integer -> Projective
mul PubNonce
aggNonce'.r2 Integer
b)
   in
    if Projective
finalNonce Projective -> Projective -> Bool
forall a. Eq a => a -> a -> Bool
== Projective
_CURVE_ZERO then Projective
_CURVE_G else Projective
finalNonce

{- | Gets the signing nonce coefficient following
[BIP327 algorithm and recommendations](https://github.com/bitcoin/bips/blob/master/bip-0327.mediawiki#dealing-with-infinity-in-nonce-aggregation).
-}
getSigningNonceCoeff :: SessionContext -> Integer
getSigningNonceCoeff :: SessionContext -> Integer
getSigningNonceCoeff SessionContext
ctx =
  let
    aggNonce :: PubNonce
aggNonce = SessionContext
ctx.aggNonce
    aggNonce' :: PubNonce
aggNonce' = if PubNonce
aggNonce.r1 Projective -> Projective -> Bool
forall a. Eq a => a -> a -> Bool
== Projective
_CURVE_ZERO then Projective -> Projective -> PubNonce
PubNonce Projective
_CURVE_G PubNonce
aggNonce.r2 else PubNonce
aggNonce
    -- Apply tweaks to get the correct aggregate public key
    keyCtx :: KeyAggContext
keyCtx =
      if Seq Tweak -> Bool
forall a. Seq a -> Bool
Seq.null (SessionContext -> Seq Tweak
tweaks SessionContext
ctx)
        then Seq Projective -> Maybe Tweak -> KeyAggContext
forall (t :: * -> *).
Traversable t =>
t Projective -> Maybe Tweak -> KeyAggContext
mkKeyAggContext (SessionContext -> Seq Projective
pks SessionContext
ctx) Maybe Tweak
forall a. Maybe a
Nothing
        else (KeyAggContext -> Tweak -> KeyAggContext)
-> KeyAggContext -> Seq Tweak -> KeyAggContext
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl KeyAggContext -> Tweak -> KeyAggContext
applyTweak (Seq Projective -> Maybe Tweak -> KeyAggContext
forall (t :: * -> *).
Traversable t =>
t Projective -> Maybe Tweak -> KeyAggContext
mkKeyAggContext (SessionContext -> Seq Projective
pks SessionContext
ctx) Maybe Tweak
forall a. Maybe a
Nothing) (SessionContext -> Seq Tweak
tweaks SessionContext
ctx)
    aggPubKey :: Projective
aggPubKey = KeyAggContext -> Projective
q KeyAggContext
keyCtx
    msg :: ByteString
msg = SessionContext
ctx.msg
    nonceBytes :: ByteString
nonceBytes = Projective -> ByteString
serialize_point PubNonce
aggNonce'.r1 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Projective -> ByteString
serialize_point PubNonce
aggNonce'.r2
    qBytes :: ByteString
qBytes = Projective -> ByteString
xBytes Projective
aggPubKey
    preimage :: ByteString
preimage = ByteString
nonceBytes ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
qBytes ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
msg
   in
    ByteString -> Integer
bytesToInteger (ByteString -> Integer) -> ByteString -> Integer
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
hashTagModQ ByteString
"MuSig/noncecoef" ByteString
preimage

{- | Gets the signing challenge hash as a 'ByteString' following
[BIP327 algorithm](https://github.com/bitcoin/bips/blob/master/bip-0327.mediawiki).

Note that the signing challenge hash is the naming convention from the
[MuSig2 paper, page 6](https://eprint.iacr.org/2020/1261).
In the BIP327 it is referred as @e@.
-}
getSigningHash :: SessionContext -> ByteString
getSigningHash :: SessionContext -> ByteString
getSigningHash SessionContext
ctx =
  let
    -- Apply tweaks to get the correct aggregate public key
    keyCtx :: KeyAggContext
keyCtx =
      if Seq Tweak -> Bool
forall a. Seq a -> Bool
Seq.null (SessionContext -> Seq Tweak
tweaks SessionContext
ctx)
        then Seq Projective -> Maybe Tweak -> KeyAggContext
forall (t :: * -> *).
Traversable t =>
t Projective -> Maybe Tweak -> KeyAggContext
mkKeyAggContext (SessionContext -> Seq Projective
pks SessionContext
ctx) Maybe Tweak
forall a. Maybe a
Nothing
        else (KeyAggContext -> Tweak -> KeyAggContext)
-> KeyAggContext -> Seq Tweak -> KeyAggContext
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl KeyAggContext -> Tweak -> KeyAggContext
applyTweak (Seq Projective -> Maybe Tweak -> KeyAggContext
forall (t :: * -> *).
Traversable t =>
t Projective -> Maybe Tweak -> KeyAggContext
mkKeyAggContext (SessionContext -> Seq Projective
pks SessionContext
ctx) Maybe Tweak
forall a. Maybe a
Nothing) (SessionContext -> Seq Tweak
tweaks SessionContext
ctx)
    aggPubKey :: Projective
aggPubKey = KeyAggContext -> Projective
q KeyAggContext
keyCtx
    qBytes :: ByteString
qBytes = Projective -> ByteString
xBytes Projective
aggPubKey
    msg :: ByteString
msg = SessionContext
ctx.msg
    nonce :: Projective
nonce = SessionContext -> Projective
getSigningNonce SessionContext
ctx
    r :: ByteString
r = Projective -> ByteString
xBytes Projective
nonce
    preimage :: ByteString
preimage = ByteString
r ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
qBytes ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
msg
   in
    ByteString -> ByteString -> ByteString
hashTagModQ ByteString
"BIP0340/challenge" ByteString
preimage

-- | Tweak that can be added to an aggregated 'Pub'key.
data Tweak
  = -- | X-only tweak required by Taproot tweaking to add script paths to a Taproot output.
    -- See [BIP341](https://github.com/bitcoin/bips/blob/master/bip-0341.mediawiki).
    XOnlyTweak !Integer
  | -- | Plain tweak that can be used to derive child aggregated 'Pub'keys per
    -- [BIP32](https://github.com/bitcoin/bips/blob/master/bip-0032.mediawiki)
    PlainTweak !Integer
  deriving (ReadPrec [Tweak]
ReadPrec Tweak
Int -> ReadS Tweak
ReadS [Tweak]
(Int -> ReadS Tweak)
-> ReadS [Tweak]
-> ReadPrec Tweak
-> ReadPrec [Tweak]
-> Read Tweak
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Tweak
readsPrec :: Int -> ReadS Tweak
$creadList :: ReadS [Tweak]
readList :: ReadS [Tweak]
$creadPrec :: ReadPrec Tweak
readPrec :: ReadPrec Tweak
$creadListPrec :: ReadPrec [Tweak]
readListPrec :: ReadPrec [Tweak]
Read, Int -> Tweak -> ShowS
[Tweak] -> ShowS
Tweak -> [Char]
(Int -> Tweak -> ShowS)
-> (Tweak -> [Char]) -> ([Tweak] -> ShowS) -> Show Tweak
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Tweak -> ShowS
showsPrec :: Int -> Tweak -> ShowS
$cshow :: Tweak -> [Char]
show :: Tweak -> [Char]
$cshowList :: [Tweak] -> ShowS
showList :: [Tweak] -> ShowS
Show, Tweak -> Tweak -> Bool
(Tweak -> Tweak -> Bool) -> (Tweak -> Tweak -> Bool) -> Eq Tweak
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tweak -> Tweak -> Bool
== :: Tweak -> Tweak -> Bool
$c/= :: Tweak -> Tweak -> Bool
/= :: Tweak -> Tweak -> Bool
Eq, Eq Tweak
Eq Tweak =>
(Tweak -> Tweak -> Ordering)
-> (Tweak -> Tweak -> Bool)
-> (Tweak -> Tweak -> Bool)
-> (Tweak -> Tweak -> Bool)
-> (Tweak -> Tweak -> Bool)
-> (Tweak -> Tweak -> Tweak)
-> (Tweak -> Tweak -> Tweak)
-> Ord Tweak
Tweak -> Tweak -> Bool
Tweak -> Tweak -> Ordering
Tweak -> Tweak -> Tweak
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Tweak -> Tweak -> Ordering
compare :: Tweak -> Tweak -> Ordering
$c< :: Tweak -> Tweak -> Bool
< :: Tweak -> Tweak -> Bool
$c<= :: Tweak -> Tweak -> Bool
<= :: Tweak -> Tweak -> Bool
$c> :: Tweak -> Tweak -> Bool
> :: Tweak -> Tweak -> Bool
$c>= :: Tweak -> Tweak -> Bool
>= :: Tweak -> Tweak -> Bool
$cmax :: Tweak -> Tweak -> Tweak
max :: Tweak -> Tweak -> Tweak
$cmin :: Tweak -> Tweak -> Tweak
min :: Tweak -> Tweak -> Tweak
Ord, (forall x. Tweak -> Rep Tweak x)
-> (forall x. Rep Tweak x -> Tweak) -> Generic Tweak
forall x. Rep Tweak x -> Tweak
forall x. Tweak -> Rep Tweak x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Tweak -> Rep Tweak x
from :: forall x. Tweak -> Rep Tweak x
$cto :: forall x. Rep Tweak x -> Tweak
to :: forall x. Rep Tweak x -> Tweak
Generic)

-- | Retrieves the 'Integer' from 'Tweak'.
getTweak :: Tweak -> Integer
getTweak :: Tweak -> Integer
getTweak (XOnlyTweak Integer
int) = Integer
int
getTweak (PlainTweak Integer
int) = Integer
int

-- | Applies a tweak to a KeyAggContext and returns a new KeyAggContext following [BIP327](https://github.com/bitcoin/bips/blob/master/bip-0327.mediawiki).
applyTweak :: KeyAggContext -> Tweak -> KeyAggContext
applyTweak :: KeyAggContext -> Tweak -> KeyAggContext
applyTweak KeyAggContext
ctx Tweak
newTweak =
  let pubkey :: Projective
pubkey = KeyAggContext -> Projective
q KeyAggContext
ctx
      mAccTweak :: Maybe Tweak
mAccTweak = KeyAggContext -> Maybe Tweak
tacc KeyAggContext
ctx
      gaccIn :: Integer
gaccIn = KeyAggContext -> Integer
gacc KeyAggContext
ctx
      accTweakVal :: Integer
accTweakVal = Integer -> (Tweak -> Integer) -> Maybe Tweak -> Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Integer
0 Tweak -> Integer
getTweak Maybe Tweak
mAccTweak
   in case Tweak
newTweak of
        PlainTweak Integer
t ->
          -- Plain tweak: g = 1, Q' = g*Q + t*G, tacc' = t + g*tacc, gacc' = g*gacc
          let g :: Integer
g = Integer
1
              tweakedPk :: Projective
tweakedPk = Projective -> Projective -> Projective
add (Projective -> Integer -> Projective
mul Projective
pubkey Integer
g) (Projective -> Integer -> Projective
mul Projective
_CURVE_G Integer
t)
              newAccTweak :: Integer
newAccTweak = Integer -> Integer
modQ (Integer
t Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Integer
g Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
accTweakVal))
              newGacc :: Integer
newGacc = Integer -> Integer
modQ (Integer
g Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
gaccIn)
           in if Projective
tweakedPk Projective -> Projective -> Bool
forall a. Eq a => a -> a -> Bool
== Projective
_CURVE_ZERO
                then [Char] -> KeyAggContext
forall a. HasCallStack => [Char] -> a
error [Char]
"musig2 (applyTweak): result of tweaking cannot be infinity"
                else KeyAggContext
ctx{q = tweakedPk, tacc = Just (PlainTweak newAccTweak), gacc = newGacc}
        XOnlyTweak Integer
t ->
          -- X-only tweak: g = 1 if even Y, g = n-1 if odd Y, tacc' = t + g*tacc
          let g :: Integer
g = if Projective -> Bool
isEvenPub Projective
pubkey then Integer
1 else Integer
_CURVE_Q Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
              tweakedPk :: Projective
tweakedPk = Projective -> Projective -> Projective
add (Projective -> Integer -> Projective
mul Projective
pubkey Integer
g) (Projective -> Integer -> Projective
mul Projective
_CURVE_G Integer
t)
              newAccTweak :: Integer
newAccTweak = Integer -> Integer
modQ (Integer
t Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Integer
g Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
accTweakVal))
              newGacc :: Integer
newGacc = Integer -> Integer
modQ (Integer
g Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
gaccIn)
           in if Projective
tweakedPk Projective -> Projective -> Bool
forall a. Eq a => a -> a -> Bool
== Projective
_CURVE_ZERO
                then [Char] -> KeyAggContext
forall a. HasCallStack => [Char] -> a
error [Char]
"musig2 (applyTweak): result of tweaking cannot be infinity"
                else KeyAggContext
ctx{q = tweakedPk, tacc = Just (XOnlyTweak newAccTweak), gacc = newGacc}

-- | Manual 'Ord' implementation of 'Projective' for lexicography sorting.
instance Ord Projective where
  compare :: Projective -> Projective -> Ordering
compare Projective
x Projective
y = ByteString -> ByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Projective -> ByteString
serialize_point Projective
x) (Projective -> ByteString
serialize_point Projective
y)

-- | 'Data.Semigroup' implementation of 'Projective' for algebraic sound combination of points.
instance Semigroup Projective where
  (<>) :: Projective -> Projective -> Projective
  <> :: Projective -> Projective -> Projective
(<>) = Projective -> Projective -> Projective
add

-- | 'Data.Monoid' implementation of 'Projective' for algebraic sound combination of points.
instance Monoid Projective where
  mempty :: Projective
  mempty :: Projective
mempty = Projective
_CURVE_ZERO

-- | Lexicographically 'Data.Sequence.sort's a 'Traversable' of 'Pub'keys.
sortPublicKeys :: (Traversable t) => t Pub -> Seq Pub
sortPublicKeys :: forall (t :: * -> *).
Traversable t =>
t Projective -> Seq Projective
sortPublicKeys = Seq Projective -> Seq Projective
forall a. Ord a => Seq a -> Seq a
Seq.sort (Seq Projective -> Seq Projective)
-> (t Projective -> Seq Projective)
-> t Projective
-> Seq Projective
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Projective] -> Seq Projective
forall a. [a] -> Seq a
Seq.fromList ([Projective] -> Seq Projective)
-> (t Projective -> [Projective]) -> t Projective -> Seq Projective
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t Projective -> [Projective]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

-- | Gets the aggregated public key from a 'KeyAggContext'.
aggregatedPubkey :: KeyAggContext -> Pub
aggregatedPubkey :: KeyAggContext -> Projective
aggregatedPubkey = KeyAggContext -> Projective
q

{- | Secret nonce.

The secret nonce provides randomness, blinding a signer's private key when
signing. It is imperative that the same 'SecNonce' is not used to sign more
than one message with the same key, as this would allow an observer to
compute the private key used to create both signatures.

If you want to follow
[BIP327](https://github.com/bitcoin/bips/blob/master/bip-0327.mediawiki)
suggestions, then use 'secNonceGen' otherwise use 'mkSecNonce'.
-}
data SecNonce = SecNonce
  { SecNonce -> Integer
k1 :: !Integer
  -- ^ First secret scalar.
  , SecNonce -> Integer
k2 :: !Integer
  -- ^ Second secret scalar.
  }
  deriving (ReadPrec [SecNonce]
ReadPrec SecNonce
Int -> ReadS SecNonce
ReadS [SecNonce]
(Int -> ReadS SecNonce)
-> ReadS [SecNonce]
-> ReadPrec SecNonce
-> ReadPrec [SecNonce]
-> Read SecNonce
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SecNonce
readsPrec :: Int -> ReadS SecNonce
$creadList :: ReadS [SecNonce]
readList :: ReadS [SecNonce]
$creadPrec :: ReadPrec SecNonce
readPrec :: ReadPrec SecNonce
$creadListPrec :: ReadPrec [SecNonce]
readListPrec :: ReadPrec [SecNonce]
Read, SecNonce -> SecNonce -> Bool
(SecNonce -> SecNonce -> Bool)
-> (SecNonce -> SecNonce -> Bool) -> Eq SecNonce
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SecNonce -> SecNonce -> Bool
== :: SecNonce -> SecNonce -> Bool
$c/= :: SecNonce -> SecNonce -> Bool
/= :: SecNonce -> SecNonce -> Bool
Eq, Eq SecNonce
Eq SecNonce =>
(SecNonce -> SecNonce -> Ordering)
-> (SecNonce -> SecNonce -> Bool)
-> (SecNonce -> SecNonce -> Bool)
-> (SecNonce -> SecNonce -> Bool)
-> (SecNonce -> SecNonce -> Bool)
-> (SecNonce -> SecNonce -> SecNonce)
-> (SecNonce -> SecNonce -> SecNonce)
-> Ord SecNonce
SecNonce -> SecNonce -> Bool
SecNonce -> SecNonce -> Ordering
SecNonce -> SecNonce -> SecNonce
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SecNonce -> SecNonce -> Ordering
compare :: SecNonce -> SecNonce -> Ordering
$c< :: SecNonce -> SecNonce -> Bool
< :: SecNonce -> SecNonce -> Bool
$c<= :: SecNonce -> SecNonce -> Bool
<= :: SecNonce -> SecNonce -> Bool
$c> :: SecNonce -> SecNonce -> Bool
> :: SecNonce -> SecNonce -> Bool
$c>= :: SecNonce -> SecNonce -> Bool
>= :: SecNonce -> SecNonce -> Bool
$cmax :: SecNonce -> SecNonce -> SecNonce
max :: SecNonce -> SecNonce -> SecNonce
$cmin :: SecNonce -> SecNonce -> SecNonce
min :: SecNonce -> SecNonce -> SecNonce
Ord, (forall x. SecNonce -> Rep SecNonce x)
-> (forall x. Rep SecNonce x -> SecNonce) -> Generic SecNonce
forall x. Rep SecNonce x -> SecNonce
forall x. SecNonce -> Rep SecNonce x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SecNonce -> Rep SecNonce x
from :: forall x. SecNonce -> Rep SecNonce x
$cto :: forall x. Rep SecNonce x -> SecNonce
to :: forall x. Rep SecNonce x -> SecNonce
Generic)

{- | Generates a 'SecNonce' using only the system's underlying Cryptographic Secure
Pseudorandom Number Generator (CSPRNG) using the
[@entropy@](https://hackage.haskell.org/package/entropy) package.

== WARNING

Make sure that you have access to a good CSPRNG in your system before calling
this function.

Note that this does not follow the
[BIP327](https://github.com/bitcoin/bips/blob/master/bip-0327.mediawiki)
algorithm.
-}
mkSecNonce :: IO SecNonce
mkSecNonce :: IO SecNonce
mkSecNonce = do
  ByteString
bytes <- Int -> IO ByteString
getEntropy Int
64 -- 64 bytes = 512 bits for two 256-bit scalars
  let k1' :: Integer
k1' = ByteString -> Integer
bytesToInteger (Int -> ByteString -> ByteString
BS.take Int
32 ByteString
bytes)
      k2' :: Integer
k2' = ByteString -> Integer
bytesToInteger (Int -> ByteString -> ByteString
BS.drop Int
32 ByteString
bytes)
  SecNonce -> IO SecNonce
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SecNonce{k1 :: Integer
k1 = Integer
k1', k2 :: Integer
k2 = Integer
k2'}

-- | Required and Optional data to generate a 'SecNonce'.
data SecNonceGenParams = SecNonceGenParams
  { SecNonceGenParams -> Projective
_pk :: Pub
  -- ^ 'Pub'lic key: mandatory.
  , SecNonceGenParams -> Maybe SecKey
_sk :: Maybe SecKey
  -- ^ Secret key: optional.
  , SecNonceGenParams -> Maybe Projective
_aggpk :: Maybe Pub
  -- ^ Aggregated 'Pub'lic key: optional.
  , SecNonceGenParams -> Maybe ByteString
_msg :: Maybe ByteString
  -- ^ Message: optional.
  , SecNonceGenParams -> Maybe ByteString
_extraIn :: Maybe ByteString
  -- Auxiliary input: optional.
  }
  deriving (SecNonceGenParams -> SecNonceGenParams -> Bool
(SecNonceGenParams -> SecNonceGenParams -> Bool)
-> (SecNonceGenParams -> SecNonceGenParams -> Bool)
-> Eq SecNonceGenParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SecNonceGenParams -> SecNonceGenParams -> Bool
== :: SecNonceGenParams -> SecNonceGenParams -> Bool
$c/= :: SecNonceGenParams -> SecNonceGenParams -> Bool
/= :: SecNonceGenParams -> SecNonceGenParams -> Bool
Eq, Eq SecNonceGenParams
Eq SecNonceGenParams =>
(SecNonceGenParams -> SecNonceGenParams -> Ordering)
-> (SecNonceGenParams -> SecNonceGenParams -> Bool)
-> (SecNonceGenParams -> SecNonceGenParams -> Bool)
-> (SecNonceGenParams -> SecNonceGenParams -> Bool)
-> (SecNonceGenParams -> SecNonceGenParams -> Bool)
-> (SecNonceGenParams -> SecNonceGenParams -> SecNonceGenParams)
-> (SecNonceGenParams -> SecNonceGenParams -> SecNonceGenParams)
-> Ord SecNonceGenParams
SecNonceGenParams -> SecNonceGenParams -> Bool
SecNonceGenParams -> SecNonceGenParams -> Ordering
SecNonceGenParams -> SecNonceGenParams -> SecNonceGenParams
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SecNonceGenParams -> SecNonceGenParams -> Ordering
compare :: SecNonceGenParams -> SecNonceGenParams -> Ordering
$c< :: SecNonceGenParams -> SecNonceGenParams -> Bool
< :: SecNonceGenParams -> SecNonceGenParams -> Bool
$c<= :: SecNonceGenParams -> SecNonceGenParams -> Bool
<= :: SecNonceGenParams -> SecNonceGenParams -> Bool
$c> :: SecNonceGenParams -> SecNonceGenParams -> Bool
> :: SecNonceGenParams -> SecNonceGenParams -> Bool
$c>= :: SecNonceGenParams -> SecNonceGenParams -> Bool
>= :: SecNonceGenParams -> SecNonceGenParams -> Bool
$cmax :: SecNonceGenParams -> SecNonceGenParams -> SecNonceGenParams
max :: SecNonceGenParams -> SecNonceGenParams -> SecNonceGenParams
$cmin :: SecNonceGenParams -> SecNonceGenParams -> SecNonceGenParams
min :: SecNonceGenParams -> SecNonceGenParams -> SecNonceGenParams
Ord, (forall x. SecNonceGenParams -> Rep SecNonceGenParams x)
-> (forall x. Rep SecNonceGenParams x -> SecNonceGenParams)
-> Generic SecNonceGenParams
forall x. Rep SecNonceGenParams x -> SecNonceGenParams
forall x. SecNonceGenParams -> Rep SecNonceGenParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SecNonceGenParams -> Rep SecNonceGenParams x
from :: forall x. SecNonceGenParams -> Rep SecNonceGenParams x
$cto :: forall x. Rep SecNonceGenParams x -> SecNonceGenParams
to :: forall x. Rep SecNonceGenParams x -> SecNonceGenParams
Generic)

-- | Default approach to generate 'SecNonce's with the only required 'Pub'lic key.
defaultSecNonceGenParams :: Pub -> SecNonceGenParams
defaultSecNonceGenParams :: Projective -> SecNonceGenParams
defaultSecNonceGenParams Projective
pk =
  SecNonceGenParams
    { _pk :: Projective
_pk = Projective
pk
    , _sk :: Maybe SecKey
_sk = Maybe SecKey
forall a. Maybe a
Nothing
    , _aggpk :: Maybe Projective
_aggpk = Maybe Projective
forall a. Maybe a
Nothing
    , _msg :: Maybe ByteString
_msg = Maybe ByteString
forall a. Maybe a
Nothing
    , _extraIn :: Maybe ByteString
_extraIn = Maybe ByteString
forall a. Maybe a
Nothing
    }

{- | Generates a 'SecNonce' using the inputs and algorithms from
[BIP327](https://github.com/bitcoin/bips/blob/master/bip-0327.mediawiki).
-}
secNonceGen :: SecNonceGenParams -> IO SecNonce
secNonceGen :: SecNonceGenParams -> IO SecNonce
secNonceGen SecNonceGenParams
params = IO SecNonce
loop
 where
  loop :: IO SecNonce
loop = do
    ByteString
rand <- Int -> IO ByteString
getEntropy Int
32
    Either ErrorCall SecNonce
eres <- IO SecNonce -> IO (Either ErrorCall SecNonce)
forall e a. Exception e => IO a -> IO (Either e a)
try (SecNonce -> IO SecNonce
forall a. a -> IO a
evaluate (ByteString -> SecNonceGenParams -> SecNonce
secNonceGenWithRand ByteString
rand SecNonceGenParams
params))
    case Either ErrorCall SecNonce
eres of
      Right SecNonce
sn -> SecNonce -> IO SecNonce
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SecNonce
sn
      Left (ErrorCall [Char]
msg) | [Char]
"musig2 (nonceGen): zero nonce generated" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
msg -> IO SecNonce
loop
      Left ErrorCall
e -> ErrorCall -> IO SecNonce
forall e a. Exception e => e -> IO a
throwIO ErrorCall
e

{- | Generates a 'SecNonce' using a given random 'ByteString' and the inputs and
algorithms from
[BIP327](https://github.com/bitcoin/bips/blob/master/bip-0327.mediawiki).

== WARNING

You should probably use 'secNonceGen'.
Use this function if you really have a randomly-generated 'ByteString'.
-}
secNonceGenWithRand :: ByteString -> SecNonceGenParams -> SecNonce
secNonceGenWithRand :: ByteString -> SecNonceGenParams -> SecNonce
secNonceGenWithRand ByteString
rand _params :: SecNonceGenParams
_params@(SecNonceGenParams{_pk :: SecNonceGenParams -> Projective
_pk = Projective
pkPoint, Maybe ByteString
Maybe Projective
Maybe SecKey
_sk :: SecNonceGenParams -> Maybe SecKey
_aggpk :: SecNonceGenParams -> Maybe Projective
_msg :: SecNonceGenParams -> Maybe ByteString
_extraIn :: SecNonceGenParams -> Maybe ByteString
_sk :: Maybe SecKey
_aggpk :: Maybe Projective
_msg :: Maybe ByteString
_extraIn :: Maybe ByteString
..}) =
  let
    -- Step 2: Optional sk XOR (with tagged hash for safety)
    rand' :: ByteString
rand' = case Maybe SecKey
_sk of
      Just (SecKey Integer
skScalar) ->
        let skBytes :: ByteString
skBytes = Integer -> ByteString
integerToBytes32 Integer
skScalar
            auxHash :: ByteString
auxHash = ByteString -> ByteString -> ByteString
hashTag ByteString
"MuSig/aux" ByteString
rand
         in ByteString -> ByteString -> ByteString
xorByteStrings ByteString
skBytes ByteString
auxHash
      Maybe SecKey
Nothing -> ByteString
rand

    -- Steps 3-5: Defaults for optionals
    pkBytes :: ByteString
pkBytes = Projective -> ByteString
serialize_point Projective
pkPoint
    aggpkBytes :: ByteString
aggpkBytes = ByteString
-> (Projective -> ByteString) -> Maybe Projective -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" (Int -> ByteString -> ByteString
BS.drop Int
1 (ByteString -> ByteString)
-> (Projective -> ByteString) -> Projective -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Projective -> ByteString
serialize_point) Maybe Projective
_aggpk
    msgPrefixed :: ByteString
msgPrefixed = case Maybe ByteString
_msg of
      Maybe ByteString
Nothing -> Word8 -> ByteString
BS.singleton Word8
0
      Just ByteString
m ->
        let len :: Word64
len = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
m) :: Word64
            lenBytes :: ByteString
lenBytes = LazyByteString -> ByteString
LBS.toStrict (LazyByteString -> ByteString)
-> (Put -> LazyByteString) -> Put -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> LazyByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Word64 -> Put
putWord64be Word64
len
         in Word8 -> ByteString
BS.singleton Word8
1 ByteString -> ByteString -> ByteString
`BS.append` ByteString
lenBytes ByteString -> ByteString -> ByteString
`BS.append` ByteString
m
    extraInBytes :: ByteString
extraInBytes = ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"" Maybe ByteString
_extraIn

    -- Steps 6-8: Hash for k1/k2
    mkInput :: Word8 -> ByteString
    mkInput :: Word8 -> ByteString
mkInput Word8
i =
      ByteString
rand'
        ByteString -> ByteString -> ByteString
`BS.append` (Word8 -> ByteString
BS.singleton (Word8 -> ByteString) -> (Int -> Word8) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> ByteString) -> Int -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
pkBytes)
        ByteString -> ByteString -> ByteString
`BS.append` ByteString
pkBytes
        ByteString -> ByteString -> ByteString
`BS.append` (Word8 -> ByteString
BS.singleton (Word8 -> ByteString) -> (Int -> Word8) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> ByteString) -> Int -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
aggpkBytes)
        ByteString -> ByteString -> ByteString
`BS.append` ByteString
aggpkBytes
        ByteString -> ByteString -> ByteString
`BS.append` ByteString
msgPrefixed
        ByteString -> ByteString -> ByteString
`BS.append` (LazyByteString -> ByteString
LBS.toStrict (LazyByteString -> ByteString)
-> (Int -> LazyByteString) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> LazyByteString
runPut (Put -> LazyByteString) -> (Int -> Put) -> Int -> LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Put
putWord32be (Word32 -> Put) -> (Int -> Word32) -> Int -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> ByteString) -> Int -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
extraInBytes)
        ByteString -> ByteString -> ByteString
`BS.append` ByteString
extraInBytes
        ByteString -> ByteString -> ByteString
`BS.append` Word8 -> ByteString
BS.singleton Word8
i

    k1' :: Integer
k1' = Integer -> Integer
modQ (Integer -> Integer)
-> (ByteString -> Integer) -> ByteString -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Integer
bytesToInteger (ByteString -> Integer) -> ByteString -> Integer
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
hashTag ByteString
"MuSig/nonce" (Word8 -> ByteString
mkInput Word8
0)
    k2' :: Integer
k2' = Integer -> Integer
modQ (Integer -> Integer)
-> (ByteString -> Integer) -> ByteString -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Integer
bytesToInteger (ByteString -> Integer) -> ByteString -> Integer
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
hashTag ByteString
"MuSig/nonce" (Word8 -> ByteString
mkInput Word8
1)
   in
    -- Step 9: check for zero nonce and retry if so
    if Integer
k1' Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 Bool -> Bool -> Bool
|| Integer
k2' Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
      then [Char] -> SecNonce
forall a. HasCallStack => [Char] -> a
error [Char]
"musig2 (nonceGen): zero nonce generated (retry)"
      else SecNonce{k1 :: Integer
k1 = Integer
k1', k2 :: Integer
k2 = Integer
k2'}

{- | Public nonce.

Represents a public nonce derived from a secret nonce. It is composed
of two public points, 'r1' and 'r2', derived by base-point multiplying
the two scalars in a 'SecNonce'.

A 'PubNonce' can be derived from a 'SecNonce' using 'publicNonce'.
-}
data PubNonce = PubNonce
  { PubNonce -> Projective
r1 :: Pub
  -- ^ First public point.
  , PubNonce -> Projective
r2 :: Pub
  -- ^ Second public point.
  }
  deriving (PubNonce -> PubNonce -> Bool
(PubNonce -> PubNonce -> Bool)
-> (PubNonce -> PubNonce -> Bool) -> Eq PubNonce
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PubNonce -> PubNonce -> Bool
== :: PubNonce -> PubNonce -> Bool
$c/= :: PubNonce -> PubNonce -> Bool
/= :: PubNonce -> PubNonce -> Bool
Eq, Eq PubNonce
Eq PubNonce =>
(PubNonce -> PubNonce -> Ordering)
-> (PubNonce -> PubNonce -> Bool)
-> (PubNonce -> PubNonce -> Bool)
-> (PubNonce -> PubNonce -> Bool)
-> (PubNonce -> PubNonce -> Bool)
-> (PubNonce -> PubNonce -> PubNonce)
-> (PubNonce -> PubNonce -> PubNonce)
-> Ord PubNonce
PubNonce -> PubNonce -> Bool
PubNonce -> PubNonce -> Ordering
PubNonce -> PubNonce -> PubNonce
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PubNonce -> PubNonce -> Ordering
compare :: PubNonce -> PubNonce -> Ordering
$c< :: PubNonce -> PubNonce -> Bool
< :: PubNonce -> PubNonce -> Bool
$c<= :: PubNonce -> PubNonce -> Bool
<= :: PubNonce -> PubNonce -> Bool
$c> :: PubNonce -> PubNonce -> Bool
> :: PubNonce -> PubNonce -> Bool
$c>= :: PubNonce -> PubNonce -> Bool
>= :: PubNonce -> PubNonce -> Bool
$cmax :: PubNonce -> PubNonce -> PubNonce
max :: PubNonce -> PubNonce -> PubNonce
$cmin :: PubNonce -> PubNonce -> PubNonce
min :: PubNonce -> PubNonce -> PubNonce
Ord, Int -> PubNonce -> ShowS
[PubNonce] -> ShowS
PubNonce -> [Char]
(Int -> PubNonce -> ShowS)
-> (PubNonce -> [Char]) -> ([PubNonce] -> ShowS) -> Show PubNonce
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PubNonce -> ShowS
showsPrec :: Int -> PubNonce -> ShowS
$cshow :: PubNonce -> [Char]
show :: PubNonce -> [Char]
$cshowList :: [PubNonce] -> ShowS
showList :: [PubNonce] -> ShowS
Show)

-- | Generates a 'PubNonce' from a 'SecNonce'.
publicNonce :: SecNonce -> PubNonce
publicNonce :: SecNonce -> PubNonce
publicNonce SecNonce
secNonce = Projective -> Projective -> PubNonce
PubNonce (Projective -> Integer -> Projective
mul Projective
_CURVE_G (SecNonce -> Integer
k1 SecNonce
secNonce)) (Projective -> Integer -> Projective
mul Projective
_CURVE_G (SecNonce -> Integer
k2 SecNonce
secNonce))

-- | 'Data.Semigroup' implementation of 'PubNonce' for algebraic sound combination of public nonces.
instance Semigroup PubNonce where
  (<>) :: PubNonce -> PubNonce -> PubNonce
  PubNonce
a <> :: PubNonce -> PubNonce -> PubNonce
<> PubNonce
b = PubNonce{r1 :: Projective
r1 = Projective
r1Agg, r2 :: Projective
r2 = Projective
r2Agg}
   where
    r1Agg :: Projective
r1Agg = Projective -> Projective -> Projective
add PubNonce
a.r1 PubNonce
b.r1
    r2Agg :: Projective
r2Agg = Projective -> Projective -> Projective
add PubNonce
a.r2 PubNonce
b.r2

-- | 'Data.Monoid' implementation of 'PubNonce' for algebraic sound combination of public nonces.
instance Monoid PubNonce where
  mempty :: PubNonce
  mempty :: PubNonce
mempty = Projective -> Projective -> PubNonce
PubNonce Projective
_CURVE_ZERO Projective
_CURVE_ZERO

{- | Aggregates a 'Traversable' of 'PubNonce's using the
[Nonce Aggregation algorithm in BIP327](https://github.com/bitcoin/bips/blob/master/bip-0327.mediawiki).
-}
aggNonces :: (Traversable t) => t PubNonce -> Maybe PubNonce
aggNonces :: forall (t :: * -> *). Traversable t => t PubNonce -> Maybe PubNonce
aggNonces t PubNonce
nonces
  | Seq PubNonce -> Bool
forall a. Seq a -> Bool
Seq.null Seq PubNonce
noncesSeq = Maybe PubNonce
forall a. Maybe a
Nothing
  | Bool
otherwise = PubNonce -> Maybe PubNonce
forall a. a -> Maybe a
Just (PubNonce -> Maybe PubNonce) -> PubNonce -> Maybe PubNonce
forall a b. (a -> b) -> a -> b
$ (PubNonce -> PubNonce -> PubNonce) -> Seq PubNonce -> PubNonce
forall a. (a -> a -> a) -> Seq a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 PubNonce -> PubNonce -> PubNonce
forall a. Semigroup a => a -> a -> a
(<>) Seq PubNonce
noncesSeq
 where
  noncesSeq :: Seq PubNonce
noncesSeq = [PubNonce] -> Seq PubNonce
forall a. [a] -> Seq a
Seq.fromList (t PubNonce -> [PubNonce]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t PubNonce
nonces)