{-# LANGUAGE CPP #-}
{-# 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.

== Security Considerations

* __Nonce single-use:__ Each 'SecNonce' /must/ be used to 'sign' at most one
  message. Reusing a nonce across two different messages enables algebraic
  recovery of the signer's private key. This library does not enforce
  single-use semantics at the type level; callers must ensure fresh nonces
  per signing session.

* __Non-constant-time arithmetic:__ This library uses Haskell's arbitrary-precision
  'Integer' type for all scalar operations. Branching and comparison on secret
  values (e.g., key negation during signing) is not constant-time. For
  applications requiring side-channel resistance, consider a C FFI binding
  such as @libsecp256k1-musig@.

* __No secret zeroization:__ Secret key material ('SecKey', 'SecNonce') is not
  zeroized after use due to Haskell's garbage-collected runtime. Secrets may
  persist in memory until collected.

== 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 Just pub1 = Secp256k1.derive_pub 0xB7E151628AED2A6ABF7158809CF4F3C762E7160F38B4DA56A784D9045190CFEF
> let Just pub2 = Secp256k1.derive_pub 0x68E151628AED2A6ABF7158809CF4F3C762E7160F38B4DA56A784D9045190CFEF
> let pubkeys = [pub1, pub2]
>
> -- create key aggregation context
> let Right 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
> Right secnonce1 <- MuSig2.secNonceGen params1
> Right secnonce2 <- MuSig2.secNonceGen params2
> let Right pubnonce1 = MuSig2.publicNonce secnonce1
> let Right pubnonce2 = MuSig2.publicNonce secnonce2
> let pubnonces = [pubnonce1, pubnonce2]
>
> -- aggregate nonces and create session context
> let Right aggnonce = MuSig2.aggNonces pubnonces
> let Right session_ctx = MuSig2.mkSessionContext aggnonce pubkeys [] msg
>
> -- each signer creates a partial signature
> let Right psig1 = MuSig2.sign secnonce1 sec1 session_ctx
> let Right psig2 = MuSig2.sign secnonce2 sec2 session_ctx
> let psigs = [psig1, psig2]
>
> -- aggregate partial signatures into final signature
> let Right 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
  MuSig2Error (..),
  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.Monad (foldM)
import Crypto.Curve.Secp256k1 (Projective, Pub, add, derive_pub, mul, neg, serialize_point, _CURVE_G, _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

{- HLINT ignore "Use fewer imports" -}
#if !MIN_VERSION_base(4,20,0)
import Data.Foldable (foldl')
#endif
import Data.Foldable (toList, traverse_)
import Data.Maybe (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)

data MuSig2Error
  = EmptyPartialSignatureCollection
  | EmptyNonceCollection
  | EmptyPublicKeyCollection
  | TooManyPublicKeys
  | TooManyTweaks
  | PublicKeyAtInfinity
  | SignerCountMismatch Int Int
  | InvalidSignerIndex Int
  | NegativeTweak Integer
  | TweakOutOfRange Integer
  | AggregatedPublicKeyAtInfinity
  | TweakResultAtInfinity
  | SecretScalarZero String
  | SecretScalarOutOfRange String
  | SecretKeyPublicKeyMismatch
  | PartialSignatureOutOfRange
  | InvalidRandomBytesLength Int
  | PublicNonceGenerationFailed String
  | KeyDerivationFailed
  | ScalarMultiplicationFailed String
  | InvalidPointFormat
  | ZeroNonceGenerated
  deriving (MuSig2Error -> MuSig2Error -> Bool
(MuSig2Error -> MuSig2Error -> Bool)
-> (MuSig2Error -> MuSig2Error -> Bool) -> Eq MuSig2Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MuSig2Error -> MuSig2Error -> Bool
== :: MuSig2Error -> MuSig2Error -> Bool
$c/= :: MuSig2Error -> MuSig2Error -> Bool
/= :: MuSig2Error -> MuSig2Error -> Bool
Eq, Int -> MuSig2Error -> ShowS
[MuSig2Error] -> ShowS
MuSig2Error -> String
(Int -> MuSig2Error -> ShowS)
-> (MuSig2Error -> String)
-> ([MuSig2Error] -> ShowS)
-> Show MuSig2Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MuSig2Error -> ShowS
showsPrec :: Int -> MuSig2Error -> ShowS
$cshow :: MuSig2Error -> String
show :: MuSig2Error -> String
$cshowList :: [MuSig2Error] -> ShowS
showList :: [MuSig2Error] -> ShowS
Show)

liftMaybe :: e -> Maybe a -> Either e a
liftMaybe :: forall e a. e -> Maybe a -> Either e a
liftMaybe e
err = Either e a -> (a -> Either e a) -> Maybe a -> Either e a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e -> Either e a
forall a b. a -> Either a b
Left e
err) a -> Either e a
forall a b. b -> Either a b
Right

validateSecretScalar :: String -> Integer -> Either MuSig2Error Integer
validateSecretScalar :: String -> Integer -> Either MuSig2Error Integer
validateSecretScalar String
label Integer
scalar
  | Integer
scalar Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = MuSig2Error -> Either MuSig2Error Integer
forall a b. a -> Either a b
Left (String -> MuSig2Error
SecretScalarZero String
label)
  | Integer
scalar Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Integer
scalar Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
curveOrder = MuSig2Error -> Either MuSig2Error Integer
forall a b. a -> Either a b
Left (String -> MuSig2Error
SecretScalarOutOfRange String
label)
  | Bool
otherwise = Integer -> Either MuSig2Error Integer
forall a b. b -> Either a b
Right Integer
scalar

validateTweakValue :: Integer -> Either MuSig2Error Integer
validateTweakValue :: Integer -> Either MuSig2Error Integer
validateTweakValue Integer
tweak
  | Integer
tweak Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = MuSig2Error -> Either MuSig2Error Integer
forall a b. a -> Either a b
Left (Integer -> MuSig2Error
NegativeTweak Integer
tweak)
  | Integer
tweak Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
curveOrder = MuSig2Error -> Either MuSig2Error Integer
forall a b. a -> Either a b
Left (Integer -> MuSig2Error
TweakOutOfRange Integer
tweak)
  | Bool
otherwise = Integer -> Either MuSig2Error Integer
forall a b. b -> Either a b
Right Integer
tweak

validatePublicKey :: Pub -> Either MuSig2Error Pub
validatePublicKey :: Pub -> Either MuSig2Error Pub
validatePublicKey Pub
pub
  | Pub
pub Pub -> Pub -> Bool
forall a. Eq a => a -> a -> Bool
== Pub
_CURVE_ZERO = MuSig2Error -> Either MuSig2Error Pub
forall a b. a -> Either a b
Left MuSig2Error
PublicKeyAtInfinity
  | Bool
otherwise = Pub -> Either MuSig2Error Pub
forall a b. b -> Either a b
Right Pub
pub

-- | Aggregates 'PartialSignature's into a 64-byte Schnorr signature.
aggPartials ::
  (Traversable t) =>
  -- | Partial signatures.
  t PartialSignature ->
  -- | Session context.
  SessionContext ->
  -- | 64-byte Schnorr signature.
  Either MuSig2Error ByteString
aggPartials :: forall (t :: * -> *).
Traversable t =>
t Integer -> SessionContext -> Either MuSig2Error ByteString
aggPartials t Integer
partials SessionContext
ctx =
  if Seq Integer -> Bool
forall a. Seq a -> Bool
Seq.null Seq Integer
partialsSeq
    then MuSig2Error -> Either MuSig2Error ByteString
forall a b. a -> Either a b
Left MuSig2Error
EmptyPartialSignatureCollection
    else case (Integer -> Either MuSig2Error Integer)
-> Seq Integer -> Either MuSig2Error (Seq Integer)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
traverse Integer -> Either MuSig2Error Integer
validatePartialSignature Seq Integer
partialsSeq of
      Left MuSig2Error
err -> MuSig2Error -> Either MuSig2Error ByteString
forall a b. a -> Either a b
Left MuSig2Error
err
      Right Seq Integer
validPartials -> do
        Pub
nonce <- SessionContext -> Either MuSig2Error Pub
getSigningNonce SessionContext
ctx
        ByteString
signingHash <- SessionContext -> Either MuSig2Error ByteString
getSigningHash SessionContext
ctx
        let
          e :: Integer
e = ByteString -> Integer
bytesToInteger ByteString
signingHash
          keyCtx :: KeyAggContext
keyCtx = SessionContext -> KeyAggContext
cachedKeyAggCtx SessionContext
ctx
          aggPk :: Pub
aggPk = KeyAggContext -> Pub
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
        Bool
evenAggPk <- MuSig2Error -> Maybe Bool -> Either MuSig2Error Bool
forall e a. e -> Maybe a -> Either e a
liftMaybe MuSig2Error
InvalidPointFormat (Pub -> Maybe Bool
isEvenPub Pub
aggPk)
        let
          g :: Integer
g = if Bool
evenAggPk then Integer
1 else Integer
curveOrder 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
$ Seq Integer -> Integer
forall a. Num a => Seq a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum Seq Integer
validPartials
          -- 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 = Pub -> ByteString
xBytes Pub
nonce
          right :: ByteString
right = Integer -> ByteString
integerToBytes32 Integer
s
        ByteString -> Either MuSig2Error ByteString
forall a b. b -> Either a b
Right (ByteString
left ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
right)
 where
  partialsSeq :: Seq Integer
partialsSeq = [Integer] -> Seq Integer
forall a. [a] -> Seq a
Seq.fromList (t Integer -> [Integer]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Integer
partials)
  validatePartialSignature :: Integer -> Either MuSig2Error Integer
validatePartialSignature Integer
partial
    | 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
curveOrder = MuSig2Error -> Either MuSig2Error Integer
forall a b. a -> Either a b
Left MuSig2Error
PartialSignatureOutOfRange
    | Bool
otherwise = Integer -> Either MuSig2Error Integer
forall a b. b -> Either a b
Right Integer
partial

{- | 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.
  Either MuSig2Error PartialSignature
sign :: SecNonce -> SecKey -> SessionContext -> Either MuSig2Error Integer
sign SecNonce
secnonce SecKey
sk SessionContext
ctx =
  do
    Pub
nonce <- SessionContext -> Either MuSig2Error Pub
getSigningNonce SessionContext
ctx
    ByteString
signingHash <- SessionContext -> Either MuSig2Error ByteString
getSigningHash SessionContext
ctx
    let publicKeys :: Seq Pub
publicKeys = SessionContext -> Seq Pub
pks SessionContext
ctx
        e :: Integer
e = ByteString -> Integer
bytesToInteger ByteString
signingHash
        keyCtx :: KeyAggContext
keyCtx = SessionContext -> KeyAggContext
cachedKeyAggCtx SessionContext
ctx
        aggPk :: Pub
aggPk = KeyAggContext -> Pub
q KeyAggContext
keyCtx
        gaccVal :: Integer
gaccVal = KeyAggContext -> Integer
gacc KeyAggContext
keyCtx
        SecNonce Integer
k1 Integer
k2 Pub
boundPk = SecNonce
secnonce
    Bool
evenAggPk <- MuSig2Error -> Maybe Bool -> Either MuSig2Error Bool
forall e a. e -> Maybe a -> Either e a
liftMaybe MuSig2Error
InvalidPointFormat (Pub -> Maybe Bool
isEvenPub Pub
aggPk)
    Bool
evenNonce <- MuSig2Error -> Maybe Bool -> Either MuSig2Error Bool
forall e a. e -> Maybe a -> Either e a
liftMaybe MuSig2Error
InvalidPointFormat (Pub -> Maybe Bool
isEvenPub Pub
nonce)
    Integer
_ <- String -> Integer -> Either MuSig2Error Integer
validateSecretScalar String
"k1" Integer
k1
    Integer
_ <- String -> Integer -> Either MuSig2Error Integer
validateSecretScalar String
"k2" Integer
k2
    Integer
d' <- String -> Integer -> Either MuSig2Error Integer
validateSecretScalar String
"secret key" (SecKey -> Integer
unSecKey SecKey
sk)
    Pub
p <- MuSig2Error -> Maybe Pub -> Either MuSig2Error Pub
forall e a. e -> Maybe a -> Either e a
liftMaybe MuSig2Error
KeyDerivationFailed (Maybe Pub -> Either MuSig2Error Pub)
-> Maybe Pub -> Either MuSig2Error Pub
forall a b. (a -> b) -> a -> b
$ Wider -> Maybe Pub
derive_pub (Integer -> Wider
forall a. Num a => Integer -> a
fromInteger Integer
d')
    if Pub
p Pub -> Pub -> Bool
forall a. Eq a => a -> a -> Bool
/= Pub
boundPk
      then MuSig2Error -> Either MuSig2Error Integer
forall a b. a -> Either a b
Left MuSig2Error
SecretKeyPublicKeyMismatch
      else do
        let
          -- `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
          oddAggPk :: Bool
oddAggPk = Bool -> Bool
not Bool
evenAggPk
          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
curveOrder Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
d' else Integer
d'
          a :: Integer
a = Pub -> Seq Pub -> Integer
computeKeyAggCoef Pub
p Seq Pub
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 Bool
evenNonce 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
curveOrder 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' <- SecNonce -> Either MuSig2Error PubNonce
publicNonce SecNonce
secnonce
        Bool
verified <- Integer
-> PubNonce -> Pub -> SessionContext -> Either MuSig2Error Bool
partialSigVerifyInternal Integer
s PubNonce
pubNonce' Pub
p SessionContext
ctx
        if Bool
verified
          then Integer -> Either MuSig2Error Integer
forall a b. b -> Either a b
Right Integer
s
          else MuSig2Error -> Either MuSig2Error Integer
forall a b. a -> Either a b
Left (String -> MuSig2Error
PublicNonceGenerationFailed String
"partial signature self-verification failed")

{- | 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.
  Either MuSig2Error Bool
partialSigVerify :: forall (t :: * -> *).
Traversable t =>
Integer
-> t PubNonce
-> t Pub
-> t Tweak
-> ByteString
-> Int
-> Either MuSig2Error Bool
partialSigVerify Integer
partial t PubNonce
nonces t Pub
pks t Tweak
tweaks ByteString
msg Int
idx =
  do
    PubNonce
aggNonce <- t PubNonce -> Either MuSig2Error PubNonce
forall (t :: * -> *).
Traversable t =>
t PubNonce -> Either MuSig2Error PubNonce
aggNonces t PubNonce
nonces
    SessionContext
ctx <- PubNonce
-> t Pub
-> t Tweak
-> ByteString
-> Either MuSig2Error SessionContext
forall (t :: * -> *).
Traversable t =>
PubNonce
-> t Pub
-> t Tweak
-> ByteString
-> Either MuSig2Error SessionContext
mkSessionContext PubNonce
aggNonce t Pub
pks t Tweak
tweaks ByteString
msg
    let 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)
        pksSeq :: Seq Pub
pksSeq = [Pub] -> Seq Pub
forall a. [a] -> Seq a
Seq.fromList (t Pub -> [Pub]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Pub
pks)
    if Seq PubNonce -> Int
forall a. Seq a -> Int
Seq.length Seq PubNonce
noncesSeq Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Seq Pub -> Int
forall a. Seq a -> Int
Seq.length Seq Pub
pksSeq
      then MuSig2Error -> Either MuSig2Error Bool
forall a b. a -> Either a b
Left (Int -> Int -> MuSig2Error
SignerCountMismatch (Seq Pub -> Int
forall a. Seq a -> Int
Seq.length Seq Pub
pksSeq) (Seq PubNonce -> Int
forall a. Seq a -> Int
Seq.length Seq PubNonce
noncesSeq))
      else do
        Pub
pk <- Either MuSig2Error Pub
-> (Pub -> Either MuSig2Error Pub)
-> Maybe Pub
-> Either MuSig2Error Pub
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (MuSig2Error -> Either MuSig2Error Pub
forall a b. a -> Either a b
Left (Int -> MuSig2Error
InvalidSignerIndex Int
idx)) Pub -> Either MuSig2Error Pub
forall a b. b -> Either a b
Right (Int -> Seq Pub -> Maybe Pub
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
idx Seq Pub
pksSeq)
        PubNonce
pubnonce <- Either MuSig2Error PubNonce
-> (PubNonce -> Either MuSig2Error PubNonce)
-> Maybe PubNonce
-> Either MuSig2Error PubNonce
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (MuSig2Error -> Either MuSig2Error PubNonce
forall a b. a -> Either a b
Left (Int -> MuSig2Error
InvalidSignerIndex Int
idx)) PubNonce -> Either MuSig2Error PubNonce
forall a b. b -> Either a b
Right (Int -> Seq PubNonce -> Maybe PubNonce
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
idx Seq PubNonce
noncesSeq)
        Integer
-> PubNonce -> Pub -> SessionContext -> Either MuSig2Error Bool
partialSigVerifyInternal Integer
partial PubNonce
pubnonce Pub
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.
  Either MuSig2Error Bool
partialSigVerifyInternal :: Integer
-> PubNonce -> Pub -> SessionContext -> Either MuSig2Error Bool
partialSigVerifyInternal Integer
partial PubNonce
pubnonce Pub
pk SessionContext
ctx =
  do
    Integer
s <- Integer -> Either MuSig2Error Integer
validatePartialSignature Integer
partial
    ByteString
signingHash <- SessionContext -> Either MuSig2Error ByteString
getSigningHash SessionContext
ctx
    Pub
finalNonce <- SessionContext -> Either MuSig2Error Pub
getSigningNonce SessionContext
ctx
    let
      publicKeys :: Seq Pub
publicKeys = SessionContext -> Seq Pub
pks SessionContext
ctx
      keyCtx :: KeyAggContext
keyCtx = SessionContext -> KeyAggContext
cachedKeyAggCtx SessionContext
ctx
      aggPk :: Pub
aggPk = KeyAggContext -> Pub
q KeyAggContext
keyCtx
      gaccVal :: Integer
gaccVal = KeyAggContext -> Integer
gacc KeyAggContext
keyCtx
      e :: Integer
e = ByteString -> Integer
bytesToInteger ByteString
signingHash
      r1' :: Pub
r1' = PubNonce
pubnonce.r1
      r2' :: Pub
r2' = PubNonce
pubnonce.r2
      b :: Integer
b = SessionContext -> Integer
getSigningNonceCoeff SessionContext
ctx
      a :: Integer
a = Pub -> Seq Pub -> Integer
computeKeyAggCoef Pub
pk Seq Pub
publicKeys
    Bool
evenAggPk <- MuSig2Error -> Maybe Bool -> Either MuSig2Error Bool
forall e a. e -> Maybe a -> Either e a
liftMaybe MuSig2Error
InvalidPointFormat (Pub -> Maybe Bool
isEvenPub Pub
aggPk)
    Bool
evenFinalNonce <- MuSig2Error -> Maybe Bool -> Either MuSig2Error Bool
forall e a. e -> Maybe a -> Either e a
liftMaybe MuSig2Error
InvalidPointFormat (Pub -> Maybe Bool
isEvenPub Pub
finalNonce)
    let
      oddAggPk :: Bool
oddAggPk = Bool -> Bool
not Bool
evenAggPk
      -- Calculate g factor: 1 if aggregate pubkey has even Y, n-1 if odd
      g :: Integer
g = if Bool
oddAggPk then Integer
curveOrder 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)
    Pub
r2b <- MuSig2Error -> Maybe Pub -> Either MuSig2Error Pub
forall e a. e -> Maybe a -> Either e a
liftMaybe (String -> MuSig2Error
ScalarMultiplicationFailed String
"r2 * b") (Maybe Pub -> Either MuSig2Error Pub)
-> Maybe Pub -> Either MuSig2Error Pub
forall a b. (a -> b) -> a -> b
$ Pub -> Wider -> Maybe Pub
mul Pub
r2' (Integer -> Wider
forall a. Num a => Integer -> a
fromInteger Integer
b)
    Pub
sG <- MuSig2Error -> Maybe Pub -> Either MuSig2Error Pub
forall e a. e -> Maybe a -> Either e a
liftMaybe (String -> MuSig2Error
ScalarMultiplicationFailed String
"s * G") (Maybe Pub -> Either MuSig2Error Pub)
-> Maybe Pub -> Either MuSig2Error Pub
forall a b. (a -> b) -> a -> b
$ Pub -> Wider -> Maybe Pub
mul Pub
_CURVE_G (Integer -> Wider
forall a. Num a => Integer -> a
fromInteger Integer
s)
    Pub
pkMul <- MuSig2Error -> Maybe Pub -> Either MuSig2Error Pub
forall e a. e -> Maybe a -> Either e a
liftMaybe (String -> MuSig2Error
ScalarMultiplicationFailed String
"pk multiplication") (Maybe Pub -> Either MuSig2Error Pub)
-> Maybe Pub -> Either MuSig2Error Pub
forall a b. (a -> b) -> a -> b
$ Pub -> Wider -> Maybe Pub
mul Pub
pk (Integer -> Wider
forall a. Num a => Integer -> a
fromInteger (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')))
    let
      re' :: Pub
re' = Pub -> Pub -> Pub
add Pub
r1' Pub
r2b
      -- Negate individual nonce if final aggregate nonce has odd Y
      re :: Pub
re = if Bool
evenFinalNonce then Pub
re' else Pub -> Pub
neg Pub
re'
      sG' :: Pub
sG' = Pub
re Pub -> Pub -> Pub
`add` Pub
pkMul
    Bool -> Either MuSig2Error Bool
forall a b. b -> Either a b
Right (Pub
sG Pub -> Pub -> Bool
forall a. Eq a => a -> a -> Bool
== Pub
sG')
 where
  validatePartialSignature :: Integer -> Either MuSig2Error Integer
validatePartialSignature Integer
s
    | Integer
s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Integer
s Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
curveOrder = MuSig2Error -> Either MuSig2Error Integer
forall a b. a -> Either a b
Left MuSig2Error
PartialSignatureOutOfRange
    | Bool
otherwise = Integer -> Either MuSig2Error Integer
forall a b. b -> Either a b
Right Integer
s

-- | 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 -> Pub
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'.
  Either MuSig2Error KeyAggContext
mkKeyAggContext :: forall (t :: * -> *).
Traversable t =>
t Pub -> Maybe Tweak -> Either MuSig2Error KeyAggContext
mkKeyAggContext t Pub
pks Maybe Tweak
mTweak
  | Seq Pub -> Bool
forall a. Seq a -> Bool
Seq.null Seq Pub
pks' = MuSig2Error -> Either MuSig2Error KeyAggContext
forall a b. a -> Either a b
Left MuSig2Error
EmptyPublicKeyCollection
  | Seq Pub -> Int
forall a. Seq a -> Int
Seq.length Seq Pub
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) = MuSig2Error -> Either MuSig2Error KeyAggContext
forall a b. a -> Either a b
Left MuSig2Error
TooManyPublicKeys
  | Bool
otherwise = do
      (Pub -> Either MuSig2Error Pub) -> Seq Pub -> Either MuSig2Error ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Pub -> Either MuSig2Error Pub
validatePublicKey Seq Pub
pks'
      Pub
aggPk <- MuSig2Error -> Maybe Pub -> Either MuSig2Error Pub
forall e a. e -> Maybe a -> Either e a
liftMaybe MuSig2Error
AggregatedPublicKeyAtInfinity (Maybe Pub -> Either MuSig2Error Pub)
-> Maybe Pub -> Either MuSig2Error Pub
forall a b. (a -> b) -> a -> b
$ Seq Pub -> Maybe Pub
forall (t :: * -> *). Traversable t => t Pub -> Maybe Pub
aggPublicKeys Seq Pub
pks'
      if Pub
aggPk Pub -> Pub -> Bool
forall a. Eq a => a -> a -> Bool
== Pub
_CURVE_ZERO
        then MuSig2Error -> Either MuSig2Error KeyAggContext
forall a b. a -> Either a b
Left MuSig2Error
AggregatedPublicKeyAtInfinity
        else do
          let baseCtx :: KeyAggContext
baseCtx = Pub -> Maybe Tweak -> Integer -> KeyAggContext
KeyAggContext Pub
aggPk Maybe Tweak
forall a. Maybe a
Nothing Integer
1
          case Maybe Tweak
mTweak of
            Maybe Tweak
Nothing -> KeyAggContext -> Either MuSig2Error KeyAggContext
forall a b. b -> Either a b
Right KeyAggContext
baseCtx
            Just Tweak
tweak -> KeyAggContext -> Tweak -> Either MuSig2Error KeyAggContext
applyTweak KeyAggContext
baseCtx Tweak
tweak
 where
  pks' :: Seq Pub
pks' = [Pub] -> Seq Pub
forall a. [a] -> Seq a
Seq.fromList (t Pub -> [Pub]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Pub
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 Pub
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.
  , SessionContext -> KeyAggContext
cachedKeyAggCtx :: !KeyAggContext
  -- ^ Cached 'KeyAggContext' to avoid recomputation.
  }

{- | 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'.
  Either MuSig2Error SessionContext
mkSessionContext :: forall (t :: * -> *).
Traversable t =>
PubNonce
-> t Pub
-> t Tweak
-> ByteString
-> Either MuSig2Error SessionContext
mkSessionContext PubNonce
aggNonce t Pub
pks t Tweak
tweaks ByteString
msg
  | Seq Pub -> Bool
forall a. Seq a -> Bool
Seq.null Seq Pub
pks' = MuSig2Error -> Either MuSig2Error SessionContext
forall a b. a -> Either a b
Left MuSig2Error
EmptyPublicKeyCollection
  | Seq Pub -> Int
forall a. Seq a -> Int
Seq.length Seq Pub
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) = MuSig2Error -> Either MuSig2Error SessionContext
forall a b. a -> Either a b
Left MuSig2Error
TooManyPublicKeys
  | 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) = MuSig2Error -> Either MuSig2Error SessionContext
forall a b. a -> Either a b
Left MuSig2Error
TooManyTweaks
  | Bool
otherwise = do
      (Pub -> Either MuSig2Error Pub) -> Seq Pub -> Either MuSig2Error ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Pub -> Either MuSig2Error Pub
validatePublicKey Seq Pub
pks'
      (Tweak -> Either MuSig2Error Integer)
-> Seq Tweak -> Either MuSig2Error ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Integer -> Either MuSig2Error Integer
validateTweakValue (Integer -> Either MuSig2Error Integer)
-> (Tweak -> Integer) -> Tweak -> Either MuSig2Error Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tweak -> Integer
getTweak) Seq Tweak
tweaks'
      KeyAggContext
keyCtx <- if Seq Tweak -> Bool
forall a. Seq a -> Bool
Seq.null Seq Tweak
tweaks' then Seq Pub -> Maybe Tweak -> Either MuSig2Error KeyAggContext
forall (t :: * -> *).
Traversable t =>
t Pub -> Maybe Tweak -> Either MuSig2Error KeyAggContext
mkKeyAggContext Seq Pub
pks' Maybe Tweak
forall a. Maybe a
Nothing else Seq Pub -> Maybe Tweak -> Either MuSig2Error KeyAggContext
forall (t :: * -> *).
Traversable t =>
t Pub -> Maybe Tweak -> Either MuSig2Error KeyAggContext
mkKeyAggContext Seq Pub
pks' Maybe Tweak
forall a. Maybe a
Nothing Either MuSig2Error KeyAggContext
-> (KeyAggContext -> Either MuSig2Error KeyAggContext)
-> Either MuSig2Error KeyAggContext
forall a b.
Either MuSig2Error a
-> (a -> Either MuSig2Error b) -> Either MuSig2Error b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \KeyAggContext
baseCtx -> (KeyAggContext -> Tweak -> Either MuSig2Error KeyAggContext)
-> KeyAggContext -> Seq Tweak -> Either MuSig2Error KeyAggContext
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM KeyAggContext -> Tweak -> Either MuSig2Error KeyAggContext
applyTweak KeyAggContext
baseCtx Seq Tweak
tweaks'
      SessionContext -> Either MuSig2Error SessionContext
forall a b. b -> Either a b
Right (PubNonce
-> Seq Pub
-> Seq Tweak
-> ByteString
-> KeyAggContext
-> SessionContext
SessionContext PubNonce
aggNonce Seq Pub
pks' Seq Tweak
tweaks' ByteString
msg KeyAggContext
keyCtx)
 where
  pks' :: Seq Pub
pks' = [Pub] -> Seq Pub
forall a. [a] -> Seq a
Seq.fromList (t Pub -> [Pub]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Pub
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)

{- | Gets the signing nonce as a 'Projective' following
[BIP-0327 algorithm and recommendations](https://github.com/bitcoin/bips/blob/master/bip-0327.mediawiki#dealing-with-infinity-in-nonce-aggregation).
-}
getSigningNonce :: SessionContext -> Either MuSig2Error Projective
getSigningNonce :: SessionContext -> Either MuSig2Error Pub
getSigningNonce SessionContext
ctx = do
  let
    b :: Integer
b = SessionContext -> Integer
getSigningNonceCoeff SessionContext
ctx
    aggNonce :: PubNonce
aggNonce = SessionContext
ctx.aggNonce
    aggNonce' :: PubNonce
aggNonce' = if PubNonce
aggNonce.r1 Pub -> Pub -> Bool
forall a. Eq a => a -> a -> Bool
== Pub
_CURVE_ZERO then Pub -> Pub -> PubNonce
PubNonce Pub
_CURVE_G PubNonce
aggNonce.r2 else PubNonce
aggNonce
  Pub
r2b <- MuSig2Error -> Maybe Pub -> Either MuSig2Error Pub
forall e a. e -> Maybe a -> Either e a
liftMaybe (String -> MuSig2Error
ScalarMultiplicationFailed String
"r2 * b") (Maybe Pub -> Either MuSig2Error Pub)
-> Maybe Pub -> Either MuSig2Error Pub
forall a b. (a -> b) -> a -> b
$ Pub -> Wider -> Maybe Pub
mul PubNonce
aggNonce'.r2 (Integer -> Wider
forall a. Num a => Integer -> a
fromInteger Integer
b)
  let finalNonce :: Pub
finalNonce = Pub -> Pub -> Pub
add PubNonce
aggNonce'.r1 Pub
r2b
  Pub -> Either MuSig2Error Pub
forall a b. b -> Either a b
Right (if Pub
finalNonce Pub -> Pub -> Bool
forall a. Eq a => a -> a -> Bool
== Pub
_CURVE_ZERO then Pub
_CURVE_G else Pub
finalNonce)

{- | Gets the signing nonce coefficient following
[BIP-0327 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 Pub -> Pub -> Bool
forall a. Eq a => a -> a -> Bool
== Pub
_CURVE_ZERO then Pub -> Pub -> PubNonce
PubNonce Pub
_CURVE_G PubNonce
aggNonce.r2 else PubNonce
aggNonce
    aggPubKey :: Pub
aggPubKey = KeyAggContext -> Pub
q (SessionContext -> KeyAggContext
cachedKeyAggCtx SessionContext
ctx)
    msg :: ByteString
msg = SessionContext
ctx.msg
    nonceBytes :: ByteString
nonceBytes = Pub -> ByteString
serialize_point PubNonce
aggNonce'.r1 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Pub -> ByteString
serialize_point PubNonce
aggNonce'.r2
    qBytes :: ByteString
qBytes = Pub -> ByteString
xBytes Pub
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
[BIP-0327 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 BIP-0327 it is referred as @e@.
-}
getSigningHash :: SessionContext -> Either MuSig2Error ByteString
getSigningHash :: SessionContext -> Either MuSig2Error ByteString
getSigningHash SessionContext
ctx = do
  Pub
nonce <- SessionContext -> Either MuSig2Error Pub
getSigningNonce SessionContext
ctx
  let
    aggPubKey :: Pub
aggPubKey = KeyAggContext -> Pub
q (SessionContext -> KeyAggContext
cachedKeyAggCtx SessionContext
ctx)
    qBytes :: ByteString
qBytes = Pub -> ByteString
xBytes Pub
aggPubKey
    msg :: ByteString
msg = SessionContext
ctx.msg
    r :: ByteString
r = Pub -> ByteString
xBytes Pub
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
  ByteString -> Either MuSig2Error ByteString
forall a b. b -> Either a b
Right (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 -> String
(Int -> Tweak -> ShowS)
-> (Tweak -> String) -> ([Tweak] -> ShowS) -> Show Tweak
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Tweak -> ShowS
showsPrec :: Int -> Tweak -> ShowS
$cshow :: Tweak -> String
show :: Tweak -> String
$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

applyTweak :: KeyAggContext -> Tweak -> Either MuSig2Error KeyAggContext
applyTweak :: KeyAggContext -> Tweak -> Either MuSig2Error KeyAggContext
applyTweak KeyAggContext
ctx Tweak
newTweak = do
  let pubkey :: Pub
pubkey = KeyAggContext -> Pub
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
  Integer
t <- Integer -> Either MuSig2Error Integer
validateTweakValue (Tweak -> Integer
getTweak Tweak
newTweak)
  case Tweak
newTweak of
    PlainTweak Integer
_ -> do
      let g :: Integer
g = Integer
1
      Pub
pubkeyMul <- MuSig2Error -> Maybe Pub -> Either MuSig2Error Pub
forall e a. e -> Maybe a -> Either e a
liftMaybe (String -> MuSig2Error
ScalarMultiplicationFailed String
"pubkey * g") (Maybe Pub -> Either MuSig2Error Pub)
-> Maybe Pub -> Either MuSig2Error Pub
forall a b. (a -> b) -> a -> b
$ Pub -> Wider -> Maybe Pub
mul Pub
pubkey (Integer -> Wider
forall a. Num a => Integer -> a
fromInteger Integer
g)
      Pub
tG <- MuSig2Error -> Maybe Pub -> Either MuSig2Error Pub
forall e a. e -> Maybe a -> Either e a
liftMaybe (String -> MuSig2Error
ScalarMultiplicationFailed String
"t * G") (Maybe Pub -> Either MuSig2Error Pub)
-> Maybe Pub -> Either MuSig2Error Pub
forall a b. (a -> b) -> a -> b
$ Pub -> Wider -> Maybe Pub
mul Pub
_CURVE_G (Integer -> Wider
forall a. Num a => Integer -> a
fromInteger Integer
t)
      let tweakedPk :: Pub
tweakedPk = Pub -> Pub -> Pub
add Pub
pubkeyMul Pub
tG
          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)
      if Pub
tweakedPk Pub -> Pub -> Bool
forall a. Eq a => a -> a -> Bool
== Pub
_CURVE_ZERO
        then MuSig2Error -> Either MuSig2Error KeyAggContext
forall a b. a -> Either a b
Left MuSig2Error
TweakResultAtInfinity
        else KeyAggContext -> Either MuSig2Error KeyAggContext
forall a b. b -> Either a b
Right KeyAggContext
ctx{q = tweakedPk, tacc = Just (PlainTweak newAccTweak), gacc = newGacc}
    XOnlyTweak Integer
_ -> do
      Bool
evenPubkey <- MuSig2Error -> Maybe Bool -> Either MuSig2Error Bool
forall e a. e -> Maybe a -> Either e a
liftMaybe MuSig2Error
InvalidPointFormat (Pub -> Maybe Bool
isEvenPub Pub
pubkey)
      let g :: Integer
g = if Bool
evenPubkey then Integer
1 else Integer
curveOrder Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
      Pub
pubkeyMul <- MuSig2Error -> Maybe Pub -> Either MuSig2Error Pub
forall e a. e -> Maybe a -> Either e a
liftMaybe (String -> MuSig2Error
ScalarMultiplicationFailed String
"pubkey * g") (Maybe Pub -> Either MuSig2Error Pub)
-> Maybe Pub -> Either MuSig2Error Pub
forall a b. (a -> b) -> a -> b
$ Pub -> Wider -> Maybe Pub
mul Pub
pubkey (Integer -> Wider
forall a. Num a => Integer -> a
fromInteger Integer
g)
      Pub
tG <- MuSig2Error -> Maybe Pub -> Either MuSig2Error Pub
forall e a. e -> Maybe a -> Either e a
liftMaybe (String -> MuSig2Error
ScalarMultiplicationFailed String
"t * G") (Maybe Pub -> Either MuSig2Error Pub)
-> Maybe Pub -> Either MuSig2Error Pub
forall a b. (a -> b) -> a -> b
$ Pub -> Wider -> Maybe Pub
mul Pub
_CURVE_G (Integer -> Wider
forall a. Num a => Integer -> a
fromInteger Integer
t)
      let tweakedPk :: Pub
tweakedPk = Pub -> Pub -> Pub
add Pub
pubkeyMul Pub
tG
          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)
      if Pub
tweakedPk Pub -> Pub -> Bool
forall a. Eq a => a -> a -> Bool
== Pub
_CURVE_ZERO
        then MuSig2Error -> Either MuSig2Error KeyAggContext
forall a b. a -> Either a b
Left MuSig2Error
TweakResultAtInfinity
        else KeyAggContext -> Either MuSig2Error KeyAggContext
forall a b. b -> Either a b
Right KeyAggContext
ctx{q = tweakedPk, tacc = Just (XOnlyTweak newAccTweak), gacc = newGacc}

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

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

-- | 'Data.Monoid' implementation of 'Projective' for algebraic sound combination of points.
instance Monoid Projective where
  mempty :: Projective
  mempty :: Pub
mempty = Pub
_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 Pub -> Seq Pub
sortPublicKeys = Seq Pub -> Seq Pub
forall a. Ord a => Seq a -> Seq a
Seq.sort (Seq Pub -> Seq Pub) -> (t Pub -> Seq Pub) -> t Pub -> Seq Pub
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pub] -> Seq Pub
forall a. [a] -> Seq a
Seq.fromList ([Pub] -> Seq Pub) -> (t Pub -> [Pub]) -> t Pub -> Seq Pub
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t Pub -> [Pub]
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 -> Pub
aggregatedPubkey = KeyAggContext -> Pub
q

{- | Secret nonce.

The secret nonce provides randomness, blinding a signer's private key when
signing.

== SECURITY: Single-Use Requirement

A 'SecNonce' /must/ be used to 'sign' at most one message. Reusing the same
'SecNonce' across two different messages or session contexts allows an
adversary to algebraically recover the signer's private key.

This library does not enforce single-use semantics at the type level. It is
the caller's responsibility to ensure that each 'SecNonce' is consumed
exactly once and then discarded. Generate a fresh nonce (via 'secNonceGen')
for every signing session.

If you want to follow
[BIP-0327](https://github.com/bitcoin/bips/blob/master/bip-0327.mediawiki)
suggestions, then use 'secNonceGen' otherwise use 'mkSecNonce'.

@since 0.2.0
-}
mkSecNonce ::
  -- | Public key this nonce is bound to.
  Pub ->
  -- | First secret scalar.
  Integer ->
  -- | Second secret scalar.
  Integer ->
  Either MuSig2Error SecNonce
mkSecNonce :: Pub -> Integer -> Integer -> Either MuSig2Error SecNonce
mkSecNonce Pub
pub Integer
k1 Integer
k2 = do
  Pub
_ <- Pub -> Either MuSig2Error Pub
validatePublicKey Pub
pub
  Integer
k1' <- String -> Integer -> Either MuSig2Error Integer
validateSecretScalar String
"k1" Integer
k1
  Integer
k2' <- String -> Integer -> Either MuSig2Error Integer
validateSecretScalar String
"k2" Integer
k2
  SecNonce -> Either MuSig2Error SecNonce
forall a b. b -> Either a b
Right SecNonce{secNonceK1Internal :: Integer
secNonceK1Internal = Integer
k1', secNonceK2Internal :: Integer
secNonceK2Internal = Integer
k2', secNoncePubKeyInternal :: Pub
secNoncePubKeyInternal = Pub
pub}

-- | Required and Optional data to generate a 'SecNonce'.
data SecNonceGenParams = SecNonceGenParams
  { SecNonceGenParams -> Pub
_pk :: Pub
  -- ^ 'Pub'lic key: mandatory.
  , SecNonceGenParams -> Maybe SecKey
_sk :: Maybe SecKey
  -- ^ Secret key: optional.
  , SecNonceGenParams -> Maybe Pub
_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 :: Pub -> SecNonceGenParams
defaultSecNonceGenParams Pub
pk =
  SecNonceGenParams
    { _pk :: Pub
_pk = Pub
pk
    , _sk :: Maybe SecKey
_sk = Maybe SecKey
forall a. Maybe a
Nothing
    , _aggpk :: Maybe Pub
_aggpk = Maybe Pub
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
[BIP-0327](https://github.com/bitcoin/bips/blob/master/bip-0327.mediawiki).

Tries to get the entropy from 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.
-}
secNonceGen :: SecNonceGenParams -> IO (Either MuSig2Error SecNonce)
secNonceGen :: SecNonceGenParams -> IO (Either MuSig2Error SecNonce)
secNonceGen SecNonceGenParams
params = IO (Either MuSig2Error SecNonce)
loop
 where
  loop :: IO (Either MuSig2Error SecNonce)
loop = do
    ByteString
rand <- Int -> IO ByteString
getEntropy Int
32
    case ByteString -> SecNonceGenParams -> Either MuSig2Error SecNonce
secNonceGenWithRand ByteString
rand SecNonceGenParams
params of
      Left MuSig2Error
ZeroNonceGenerated -> IO (Either MuSig2Error SecNonce)
loop
      Either MuSig2Error SecNonce
other -> Either MuSig2Error SecNonce -> IO (Either MuSig2Error SecNonce)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either MuSig2Error SecNonce
other

{- | Generates a 'SecNonce' using a given random 'ByteString' and the inputs and
algorithms from
[BIP-0327](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 -> Either MuSig2Error SecNonce
secNonceGenWithRand :: ByteString -> SecNonceGenParams -> Either MuSig2Error SecNonce
secNonceGenWithRand ByteString
rand _params :: SecNonceGenParams
_params@(SecNonceGenParams{_pk :: SecNonceGenParams -> Pub
_pk = Pub
pkPoint, Maybe ByteString
Maybe Pub
Maybe SecKey
_sk :: SecNonceGenParams -> Maybe SecKey
_aggpk :: SecNonceGenParams -> Maybe Pub
_msg :: SecNonceGenParams -> Maybe ByteString
_extraIn :: SecNonceGenParams -> Maybe ByteString
_sk :: Maybe SecKey
_aggpk :: Maybe Pub
_msg :: Maybe ByteString
_extraIn :: Maybe ByteString
..}) = do
  if ByteString -> Int
BS.length ByteString
rand Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
32
    then MuSig2Error -> Either MuSig2Error ()
forall a b. a -> Either a b
Left (Int -> MuSig2Error
InvalidRandomBytesLength (ByteString -> Int
BS.length ByteString
rand))
    else () -> Either MuSig2Error ()
forall a b. b -> Either a b
Right ()
  Pub
_ <- Pub -> Either MuSig2Error Pub
validatePublicKey Pub
pkPoint
  (Pub -> Either MuSig2Error Pub)
-> Maybe Pub -> Either MuSig2Error ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Pub -> Either MuSig2Error Pub
validatePublicKey Maybe Pub
_aggpk
  case Maybe SecKey
_sk of
    Maybe SecKey
Nothing -> () -> Either MuSig2Error ()
forall a b. b -> Either a b
Right ()
    Just (SecKey Integer
skScalar) -> do
      Integer
skScalar' <- String -> Integer -> Either MuSig2Error Integer
validateSecretScalar String
"secret key" Integer
skScalar
      Pub
expectedPk <- MuSig2Error -> Maybe Pub -> Either MuSig2Error Pub
forall e a. e -> Maybe a -> Either e a
liftMaybe MuSig2Error
KeyDerivationFailed (Maybe Pub -> Either MuSig2Error Pub)
-> Maybe Pub -> Either MuSig2Error Pub
forall a b. (a -> b) -> a -> b
$ Wider -> Maybe Pub
derive_pub (Integer -> Wider
forall a. Num a => Integer -> a
fromInteger Integer
skScalar')
      if Pub
expectedPk Pub -> Pub -> Bool
forall a. Eq a => a -> a -> Bool
== Pub
pkPoint
        then () -> Either MuSig2Error ()
forall a b. b -> Either a b
Right ()
        else MuSig2Error -> Either MuSig2Error ()
forall a b. a -> Either a b
Left MuSig2Error
SecretKeyPublicKeyMismatch
  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 = Pub -> ByteString
serialize_point Pub
pkPoint
    aggpkBytes :: ByteString
aggpkBytes = ByteString -> (Pub -> ByteString) -> Maybe Pub -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" (Int -> ByteString -> ByteString
BS.drop Int
1 (ByteString -> ByteString)
-> (Pub -> ByteString) -> Pub -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pub -> ByteString
serialize_point) Maybe Pub
_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)
  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 MuSig2Error -> Either MuSig2Error SecNonce
forall a b. a -> Either a b
Left MuSig2Error
ZeroNonceGenerated
    else Pub -> Integer -> Integer -> Either MuSig2Error SecNonce
mkSecNonce Pub
pkPoint Integer
k1' 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 -> Pub
r1 :: Pub
  -- ^ First public point.
  , PubNonce -> Pub
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 -> String
(Int -> PubNonce -> ShowS)
-> (PubNonce -> String) -> ([PubNonce] -> ShowS) -> Show PubNonce
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PubNonce -> ShowS
showsPrec :: Int -> PubNonce -> ShowS
$cshow :: PubNonce -> String
show :: PubNonce -> String
$cshowList :: [PubNonce] -> ShowS
showList :: [PubNonce] -> ShowS
Show)

-- | Generates a 'PubNonce' from a 'SecNonce'.
publicNonce :: SecNonce -> Either MuSig2Error PubNonce
publicNonce :: SecNonce -> Either MuSig2Error PubNonce
publicNonce SecNonce
secNonce = do
  let (Integer
k1, Integer
k2) = SecNonce -> (Integer, Integer)
secNonceScalars SecNonce
secNonce
  Pub
r1' <- MuSig2Error -> Maybe Pub -> Either MuSig2Error Pub
forall e a. e -> Maybe a -> Either e a
liftMaybe (String -> MuSig2Error
ScalarMultiplicationFailed String
"k1 * G") (Maybe Pub -> Either MuSig2Error Pub)
-> Maybe Pub -> Either MuSig2Error Pub
forall a b. (a -> b) -> a -> b
$ Pub -> Wider -> Maybe Pub
mul Pub
_CURVE_G (Integer -> Wider
forall a. Num a => Integer -> a
fromInteger Integer
k1)
  Pub
r2' <- MuSig2Error -> Maybe Pub -> Either MuSig2Error Pub
forall e a. e -> Maybe a -> Either e a
liftMaybe (String -> MuSig2Error
ScalarMultiplicationFailed String
"k2 * G") (Maybe Pub -> Either MuSig2Error Pub)
-> Maybe Pub -> Either MuSig2Error Pub
forall a b. (a -> b) -> a -> b
$ Pub -> Wider -> Maybe Pub
mul Pub
_CURVE_G (Integer -> Wider
forall a. Num a => Integer -> a
fromInteger Integer
k2)
  PubNonce -> Either MuSig2Error PubNonce
forall a b. b -> Either a b
Right (Pub -> Pub -> PubNonce
PubNonce Pub
r1' Pub
r2')

-- | '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 :: Pub
r1 = Pub
r1Agg, r2 :: Pub
r2 = Pub
r2Agg}
   where
    r1Agg :: Pub
r1Agg = Pub -> Pub -> Pub
add PubNonce
a.r1 PubNonce
b.r1
    r2Agg :: Pub
r2Agg = Pub -> Pub -> Pub
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 = Pub -> Pub -> PubNonce
PubNonce Pub
_CURVE_ZERO Pub
_CURVE_ZERO

{- | Aggregates a 'Traversable' of 'PubNonce's using the
[Nonce Aggregation algorithm in BIP-0327](https://github.com/bitcoin/bips/blob/master/bip-0327.mediawiki).
-}
aggNonces :: (Traversable t) => t PubNonce -> Either MuSig2Error PubNonce
aggNonces :: forall (t :: * -> *).
Traversable t =>
t PubNonce -> Either MuSig2Error PubNonce
aggNonces t PubNonce
nonces
  | Seq PubNonce -> Bool
forall a. Seq a -> Bool
Seq.null Seq PubNonce
noncesSeq = MuSig2Error -> Either MuSig2Error PubNonce
forall a b. a -> Either a b
Left MuSig2Error
EmptyNonceCollection
  | Bool
otherwise = case Seq PubNonce -> ViewL PubNonce
forall a. Seq a -> ViewL a
Seq.viewl Seq PubNonce
noncesSeq of
      ViewL PubNonce
Seq.EmptyL -> MuSig2Error -> Either MuSig2Error PubNonce
forall a b. a -> Either a b
Left MuSig2Error
EmptyNonceCollection
      PubNonce
x Seq.:< Seq PubNonce
xs -> PubNonce -> Either MuSig2Error PubNonce
forall a b. b -> Either a b
Right (PubNonce -> Either MuSig2Error PubNonce)
-> PubNonce -> Either MuSig2Error PubNonce
forall a b. (a -> b) -> a -> b
$! (PubNonce -> PubNonce -> PubNonce)
-> PubNonce -> Seq PubNonce -> PubNonce
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' PubNonce -> PubNonce -> PubNonce
forall a. Semigroup a => a -> a -> a
(<>) PubNonce
x Seq PubNonce
xs
 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)