diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,5 +1,20 @@ # Changelog +## 0.2.0 (2026-04-10) + +* Security hardening and API changes: + - Bind `SecNonce` values to the originating signer public key and reject nonce/key mismatches during signing + - Replace panic-based validation in signing, verification, context creation, tweaking, and nonce generation with structured `MuSig2Error` results + - Eliminate all remaining `error` calls from library code (`publicNonce`, `getSigningNonce`, `isEvenPub`) + - Make `SecNonce` opaque and require checked construction via `mkSecNonce` or the nonce generation APIs + - Remove `Eq` and `Ord` instances from `SecNonce` to discourage storing nonces in collections + - Move `secNonceScalars` out of public API into `Internal` module to prevent leaking secret nonce scalars + - Strip secret scalar values from `MuSig2Error` constructors to prevent leaking secrets through error logging + - Reject out-of-range partial signatures during `aggPartials` instead of reducing them modulo the curve order + - Update nonce generation and session construction APIs to return checked `Either` results + - Add security considerations documentation (nonce reuse, non-constant-time arithmetic, no zeroization) + - Refresh tests, benchmarks, and documentation to cover the new checked API and regression cases + ## 0.1.3 (2026-01-04) * Performance improvements: diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -13,7 +13,7 @@ KeyAggContext, PubNonce (..), SecKey (..), - SecNonce (..), + SecNonce, SecNonceGenParams (..), SessionContext (..), Tweak (..), @@ -22,6 +22,10 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as B16 +-- | Unwrap a Right value, crashing on Left (bench setup only). +unsafeRight :: (Show e) => Either e a -> a +unsafeRight = either (error . show) id + -- NFData instances for benchmarking instance NFData S.Projective instance NFData S.Affine @@ -32,7 +36,7 @@ rnf (SecKey i) = rnf i instance NFData SecNonce where - rnf (SecNonce k1 k2) = rnf k1 `seq` rnf k2 + rnf sn = sn `seq` () instance NFData PubNonce where rnf (PubNonce r1 r2) = rnf r1 `seq` rnf r2 @@ -96,8 +100,7 @@ nonceGen = env setupNonce $ \ ~(params, rand) -> bgroup "nonce_generation" - [ bench "mkSecNonce" $ nfIO M.mkSecNonce - , bench "secNonceGen (minimal params)" $ nfIO (M.secNonceGen params) + [ bench "secNonceGen (minimal params)" $ nfIO (M.secNonceGen params) , bench "secNonceGenWithRand" $ nf (M.secNonceGenWithRand rand) params , bench "publicNonce" $ nf M.publicNonce secNonce1 ] @@ -127,9 +130,7 @@ ] where setupSession = do - let !aggNonce = case M.aggNonces [pubNonce1, pubNonce2] of - Nothing -> error "failed to aggregate nonces" - Just n -> n + let !aggNonce = unsafeRight $ M.aggNonces [pubNonce1, pubNonce2] !pks = [p, q] !tweaks = [plainTweak, xonlyTweak] pure (aggNonce, pks, tweaks) @@ -143,11 +144,9 @@ ] where setupSigning = do - let !aggNonce = case M.aggNonces [pubNonce1, pubNonce2] of - Nothing -> error "failed to aggregate nonces" - Just n -> n - !ctx = M.mkSessionContext aggNonce [p, q] [] sMsg - !secNonce = SecNonce sk1 sk2 + let !aggNonce = unsafeRight $ M.aggNonces [pubNonce1, pubNonce2] + !ctx = unsafeRight $ M.mkSessionContext aggNonce [p, q] [] sMsg + !secNonce = secNonce1 !sk = SecKey ssk pure (ctx, secNonce, sk) @@ -161,13 +160,11 @@ ] where setupVerification = do - let !aggNonce = case M.aggNonces [pubNonce1, pubNonce2] of - Nothing -> error "failed to aggregate nonces" - Just n -> n - !ctx = M.mkSessionContext aggNonce [p, q] [] sMsg - !secNonce = SecNonce sk1 sk2 + let !aggNonce = unsafeRight $ M.aggNonces [pubNonce1, pubNonce2] + !ctx = unsafeRight $ M.mkSessionContext aggNonce [p, q] [] sMsg + !secNonce = secNonce1 !sk = SecKey ssk - !partial = M.sign secNonce sk ctx + !partial = unsafeRight $ M.sign secNonce sk ctx !nonces = [pubNonce1, pubNonce2] !pks = [p, q] pure (partial, nonces, pks, ctx) @@ -238,7 +235,7 @@ -- Contexts and nonces for testing keyCtx2 :: KeyAggContext -keyCtx2 = M.mkKeyAggContext [p, q] Nothing +keyCtx2 = unsafeRight $ M.mkKeyAggContext [p, q] Nothing plainTweak :: Tweak plainTweak = PlainTweak 0x1234567890ABCDEF @@ -247,31 +244,31 @@ xonlyTweak = XOnlyTweak 0xFEDCBA0987654321 secNonce1 :: SecNonce -secNonce1 = SecNonce sk1 sk2 +secNonce1 = unsafeRight $ M.mkSecNonce p sk1 sk2 pubNonce1 :: PubNonce -pubNonce1 = M.publicNonce secNonce1 +pubNonce1 = unsafeRight $ M.publicNonce secNonce1 secNonce2 :: SecNonce -secNonce2 = SecNonce (sk1 + 1) (sk2 + 1) +secNonce2 = unsafeRight $ M.mkSecNonce p (sk1 + 1) (sk2 + 1) pubNonce2 :: PubNonce -pubNonce2 = M.publicNonce secNonce2 +pubNonce2 = unsafeRight $ M.publicNonce secNonce2 secNonce3 :: SecNonce -secNonce3 = SecNonce (sk1 + 2) (sk2 + 2) +secNonce3 = unsafeRight $ M.mkSecNonce p (sk1 + 2) (sk2 + 2) pubNonce3 :: PubNonce -pubNonce3 = M.publicNonce secNonce3 +pubNonce3 = unsafeRight $ M.publicNonce secNonce3 secNonce4 :: SecNonce -secNonce4 = SecNonce (sk1 + 3) (sk2 + 3) +secNonce4 = unsafeRight $ M.mkSecNonce p (sk1 + 3) (sk2 + 3) pubNonce4 :: PubNonce -pubNonce4 = M.publicNonce secNonce4 +pubNonce4 = unsafeRight $ M.publicNonce secNonce4 secNonce5 :: SecNonce -secNonce5 = SecNonce (sk1 + 4) (sk2 + 4) +secNonce5 = unsafeRight $ M.mkSecNonce p (sk1 + 4) (sk2 + 4) pubNonce5 :: PubNonce -pubNonce5 = M.publicNonce secNonce5 +pubNonce5 = unsafeRight $ M.publicNonce secNonce5 diff --git a/lib/Crypto/Curve/Secp256k1/MuSig2.hs b/lib/Crypto/Curve/Secp256k1/MuSig2.hs --- a/lib/Crypto/Curve/Secp256k1/MuSig2.hs +++ b/lib/Crypto/Curve/Secp256k1/MuSig2.hs @@ -19,6 +19,24 @@ [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: @@ -43,7 +61,7 @@ > let pubkeys = [pub1, pub2] > > -- create key aggregation context -> let keyagg_ctx = MuSig2.mkKeyAggContext pubkeys Nothing +> let Right keyagg_ctx = MuSig2.mkKeyAggContext pubkeys Nothing > let agg_pk = MuSig2.aggregatedPubkey keyagg_ctx > > -- message to sign @@ -52,23 +70,23 @@ > -- 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 +> 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 Just aggnonce = MuSig2.aggNonces pubnonces -> let session_ctx = MuSig2.mkSessionContext aggnonce pubkeys [] msg +> let Right aggnonce = MuSig2.aggNonces pubnonces +> let Right 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 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 final_sig = MuSig2.aggPartials psigs session_ctx +> let Right final_sig = MuSig2.aggPartials psigs session_ctx > > -- verify the aggregated signature > Secp256k1.verify_schnorr msg agg_pk final_sig @@ -77,6 +95,7 @@ -} module Crypto.Curve.Secp256k1.MuSig2 ( -- Main types and functions + MuSig2Error (..), sign, SecKey (..), PartialSignature, @@ -94,7 +113,7 @@ Tweak (..), sortPublicKeys, -- nonces - SecNonce (..), + SecNonce, mkSecNonce, SecNonceGenParams (..), defaultSecNonceGenParams, @@ -105,7 +124,7 @@ aggNonces, ) where -import Control.Exception (ErrorCall (..), evaluate, throwIO, try) +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 ( @@ -121,9 +140,8 @@ #if !MIN_VERSION_base(4,20,0) import Data.Foldable (foldl') #endif -import Data.Foldable (toList) -import Data.List (isPrefixOf) -import Data.Maybe (fromJust, fromMaybe) +import Data.Foldable (toList, traverse_) +import Data.Maybe (fromMaybe) import Data.Sequence (Seq) import qualified Data.Sequence as Seq import Data.Traversable () @@ -131,6 +149,51 @@ 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 (Eq, Show) + +liftMaybe :: e -> Maybe a -> Either e a +liftMaybe err = maybe (Left err) Right + +validateSecretScalar :: String -> Integer -> Either MuSig2Error Integer +validateSecretScalar label scalar + | scalar == 0 = Left (SecretScalarZero label) + | scalar < 0 || scalar >= curveOrder = Left (SecretScalarOutOfRange label) + | otherwise = Right scalar + +validateTweakValue :: Integer -> Either MuSig2Error Integer +validateTweakValue tweak + | tweak < 0 = Left (NegativeTweak tweak) + | tweak >= curveOrder = Left (TweakOutOfRange tweak) + | otherwise = Right tweak + +validatePublicKey :: Pub -> Either MuSig2Error Pub +validatePublicKey pub + | pub == _CURVE_ZERO = Left PublicKeyAtInfinity + | otherwise = Right pub + -- | Aggregates 'PartialSignature's into a 64-byte Schnorr signature. aggPartials :: (Traversable t) => @@ -139,26 +202,38 @@ -- | Session context. SessionContext -> -- | 64-byte Schnorr signature. - ByteString + Either MuSig2Error ByteString aggPartials partials ctx = - let - nonce = getSigningNonce ctx - e = bytesToInteger $ getSigningHash ctx - keyCtx = cachedKeyAggCtx ctx - aggPk = q keyCtx - taccVal = maybe 0 getTweak $ tacc keyCtx - gaccVal = gacc keyCtx - -- BIP 327: Let g = 1 if has_even_y(Q), otherwise let g = -1 mod n - g = if isEvenPub aggPk then 1 else curveOrder - 1 - -- Apply accumulated parity factor - g' = modQ (g * gaccVal) - sSum = modQ $ sum partials - -- BIP 327: Let s = s₁ + ... + sᵤ + e⋅g'⋅tacc mod n - s = modQ (sSum + e * g' * taccVal) - left = xBytes nonce - right = integerToBytes32 s - in - left <> right + if Seq.null partialsSeq + then Left EmptyPartialSignatureCollection + else case traverse validatePartialSignature partialsSeq of + Left err -> Left err + Right validPartials -> do + nonce <- getSigningNonce ctx + signingHash <- getSigningHash ctx + let + e = bytesToInteger signingHash + keyCtx = cachedKeyAggCtx ctx + aggPk = q keyCtx + taccVal = maybe 0 getTweak $ tacc keyCtx + gaccVal = gacc keyCtx + -- BIP 327: Let g = 1 if has_even_y(Q), otherwise let g = -1 mod n + evenAggPk <- liftMaybe InvalidPointFormat (isEvenPub aggPk) + let + g = if evenAggPk then 1 else curveOrder - 1 + -- Apply accumulated parity factor + g' = modQ (g * gaccVal) + sSum = modQ $ sum validPartials + -- BIP 327: Let s = s₁ + ... + sᵤ + e⋅g'⋅tacc mod n + s = modQ (sSum + e * g' * taccVal) + left = xBytes nonce + right = integerToBytes32 s + Right (left <> right) + where + partialsSeq = Seq.fromList (toList partials) + validatePartialSignature partial + | partial < 0 || partial >= curveOrder = Left PartialSignatureOutOfRange + | otherwise = Right partial {- | Compute a partial signature on a message. @@ -174,38 +249,46 @@ -- | Session context. SessionContext -> -- | Partial signature. - PartialSignature + Either MuSig2Error PartialSignature sign secnonce sk ctx = - let - publicKeys = pks ctx - nonce = getSigningNonce ctx - e = bytesToInteger $ getSigningHash ctx - keyCtx = cachedKeyAggCtx ctx - aggPk = q keyCtx - oddAggPk = not $ isEvenPub aggPk - gaccVal = gacc keyCtx - k1 = if secnonce.k1 == 0 then error "musig2 (sign): first secret scalar k1 is zero" else secnonce.k1 - k2 = if secnonce.k2 == 0 then error "musig2 (sign): first secret scalar k2 is zero" else secnonce.k2 - d' = if unSecKey sk == 0 then error "musig2 (sign): secret key is zero" else unSecKey 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 = gaccVal /= 1 - d = if parityFromGacc /= oddAggPk then curveOrder - d' else d' - p = fromMaybe (error "musig2 (sign): failed to derive public key") $ derive_pub (fromInteger d') -- Use original secret key for public key derivation - a = computeKeyAggCoef p publicKeys - -- if has_even_Y(R): - -- k = k1 + b*k2 - -- else: - -- k = (n-k1) + b(n-k2) - -- = n - (k1 + b*k2) - b = getSigningNonceCoeff ctx - k = if isEvenPub nonce then k1 + b * k2 else curveOrder - (k1 + b * k2) - s = modQ (k + e * a * d) - r1' = fromMaybe (error "musig2 (sign): failed to compute r1") $ mul _CURVE_G (fromInteger secnonce.k1) - r2' = fromMaybe (error "musig2 (sign): failed to compute r2") $ mul _CURVE_G (fromInteger secnonce.k2) - pubNonce' = PubNonce r1' r2' - in - if partialSigVerifyInternal s pubNonce' p ctx then s else error "musig2 (sign): could not verify partial signature against public nonce, public key and session context" + do + nonce <- getSigningNonce ctx + signingHash <- getSigningHash ctx + let publicKeys = pks ctx + e = bytesToInteger signingHash + keyCtx = cachedKeyAggCtx ctx + aggPk = q keyCtx + gaccVal = gacc keyCtx + SecNonce k1 k2 boundPk = secnonce + evenAggPk <- liftMaybe InvalidPointFormat (isEvenPub aggPk) + evenNonce <- liftMaybe InvalidPointFormat (isEvenPub nonce) + _ <- validateSecretScalar "k1" k1 + _ <- validateSecretScalar "k2" k2 + d' <- validateSecretScalar "secret key" (unSecKey sk) + p <- liftMaybe KeyDerivationFailed $ derive_pub (fromInteger d') + if p /= boundPk + then Left 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 = not evenAggPk + parityFromGacc = gaccVal /= 1 + d = if parityFromGacc /= oddAggPk then curveOrder - d' else d' + a = computeKeyAggCoef p publicKeys + -- if has_even_Y(R): + -- k = k1 + b*k2 + -- else: + -- k = (n-k1) + b(n-k2) + -- = n - (k1 + b*k2) + b = getSigningNonceCoeff ctx + k = if evenNonce then k1 + b * k2 else curveOrder - (k1 + b * k2) + s = modQ (k + e * a * d) + pubNonce' <- publicNonce secnonce + verified <- partialSigVerifyInternal s pubNonce' p ctx + if verified + then Right s + else Left (PublicNonceGenerationFailed "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. @@ -228,19 +311,19 @@ -- | Index of the signer. Int -> -- | If the partial signature is valid. - Bool + Either MuSig2Error Bool partialSigVerify partial nonces pks tweaks msg idx = - let aggNonce = fromJust $ aggNonces nonces - ctx = mkSessionContext aggNonce pks tweaks msg - noncesSeq = Seq.fromList (toList nonces) - pksSeq = Seq.fromList (toList pks) - pk = case Seq.lookup idx pksSeq of - Just p -> p - Nothing -> error "musig2 (partialSigVerify): signer index out of range of the list of public keys" - pubnonce = case Seq.lookup idx noncesSeq of - Just n -> n - Nothing -> error "musig2 (partialSigVerify): signer index out of range of the list of public nonces" - in partialSigVerifyInternal partial pubnonce pk ctx + do + aggNonce <- aggNonces nonces + ctx <- mkSessionContext aggNonce pks tweaks msg + let noncesSeq = Seq.fromList (toList nonces) + pksSeq = Seq.fromList (toList pks) + if Seq.length noncesSeq /= Seq.length pksSeq + then Left (SignerCountMismatch (Seq.length pksSeq) (Seq.length noncesSeq)) + else do + pk <- maybe (Left (InvalidSignerIndex idx)) Right (Seq.lookup idx pksSeq) + pubnonce <- maybe (Left (InvalidSignerIndex idx)) Right (Seq.lookup idx noncesSeq) + partialSigVerifyInternal partial pubnonce pk ctx {- | Verifies a 'PartialSignature'. @@ -258,35 +341,43 @@ -- | MuSig2 session context. SessionContext -> -- | If the partial signature is valid. - Bool + Either MuSig2Error Bool partialSigVerifyInternal partial pubnonce pk ctx = - let - publicKeys = pks ctx - keyCtx = cachedKeyAggCtx ctx - aggPk = q keyCtx - oddAggPk = not $ isEvenPub aggPk - gaccVal = gacc keyCtx - e = bytesToInteger $ getSigningHash ctx - r1' = pubnonce.r1 - r2' = pubnonce.r2 - b = getSigningNonceCoeff ctx - finalNonce = getSigningNonce ctx -- This is the final aggregate nonce used for evenness check - s = if partial < 0 || partial >= curveOrder then error "musig2 (partialSigVerifyInternal): partial signature must be within curve order." else partial - -- Reconstruct the individual's effective nonce: R_s1 + b * R_s2 - r2b = fromMaybe (error "musig2 (partialSigVerifyInternal): failed to compute r2 * b") $ mul r2' (fromInteger b) - re' = add r1' r2b - -- Negate individual nonce if final aggregate nonce has odd Y - re = if isEvenPub finalNonce then re' else neg re' - a = computeKeyAggCoef pk publicKeys - -- Calculate g factor: 1 if aggregate pubkey has even Y, n-1 if odd - g = if oddAggPk then curveOrder - 1 else 1 - -- Apply parity accumulator: gacc is accumulated parity factor - g' = modQ (g * gaccVal) - sG = fromMaybe (error "musig2 (partialSigVerifyInternal): failed to compute s * G") $ mul _CURVE_G (fromInteger s) - pkMul = fromMaybe (error "musig2 (partialSigVerifyInternal): failed to compute pk multiplication") $ mul pk (fromInteger (modQ (e * a * g'))) - sG' = re `add` pkMul - in - sG == sG' + do + s <- validatePartialSignature partial + signingHash <- getSigningHash ctx + finalNonce <- getSigningNonce ctx + let + publicKeys = pks ctx + keyCtx = cachedKeyAggCtx ctx + aggPk = q keyCtx + gaccVal = gacc keyCtx + e = bytesToInteger signingHash + r1' = pubnonce.r1 + r2' = pubnonce.r2 + b = getSigningNonceCoeff ctx + a = computeKeyAggCoef pk publicKeys + evenAggPk <- liftMaybe InvalidPointFormat (isEvenPub aggPk) + evenFinalNonce <- liftMaybe InvalidPointFormat (isEvenPub finalNonce) + let + oddAggPk = not evenAggPk + -- Calculate g factor: 1 if aggregate pubkey has even Y, n-1 if odd + g = if oddAggPk then curveOrder - 1 else 1 + -- Apply parity accumulator: gacc is accumulated parity factor + g' = modQ (g * gaccVal) + r2b <- liftMaybe (ScalarMultiplicationFailed "r2 * b") $ mul r2' (fromInteger b) + sG <- liftMaybe (ScalarMultiplicationFailed "s * G") $ mul _CURVE_G (fromInteger s) + pkMul <- liftMaybe (ScalarMultiplicationFailed "pk multiplication") $ mul pk (fromInteger (modQ (e * a * g'))) + let + re' = add r1' r2b + -- Negate individual nonce if final aggregate nonce has odd Y + re = if evenFinalNonce then re' else neg re' + sG' = re `add` pkMul + Right (sG == sG') + where + validatePartialSignature s + | s < 0 || s >= curveOrder = Left PartialSignatureOutOfRange + | otherwise = Right s -- | Secret key. newtype SecKey = SecKey Integer @@ -328,22 +419,20 @@ -- | Optional 'Tweak' value. Maybe Tweak -> -- | Resulting 'KeyAggContext'. - KeyAggContext + Either MuSig2Error KeyAggContext mkKeyAggContext pks mTweak - | Seq.null pks' = error "musig2 (mkKeyAggContext): empty public key collection" - | Seq.length pks' > fromIntegral (maxBound :: Word32) = error "musig2 (mkKeyAggContext): too many public keys (max 2^32 - 1)" - | _CURVE_ZERO `elem` pks' = error "musig2 (mkKeyAggContext): public key at point of infinity" - | maybe False ((< 0) . getTweak) mTweak = error "musig2 (mkKeyAggContext): tweak must be non-negative" - | maybe False ((>= curveOrder) . getTweak) mTweak = error "musig2 (mkKeyAggContext): tweak must be less than curve order" - | otherwise = case aggPublicKeys pks' of - Nothing -> error "musig2 (mkKeyAggContext): failed to aggregate public keys" - Just aggPk - | aggPk == _CURVE_ZERO -> error "musig2 (mkKeyAggContext): aggregated public key is point at infinity" - | otherwise -> - let baseCtx = KeyAggContext aggPk Nothing 1 - in case mTweak of - Nothing -> baseCtx - Just tweak -> applyTweak baseCtx tweak + | Seq.null pks' = Left EmptyPublicKeyCollection + | Seq.length pks' > fromIntegral (maxBound :: Word32) = Left TooManyPublicKeys + | otherwise = do + traverse_ validatePublicKey pks' + aggPk <- liftMaybe AggregatedPublicKeyAtInfinity $ aggPublicKeys pks' + if aggPk == _CURVE_ZERO + then Left AggregatedPublicKeyAtInfinity + else do + let baseCtx = KeyAggContext aggPk Nothing 1 + case mTweak of + Nothing -> Right baseCtx + Just tweak -> applyTweak baseCtx tweak where pks' = Seq.fromList (toList pks) @@ -387,42 +476,32 @@ -- | Message to be signed. ByteString -> -- | Resulting 'SessionContext'. - SessionContext + Either MuSig2Error SessionContext mkSessionContext aggNonce pks tweaks msg - | Seq.null pks' = error "musig2 (mkSessionContext): empty public key collection" - | Seq.length pks' > fromIntegral (maxBound :: Word32) = error "musig2 (mkSessionContext): too many public keys (max 2^32 - 1)" - | _CURVE_ZERO `elem` pks' = error "musig2 (mkSessionContext): public key at point of infinity" - | Seq.length tweaks' > fromIntegral (maxBound :: Word32) = error "musig2 (mkSessionContext): too many tweaks (max 2^32 - 1)" - | any checkNeg tweaks' = error "musig2 (mkSessionContext): tweaks must be non-negative" - | any checkOrder tweaks' = error "musig2 (mkSessionContext): tweaks must be less than curve order" - | otherwise = case aggPublicKeys pks' of - Nothing -> error "musig2 (mkSessionContext): failed to aggregate public keys" - Just aggPk - | aggPk == _CURVE_ZERO -> error "musig2 (mkSessionContext): aggregated public key is point at infinity" - | otherwise -> SessionContext aggNonce pks' tweaks' msg keyCtx + | Seq.null pks' = Left EmptyPublicKeyCollection + | Seq.length pks' > fromIntegral (maxBound :: Word32) = Left TooManyPublicKeys + | Seq.length tweaks' > fromIntegral (maxBound :: Word32) = Left TooManyTweaks + | otherwise = do + traverse_ validatePublicKey pks' + traverse_ (validateTweakValue . getTweak) tweaks' + keyCtx <- if Seq.null tweaks' then mkKeyAggContext pks' Nothing else mkKeyAggContext pks' Nothing >>= \baseCtx -> foldM applyTweak baseCtx tweaks' + Right (SessionContext aggNonce pks' tweaks' msg keyCtx) where pks' = Seq.fromList (toList pks) tweaks' = Seq.fromList (toList tweaks) - checkNeg = (< 0) . getTweak - checkOrder = (>= curveOrder) . getTweak - -- Compute and cache the KeyAggContext once - keyCtx = - let baseCtx = mkKeyAggContext pks' Nothing - in if Seq.null tweaks' then baseCtx else foldl' applyTweak baseCtx 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 -> Projective -getSigningNonce ctx = +getSigningNonce :: SessionContext -> Either MuSig2Error Projective +getSigningNonce ctx = do let b = getSigningNonceCoeff ctx aggNonce = ctx.aggNonce aggNonce' = if aggNonce.r1 == _CURVE_ZERO then PubNonce _CURVE_G aggNonce.r2 else aggNonce - r2b = fromMaybe (error "musig2 (getSigningNonce): failed to compute r2 * b") $ mul aggNonce'.r2 (fromInteger b) - finalNonce = add aggNonce'.r1 r2b - in - if finalNonce == _CURVE_ZERO then _CURVE_G else finalNonce + r2b <- liftMaybe (ScalarMultiplicationFailed "r2 * b") $ mul aggNonce'.r2 (fromInteger b) + let finalNonce = add aggNonce'.r1 r2b + Right (if finalNonce == _CURVE_ZERO then _CURVE_G else 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). @@ -447,17 +526,16 @@ [MuSig2 paper, page 6](https://eprint.iacr.org/2020/1261). In the BIP-0327 it is referred as @e@. -} -getSigningHash :: SessionContext -> ByteString -getSigningHash ctx = +getSigningHash :: SessionContext -> Either MuSig2Error ByteString +getSigningHash ctx = do + nonce <- getSigningNonce ctx let aggPubKey = q (cachedKeyAggCtx ctx) qBytes = xBytes aggPubKey msg = ctx.msg - nonce = getSigningNonce ctx r = xBytes nonce preimage = r <> qBytes <> msg - in - hashTagModQ "BIP0340/challenge" preimage + Right (hashTagModQ "BIP0340/challenge" preimage) -- | Tweak that can be added to an aggregated 'Pub'key. data Tweak @@ -476,36 +554,35 @@ getTweak (XOnlyTweak int) = int getTweak (PlainTweak int) = int --- | Applies a tweak to a KeyAggContext and returns a new KeyAggContext following [BIP-0327](https://github.com/bitcoin/bips/blob/master/bip-0327.mediawiki). -applyTweak :: KeyAggContext -> Tweak -> KeyAggContext -applyTweak ctx newTweak = +applyTweak :: KeyAggContext -> Tweak -> Either MuSig2Error KeyAggContext +applyTweak ctx newTweak = do let pubkey = q ctx mAccTweak = tacc ctx gaccIn = gacc ctx accTweakVal = maybe 0 getTweak mAccTweak - in case newTweak of - PlainTweak t -> - -- Plain tweak: g = 1, Q' = g*Q + t*G, tacc' = t + g*tacc, gacc' = g*gacc - let g = 1 - pubkeyMul = fromMaybe (error "musig2 (applyTweak): failed to compute pubkey * g") $ mul pubkey (fromInteger g) - tG = fromMaybe (error "musig2 (applyTweak): failed to compute t * G") $ mul _CURVE_G (fromInteger t) - tweakedPk = add pubkeyMul tG - newAccTweak = modQ (t + (g * accTweakVal)) - newGacc = modQ (g * gaccIn) - in if tweakedPk == _CURVE_ZERO - then error "musig2 (applyTweak): result of tweaking cannot be infinity" - else ctx{q = tweakedPk, tacc = Just (PlainTweak newAccTweak), gacc = newGacc} - XOnlyTweak t -> - -- X-only tweak: g = 1 if even Y, g = n-1 if odd Y, tacc' = t + g*tacc - let g = if isEvenPub pubkey then 1 else curveOrder - 1 - pubkeyMul = fromMaybe (error "musig2 (applyTweak): failed to compute pubkey * g") $ mul pubkey (fromInteger g) - tG = fromMaybe (error "musig2 (applyTweak): failed to compute t * G") $ mul _CURVE_G (fromInteger t) - tweakedPk = add pubkeyMul tG - newAccTweak = modQ (t + (g * accTweakVal)) - newGacc = modQ (g * gaccIn) - in if tweakedPk == _CURVE_ZERO - then error "musig2 (applyTweak): result of tweaking cannot be infinity" - else ctx{q = tweakedPk, tacc = Just (XOnlyTweak newAccTweak), gacc = newGacc} + t <- validateTweakValue (getTweak newTweak) + case newTweak of + PlainTweak _ -> do + let g = 1 + pubkeyMul <- liftMaybe (ScalarMultiplicationFailed "pubkey * g") $ mul pubkey (fromInteger g) + tG <- liftMaybe (ScalarMultiplicationFailed "t * G") $ mul _CURVE_G (fromInteger t) + let tweakedPk = add pubkeyMul tG + newAccTweak = modQ (t + (g * accTweakVal)) + newGacc = modQ (g * gaccIn) + if tweakedPk == _CURVE_ZERO + then Left TweakResultAtInfinity + else Right ctx{q = tweakedPk, tacc = Just (PlainTweak newAccTweak), gacc = newGacc} + XOnlyTweak _ -> do + evenPubkey <- liftMaybe InvalidPointFormat (isEvenPub pubkey) + let g = if evenPubkey then 1 else curveOrder - 1 + pubkeyMul <- liftMaybe (ScalarMultiplicationFailed "pubkey * g") $ mul pubkey (fromInteger g) + tG <- liftMaybe (ScalarMultiplicationFailed "t * G") $ mul _CURVE_G (fromInteger t) + let tweakedPk = add pubkeyMul tG + newAccTweak = modQ (t + (g * accTweakVal)) + newGacc = modQ (g * gaccIn) + if tweakedPk == _CURVE_ZERO + then Left TweakResultAtInfinity + else Right ctx{q = tweakedPk, tacc = Just (XOnlyTweak newAccTweak), gacc = newGacc} -- | Manual 'Ord' implementation of 'Projective' for lexicography sorting. instance Ord Projective where @@ -532,41 +609,38 @@ {- | 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 -[BIP-0327](https://github.com/bitcoin/bips/blob/master/bip-0327.mediawiki) -suggestions, then use 'secNonceGen' otherwise use 'mkSecNonce'. --} -data SecNonce = SecNonce - { k1 :: !Integer - -- ^ First secret scalar. - , k2 :: !Integer - -- ^ Second secret scalar. - } - deriving (Read, Eq, Ord, Generic) +signing. -{- | 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. +== SECURITY: Single-Use Requirement -== WARNING +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. -Make sure that you have access to a good CSPRNG in your system before calling -this function. +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. -Note that this does not follow the +If you want to follow [BIP-0327](https://github.com/bitcoin/bips/blob/master/bip-0327.mediawiki) -algorithm. +suggestions, then use 'secNonceGen' otherwise use 'mkSecNonce'. + +@since 0.2.0 -} -mkSecNonce :: IO SecNonce -mkSecNonce = do - bytes <- getEntropy 64 -- 64 bytes = 512 bits for two 256-bit scalars - let k1' = bytesToInteger (BS.take 32 bytes) - k2' = bytesToInteger (BS.drop 32 bytes) - pure SecNonce{k1 = k1', k2 = k2'} +mkSecNonce :: + -- | Public key this nonce is bound to. + Pub -> + -- | First secret scalar. + Integer -> + -- | Second secret scalar. + Integer -> + Either MuSig2Error SecNonce +mkSecNonce pub k1 k2 = do + _ <- validatePublicKey pub + k1' <- validateSecretScalar "k1" k1 + k2' <- validateSecretScalar "k2" k2 + Right SecNonce{secNonceK1Internal = k1', secNonceK2Internal = k2', secNoncePubKeyInternal = pub} -- | Required and Optional data to generate a 'SecNonce'. data SecNonceGenParams = SecNonceGenParams @@ -606,16 +680,14 @@ Make sure that you have access to a good CSPRNG in your system before calling this function. -} -secNonceGen :: SecNonceGenParams -> IO SecNonce +secNonceGen :: SecNonceGenParams -> IO (Either MuSig2Error SecNonce) secNonceGen params = loop where loop = do rand <- getEntropy 32 - eres <- try (evaluate (secNonceGenWithRand rand params)) - case eres of - Right sn -> pure sn - Left (ErrorCall msg) | "musig2 (nonceGen): zero nonce generated" `isPrefixOf` msg -> loop - Left e -> throwIO e + case secNonceGenWithRand rand params of + Left ZeroNonceGenerated -> loop + other -> pure other {- | Generates a 'SecNonce' using a given random 'ByteString' and the inputs and algorithms from @@ -626,8 +698,21 @@ You should probably use 'secNonceGen'. Use this function if you really have a randomly-generated 'ByteString'. -} -secNonceGenWithRand :: ByteString -> SecNonceGenParams -> SecNonce -secNonceGenWithRand rand _params@(SecNonceGenParams{_pk = pkPoint, ..}) = +secNonceGenWithRand :: ByteString -> SecNonceGenParams -> Either MuSig2Error SecNonce +secNonceGenWithRand rand _params@(SecNonceGenParams{_pk = pkPoint, ..}) = do + if BS.length rand /= 32 + then Left (InvalidRandomBytesLength (BS.length rand)) + else Right () + _ <- validatePublicKey pkPoint + traverse_ validatePublicKey _aggpk + case _sk of + Nothing -> Right () + Just (SecKey skScalar) -> do + skScalar' <- validateSecretScalar "secret key" skScalar + expectedPk <- liftMaybe KeyDerivationFailed $ derive_pub (fromInteger skScalar') + if expectedPk == pkPoint + then Right () + else Left SecretKeyPublicKeyMismatch let -- Step 2: Optional sk XOR (with tagged hash for safety) rand' = case _sk of @@ -663,11 +748,9 @@ k1' = modQ . bytesToInteger $ hashTag "MuSig/nonce" (mkInput 0) k2' = modQ . bytesToInteger $ hashTag "MuSig/nonce" (mkInput 1) - in - -- Step 9: check for zero nonce and retry if so - if k1' == 0 || k2' == 0 - then error "musig2 (nonceGen): zero nonce generated (retry)" - else SecNonce{k1 = k1', k2 = k2'} + if k1' == 0 || k2' == 0 + then Left ZeroNonceGenerated + else mkSecNonce pkPoint k1' k2' {- | Public nonce. @@ -686,11 +769,12 @@ deriving (Eq, Ord, Show) -- | Generates a 'PubNonce' from a 'SecNonce'. -publicNonce :: SecNonce -> PubNonce -publicNonce secNonce = - let r1' = fromMaybe (error "musig2 (publicNonce): failed to compute r1") $ mul _CURVE_G (fromInteger (k1 secNonce)) - r2' = fromMaybe (error "musig2 (publicNonce): failed to compute r2") $ mul _CURVE_G (fromInteger (k2 secNonce)) - in PubNonce r1' r2' +publicNonce :: SecNonce -> Either MuSig2Error PubNonce +publicNonce secNonce = do + let (k1, k2) = secNonceScalars secNonce + r1' <- liftMaybe (ScalarMultiplicationFailed "k1 * G") $ mul _CURVE_G (fromInteger k1) + r2' <- liftMaybe (ScalarMultiplicationFailed "k2 * G") $ mul _CURVE_G (fromInteger k2) + Right (PubNonce r1' r2') -- | 'Data.Semigroup' implementation of 'PubNonce' for algebraic sound combination of public nonces. instance Semigroup PubNonce where @@ -708,11 +792,11 @@ {- | 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 -> Maybe PubNonce +aggNonces :: (Traversable t) => t PubNonce -> Either MuSig2Error PubNonce aggNonces nonces - | Seq.null noncesSeq = Nothing + | Seq.null noncesSeq = Left EmptyNonceCollection | otherwise = case Seq.viewl noncesSeq of - Seq.EmptyL -> Nothing - x Seq.:< xs -> Just $! foldl' (<>) x xs + Seq.EmptyL -> Left EmptyNonceCollection + x Seq.:< xs -> Right $! foldl' (<>) x xs where noncesSeq = Seq.fromList (toList nonces) diff --git a/lib/Crypto/Curve/Secp256k1/MuSig2/Internal.hs b/lib/Crypto/Curve/Secp256k1/MuSig2/Internal.hs --- a/lib/Crypto/Curve/Secp256k1/MuSig2/Internal.hs +++ b/lib/Crypto/Curve/Secp256k1/MuSig2/Internal.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -17,6 +18,9 @@ -- Key aggregation computeKeyAggCoef, getSecondKey, + -- SecNonce internals (not re-exported from public API) + SecNonce (..), + secNonceScalars, -- utils/misc isEvenPub, xBytes, @@ -44,7 +48,23 @@ import Data.Sequence (Seq) import qualified Data.Sequence as Seq import Data.Traversable () +import GHC.Generics (Generic) +-- | Secret nonce (internal representation). See public API for documentation. +data SecNonce = SecNonce + { secNonceK1Internal :: !Integer + -- ^ First secret scalar. + , secNonceK2Internal :: !Integer + -- ^ Second secret scalar. + , secNoncePubKeyInternal :: !Pub + -- ^ Public key this nonce is bound to. + } + deriving (Generic) + +-- | Returns the two secret scalars contained in a 'SecNonce'. +secNonceScalars :: SecNonce -> (Integer, Integer) +secNonceScalars secNonce = (secNonceK1Internal secNonce, secNonceK2Internal secNonce) + {- | Aggregates a 'Traversable' of 'Pub'keys using the [Key Aggregation algorithm in BIP-0327](https://github.com/bitcoin/bips/blob/master/bip-0327.mediawiki). @@ -144,12 +164,12 @@ encodeLen :: ByteString -> ByteString encodeLen bs = BSL.toStrict . toLazyByteString . word64BE . fromIntegral $ BS.length bs --- | Checks if a 'Pub'key is even. -isEvenPub :: Pub -> Bool +-- | Checks if a 'Pub'key is even. Returns 'Nothing' for invalid compressed point formats. +isEvenPub :: Pub -> Maybe Bool isEvenPub pub = case BS.unpack (serialize_point pub) of - (0x02 : _) -> True -- even y-coordinate - (0x03 : _) -> False -- odd y-coordinate - _ -> error "musig2 (isEvenPub): invalid compressed point format" + (0x02 : _) -> Just True -- even y-coordinate + (0x03 : _) -> Just False -- odd y-coordinate + _ -> Nothing -- | Gets the X-coordinate from a 'Pub'lic key as 'ByteString' xBytes :: Pub -> ByteString diff --git a/musig2.cabal b/musig2.cabal --- a/musig2.cabal +++ b/musig2.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: musig2 -version: 0.1.4 +version: 0.2.0 synopsis: MuSig2 library license: MIT license-file: LICENSE @@ -34,15 +34,15 @@ exposed-modules: Crypto.Curve.Secp256k1.MuSig2 other-modules: Crypto.Curve.Secp256k1.MuSig2.Internal build-depends: - , base >=4.19 && <5 - , base16-bytestring >=1.0 && <1.1.0 - , binary >=0.8 && <0.9 - , bytestring >=0.9 && <0.13 - , containers >=0.6 && <0.9 - , entropy >=0.4 && <0.5 - , ppad-hmac-drbg >=0.2 && <0.3 - , ppad-secp256k1 >=0.5 && <0.6 - , ppad-sha256 >=0.3 && <0.4 + , base >=4.19 && <5 + , base16-bytestring >=1.0 && <1.1 + , binary >=0.8 && <0.9 + , bytestring >=0.9 && <0.13 + , containers >=0.6 && <0.9 + , entropy >=0.4 && <0.5 + , ppad-hmac-drbg >=0.3.1 && <0.4 + , ppad-secp256k1 >=0.5.4 && <0.6 + , ppad-sha256 >=0.3.2 && <0.4 test-suite musig2-tests type: exitcode-stdio-1.0 diff --git a/test/AggNonces.hs b/test/AggNonces.hs --- a/test/AggNonces.hs +++ b/test/AggNonces.hs @@ -4,10 +4,9 @@ import Crypto.Curve.Secp256k1 (_CURVE_ZERO) import Crypto.Curve.Secp256k1.MuSig2 (PubNonce (..), aggNonces) -import Data.Maybe (fromJust) import Test.Tasty import Test.Tasty.HUnit -import Util (parsePoint, parsePubNonce) +import Util (parsePoint, parsePubNonce, unsafeRight) -- | Input 'PubNonce's from BIP-0327 test vectors inputPubNonces :: [PubNonce] @@ -32,7 +31,7 @@ makeTestCase :: Int -> ([Int], PubNonce) -> TestTree makeTestCase i (indices, expected) = testCase ("BIP-0327 test vector " <> show (i + 1)) $ - fromJust aggNonce @=? expected + unsafeRight aggNonce @=? expected where selectedNonces = map (inputPubNonces !!) indices aggNonce = aggNonces selectedNonces diff --git a/test/AggPartials.hs b/test/AggPartials.hs --- a/test/AggPartials.hs +++ b/test/AggPartials.hs @@ -5,11 +5,11 @@ module AggPartials (testAggPartials) where import Crypto.Curve.Secp256k1 (Pub) -import Crypto.Curve.Secp256k1.MuSig2 (PartialSignature, PubNonce (..), Tweak (..), aggPartials, mkSessionContext) +import Crypto.Curve.Secp256k1.MuSig2 (MuSig2Error (..), PartialSignature, PubNonce (..), Tweak (..), aggPartials, mkSessionContext) import Data.ByteString (ByteString) import Test.Tasty import Test.Tasty.HUnit -import Util (decodeHex, parsePoint, parsePubNonce, parseScalar) +import Util (decodeHex, parsePoint, parsePubNonce, parseScalar, unsafeRight) -- | Test vector structure for signature aggregation. data SigAggTestVector = SigAggTestVector @@ -142,8 +142,8 @@ let selectedKeys = map (pubkeys !!) keyIndices let selectedTweaks = buildTweaks tweakIndices isXOnly let selectedPsigs = map (psigs !!) psigIndices - let ctx = mkSessionContext aggNonce selectedKeys selectedTweaks msg - let result = aggPartials selectedPsigs ctx + let ctx = unsafeRight $ mkSessionContext aggNonce selectedKeys selectedTweaks msg + let result = unsafeRight $ aggPartials selectedPsigs ctx case expected of Just expectedSig -> assertEqual "signature mismatch" expectedSig result Nothing -> assertFailure "Expected signature but got nothing" @@ -152,10 +152,12 @@ makeErrorTestCase :: Int -> SigAggTestVector -> TestTree makeErrorTestCase i SigAggTestVector{..} = testCase ("BIP-0327 SigAgg Error Vector " ++ show (i + 1)) $ do - -- For the error case, we expect aggPartials to fail due to invalid partial signature - -- The test vector has psig[8] which is FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141 - -- This exceeds the curve order and should cause validation to fail + let selectedKeys = map (pubkeys !!) keyIndices + selectedTweaks = buildTweaks tweakIndices isXOnly + selectedPsigs = map (psigs !!) psigIndices + ctx = unsafeRight $ mkSessionContext aggNonce selectedKeys selectedTweaks msg assertBool "Expected error case" errorCase + aggPartials selectedPsigs ctx @?= Left PartialSignatureOutOfRange -- | Main test group for signature aggregation. testAggPartials :: TestTree diff --git a/test/AggPartialsProperty.hs b/test/AggPartialsProperty.hs --- a/test/AggPartialsProperty.hs +++ b/test/AggPartialsProperty.hs @@ -1,15 +1,15 @@ +{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} module AggPartialsProperty (propertyAggPartials) where -import Crypto.Curve.Secp256k1 (derive_pub) -import Crypto.Curve.Secp256k1.MuSig2 (SecKey (..), SecNonce (..), aggNonces, aggPartials, mkSessionContext, partialSigVerify, publicNonce, sign) +import Crypto.Curve.Secp256k1 (Pub) +import Crypto.Curve.Secp256k1.MuSig2 (PubNonce, SessionContext, aggNonces, aggPartials, mkSessionContext, partialSigVerify, publicNonce, sign) import Data.ByteString (ByteString) import qualified Data.ByteString as BS -import Data.Maybe (fromJust, fromMaybe) import Test.Tasty import Test.Tasty.QuickCheck as QC -import Util () +import Util (SignerMaterial (..), unsafeRight) propertyAggPartials :: TestTree propertyAggPartials = @@ -21,61 +21,53 @@ , testProperty "Aggregation with single signer equals partial sig" prop_singleSignerAgg ] +mkTwoSignerContext :: SignerMaterial -> SignerMaterial -> ByteString -> ([PubNonce], [Pub], SessionContext) +mkTwoSignerContext signer1 signer2 msg = + let pubNonces = [unsafeRight $ publicNonce signer1.signerSecNonce, unsafeRight $ publicNonce signer2.signerSecNonce] + pubkeys = [signer1.signerPubKey, signer2.signerPubKey] + aggNonce = unsafeRight $ aggNonces pubNonces + ctx = unsafeRight $ mkSessionContext aggNonce pubkeys [] msg + in (pubNonces, pubkeys, ctx) + -- | Property: Aggregating valid partial signatures produces a consistent result -prop_aggValidPartials :: SecNonce -> SecKey -> SecNonce -> SecKey -> ByteString -> Property -prop_aggValidPartials secNonce1 secKey1 secNonce2 secKey2 msg = - let pubkey1 = fromMaybe (error "Failed to derive pubkey1") $ derive_pub (fromInteger (case secKey1 of SecKey sk -> sk)) - pubkey2 = fromMaybe (error "Failed to derive pubkey2") $ derive_pub (fromInteger (case secKey2 of SecKey sk -> sk)) - pubkeys = [pubkey1, pubkey2] - pubNonces = [publicNonce secNonce1, publicNonce secNonce2] - aggNonce = fromJust $ aggNonces pubNonces - ctx = mkSessionContext aggNonce pubkeys [] msg - partialSig1 = sign secNonce1 secKey1 ctx - partialSig2 = sign secNonce2 secKey2 ctx - aggregated = aggPartials [partialSig1, partialSig2] ctx - in BS.length aggregated === 64 -- Schnorr signature is 64 bytes +prop_aggValidPartials :: SignerMaterial -> SignerMaterial -> ByteString -> Property +prop_aggValidPartials signer1 signer2 msg = + let (_, _, ctx) = mkTwoSignerContext signer1 signer2 msg + partialSig1 = unsafeRight $ sign signer1.signerSecNonce signer1.signerSecKey ctx + partialSig2 = unsafeRight $ sign signer2.signerSecNonce signer2.signerSecKey ctx + aggregated = unsafeRight $ aggPartials [partialSig1, partialSig2] ctx + in BS.length aggregated === 64 -- | Property: Aggregation is deterministic - same inputs produce same output -prop_aggDeterministic :: SecNonce -> SecKey -> SecNonce -> SecKey -> ByteString -> Property -prop_aggDeterministic secNonce1 secKey1 secNonce2 secKey2 msg = - let pubkey1 = fromMaybe (error "Failed to derive pubkey1") $ derive_pub (fromInteger (case secKey1 of SecKey sk -> sk)) - pubkey2 = fromMaybe (error "Failed to derive pubkey2") $ derive_pub (fromInteger (case secKey2 of SecKey sk -> sk)) - pubkeys = [pubkey1, pubkey2] - pubNonces = [publicNonce secNonce1, publicNonce secNonce2] - aggNonce = fromJust $ aggNonces pubNonces - ctx = mkSessionContext aggNonce pubkeys [] msg - partialSig1 = sign secNonce1 secKey1 ctx - partialSig2 = sign secNonce2 secKey2 ctx +prop_aggDeterministic :: SignerMaterial -> SignerMaterial -> ByteString -> Property +prop_aggDeterministic signer1 signer2 msg = + let (_, _, ctx) = mkTwoSignerContext signer1 signer2 msg + partialSig1 = unsafeRight $ sign signer1.signerSecNonce signer1.signerSecKey ctx + partialSig2 = unsafeRight $ sign signer2.signerSecNonce signer2.signerSecKey ctx partialSigs = [partialSig1, partialSig2] - aggregated1 = aggPartials partialSigs ctx - aggregated2 = aggPartials partialSigs ctx + aggregated1 = unsafeRight $ aggPartials partialSigs ctx + aggregated2 = unsafeRight $ aggPartials partialSigs ctx in aggregated1 === aggregated2 -- | Property: All partial signatures should verify individually before aggregation -prop_partialsVerifyBeforeAgg :: SecNonce -> SecKey -> SecNonce -> SecKey -> ByteString -> Property -prop_partialsVerifyBeforeAgg secNonce1 secKey1 secNonce2 secKey2 msg = - let pubkey1 = fromMaybe (error "Failed to derive pubkey1") $ derive_pub (fromInteger (case secKey1 of SecKey sk -> sk)) - pubkey2 = fromMaybe (error "Failed to derive pubkey2") $ derive_pub (fromInteger (case secKey2 of SecKey sk -> sk)) - pubkeys = [pubkey1, pubkey2] - pubNonces = [publicNonce secNonce1, publicNonce secNonce2] - aggNonce = fromJust $ aggNonces pubNonces - ctx = mkSessionContext aggNonce pubkeys [] msg - partialSig1 = sign secNonce1 secKey1 ctx - partialSig2 = sign secNonce2 secKey2 ctx +prop_partialsVerifyBeforeAgg :: SignerMaterial -> SignerMaterial -> ByteString -> Property +prop_partialsVerifyBeforeAgg signer1 signer2 msg = + let (pubNonces, pubkeys, ctx) = mkTwoSignerContext signer1 signer2 msg + partialSig1 = unsafeRight $ sign signer1.signerSecNonce signer1.signerSecKey ctx + partialSig2 = unsafeRight $ sign signer2.signerSecNonce signer2.signerSecKey ctx verify1 = partialSigVerify partialSig1 pubNonces pubkeys [] msg 0 verify2 = partialSigVerify partialSig2 pubNonces pubkeys [] msg 1 - in verify1 === True .&&. verify2 === True + in verify1 === Right True .&&. verify2 === Right True -- | Property: For a single signer, aggregation should work correctly -prop_singleSignerAgg :: SecNonce -> SecKey -> ByteString -> Property -prop_singleSignerAgg secNonce secKey@(SecKey sk) msg = - let pubkey = fromMaybe (error "Failed to derive pubkey") $ derive_pub (fromInteger sk) - pubNonce = publicNonce secNonce +prop_singleSignerAgg :: SignerMaterial -> ByteString -> Property +prop_singleSignerAgg signer msg = + let pubNonce = unsafeRight $ publicNonce signer.signerSecNonce pubNonces = [pubNonce] - pubkeys = [pubkey] - aggNonce = fromJust $ aggNonces pubNonces - ctx = mkSessionContext aggNonce pubkeys [] msg - partialSig = sign secNonce secKey ctx - aggregated = aggPartials [partialSig] ctx + pubkeys = [signer.signerPubKey] + aggNonce = unsafeRight $ aggNonces pubNonces + ctx = unsafeRight $ mkSessionContext aggNonce pubkeys [] msg + partialSig = unsafeRight $ sign signer.signerSecNonce signer.signerSecKey ctx + aggregated = unsafeRight $ aggPartials [partialSig] ctx verifyResult = partialSigVerify partialSig pubNonces pubkeys [] msg 0 - in verifyResult === True .&&. BS.length aggregated === 64 + in verifyResult === Right True .&&. BS.length aggregated === 64 diff --git a/test/AggPubkeys.hs b/test/AggPubkeys.hs --- a/test/AggPubkeys.hs +++ b/test/AggPubkeys.hs @@ -2,13 +2,12 @@ module AggPubkeys (testAggPubkeys) where -import Control.Exception (ErrorCall (..), evaluate, try) import Crypto.Curve.Secp256k1 (Pub) -import Crypto.Curve.Secp256k1.MuSig2 (Tweak (..), aggregatedPubkey, mkKeyAggContext) +import Crypto.Curve.Secp256k1.MuSig2 (MuSig2Error (..), Tweak (..), aggregatedPubkey, mkKeyAggContext) import Data.ByteString (ByteString) import Test.Tasty import Test.Tasty.HUnit -import Util (decodeHex, extractXOnly, parsePoint) +import Util (decodeHex, extractXOnly, parsePoint, unsafeRight) -- | Input public keys from BIP-0327 test vectors inputPubkeys :: [Pub] @@ -40,11 +39,14 @@ , 0x252E4BD67410A76CDF933D30EAA1608214037F1B105A013ECCD3C5C184A6110B -- tweak that causes infinity ] --- | Error test cases: (key indices, tweak index, is_xonly, expected error message). -errorTestVectors :: [([Int], Int, Bool, String)] +invalidTweakOutOfRange :: Integer +invalidTweakOutOfRange = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141 + +-- | Error test cases: (key indices, tweak index, is_xonly, expected error). +errorTestVectors :: [([Int], Int, Bool, MuSig2Error)] errorTestVectors = - [ ([0, 1], 0, True, "tweak must be less than curve order") -- Tweak is out of range - , ([6], 1, False, "result of tweaking cannot be infinity") -- Intermediate tweaking result is point at infinity + [ ([0, 1], 0, True, TweakOutOfRange invalidTweakOutOfRange) + , ([6], 1, False, TweakResultAtInfinity) ] -- | Creates test case from vector data. @@ -54,28 +56,20 @@ extractXOnly aggPk @=? expected where selectedKeys = map (inputPubkeys !!) indices - keyAggCtx = mkKeyAggContext selectedKeys Nothing + keyAggCtx = unsafeRight $ mkKeyAggContext selectedKeys Nothing aggPk = aggregatedPubkey keyAggCtx -- | Creates error test case from vector data. -makeErrorTestCase :: Int -> ([Int], Int, Bool, String) -> TestTree +makeErrorTestCase :: Int -> ([Int], Int, Bool, MuSig2Error) -> TestTree makeErrorTestCase i (keyIndices, tweakIndex, isXOnly, expectedMsg) = testCase ("BIP-0327 error test vector " <> show (i + 1)) $ do - result <- try $ evaluate $ mkKeyAggContext selectedKeys (Just tweak) - case result of - Left (ErrorCall msg) -> assertBool ("Expected '" <> expectedMsg <> "' in error message, got: " <> msg) (expectedMsg `isSubsequenceOf` msg) + case mkKeyAggContext selectedKeys (Just tweak) of + Left err -> err @?= expectedMsg Right _ -> assertFailure "Expected error but got success" where selectedKeys = map (inputPubkeys !!) keyIndices tweakVal = tweaks !! tweakIndex tweak = if isXOnly then XOnlyTweak tweakVal else PlainTweak tweakVal - - isSubsequenceOf :: String -> String -> Bool - isSubsequenceOf [] _ = True - isSubsequenceOf _ [] = False - isSubsequenceOf (x : xs) (y : ys) - | x == y = isSubsequenceOf xs ys - | otherwise = isSubsequenceOf (x : xs) ys -- | Test vectors from [BIP-0327 `key_agg_vectors.json`](https://github.com/bitcoin/bips/blob/master/bip-0327/vectors/key_agg_vectors.json). testAggPubkeys :: TestTree diff --git a/test/ApplyTweaks.hs b/test/ApplyTweaks.hs --- a/test/ApplyTweaks.hs +++ b/test/ApplyTweaks.hs @@ -9,7 +9,7 @@ import Data.Maybe (fromJust) import Test.Tasty import Test.Tasty.HUnit -import Util (decodeHex, extractXOnly, parsePoint) +import Util (decodeHex, extractXOnly, parsePoint, unsafeRight) -- | Computes taproot tweak from pubkey and merkle root. computeTaprootTweak :: Pub -> ByteString -> Integer @@ -32,23 +32,23 @@ testTweakSequence :: TestTree testTweakSequence = testCase "Tweak sequence" $ do - let keyAggCtx1 = mkKeyAggContext testPubkeys Nothing + let keyAggCtx1 = unsafeRight $ mkKeyAggContext testPubkeys Nothing -- Apply first X-only tweak let tweak1 = XOnlyTweak 0xE8F791FF9225A2AF0102AFFF4A9A723D9612A682A25EBE79802B263CDFCD83BB - keyAggCtx2 = applyTweak keyAggCtx1 tweak1 + keyAggCtx2 = unsafeRight $ applyTweak keyAggCtx1 tweak1 -- Apply second X-only tweak let tweak2 = XOnlyTweak 0xAE2EA797CC0FE72AC5B97B97F3C6957D7E4199A167A58EB08BCAFFDA70AC0455 - keyAggCtx3 = applyTweak keyAggCtx2 tweak2 + keyAggCtx3 = unsafeRight $ applyTweak keyAggCtx2 tweak2 -- Apply third plain tweak let tweak3 = PlainTweak 0xF52ECBC565B3D8BEA2DFD5B75A4F457E54369809322E4120831626F290FA87E0 - keyAggCtx4 = applyTweak keyAggCtx3 tweak3 + keyAggCtx4 = unsafeRight $ applyTweak keyAggCtx3 tweak3 -- Apply fourth plain tweak let tweak4 = PlainTweak 0x1969AD73CC177FA0B4FCED6DF1F7BF9907E665FDE9BA196A74FED0A3CF5AEF9D - finalKeyAggCtx = applyTweak keyAggCtx4 tweak4 + finalKeyAggCtx = unsafeRight $ applyTweak keyAggCtx4 tweak4 finalAggPk = aggregatedPubkey finalKeyAggCtx expected = fromJust $ parse_point $ decodeHex "0269434B39A026A4AAC9E6C1AEBDD3993FFA581C8F7F21B6FAAE15608057F5CE85" @@ -58,13 +58,13 @@ testTaprootTweak :: TestTree testTaprootTweak = testCase "Taproot tweak with merkle root" $ do - let keyAggCtx = mkKeyAggContext testPubkeys Nothing + let keyAggCtx = unsafeRight $ mkKeyAggContext testPubkeys Nothing originalPk = aggregatedPubkey keyAggCtx merkleRootBytes = decodeHex "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA" -- Compute proper taproot tweak hash taprootTweakValue = computeTaprootTweak originalPk merkleRootBytes taprootTweak = XOnlyTweak taprootTweakValue - tweakedCtx = applyTweak keyAggCtx taprootTweak + tweakedCtx = unsafeRight $ applyTweak keyAggCtx taprootTweak tweakedPk = aggregatedPubkey tweakedCtx expected = fromJust $ parse_point $ decodeHex "024650cca5e389f62e960f66ca0400927a7727fc6e84b9c38a1fd9a80271377ceb" diff --git a/test/NonceGen.hs b/test/NonceGen.hs --- a/test/NonceGen.hs +++ b/test/NonceGen.hs @@ -5,12 +5,13 @@ module NonceGen (testNonceGen) where import Crypto.Curve.Secp256k1 (Pub) -import Crypto.Curve.Secp256k1.MuSig2 (PubNonce (..), SecKey (..), SecNonce (..), SecNonceGenParams (..), publicNonce, secNonceGenWithRand) +import Crypto.Curve.Secp256k1.MuSig2 (PubNonce (..), SecKey (..), SecNonceGenParams (..), publicNonce, secNonceGenWithRand) +import Crypto.Curve.Secp256k1.MuSig2.Internal (secNonceScalars) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Test.Tasty import Test.Tasty.HUnit -import Util (decodeHex, parsePoint, parseScalar) +import Util (decodeHex, parsePoint, parseScalar, unsafeRight) -- | Test vector structure. data NonceGenTestVector = NonceGenTestVector @@ -91,10 +92,11 @@ , _msg = msg , _extraIn = extra_in } - let sec = secNonceGenWithRand rand_ params - let pub = publicNonce sec - assertEqual "k1 mismatch" expected_k1 sec.k1 - assertEqual "k2 mismatch" expected_k2 sec.k2 + let sec = unsafeRight $ secNonceGenWithRand rand_ params + let pub = unsafeRight $ publicNonce sec + let (k1, k2) = secNonceScalars sec + assertEqual "k1 mismatch" expected_k1 k1 + assertEqual "k2 mismatch" expected_k2 k2 assertEqual "r1 mismatch" expected_r1 pub.r1 assertEqual "r2 mismatch" expected_r2 pub.r2 diff --git a/test/NonceGenProperty.hs b/test/NonceGenProperty.hs --- a/test/NonceGenProperty.hs +++ b/test/NonceGenProperty.hs @@ -1,16 +1,15 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} module NonceGenProperty (propertyNonceGen) where -import Crypto.Curve.Secp256k1 (mul, _CURVE_G) -import Crypto.Curve.Secp256k1.MuSig2 (PubNonce (..), SecKey (..), SecNonce (..), SecNonceGenParams (..), publicNonce, secNonceGenWithRand) -import Crypto.Curve.Secp256k1.MuSig2.Internal (curveOrder, hashTag, integerToBytes32, xorByteStrings) +import Crypto.Curve.Secp256k1 (derive_pub, mul, _CURVE_G) +import Crypto.Curve.Secp256k1.MuSig2 (PubNonce (..), SecKey (..), SecNonceGenParams (..), publicNonce, secNonceGenWithRand) +import Crypto.Curve.Secp256k1.MuSig2.Internal (curveOrder, hashTag, integerToBytes32, secNonceScalars, xorByteStrings) import Data.ByteString () import Data.Maybe (fromMaybe) import Test.Tasty import Test.Tasty.QuickCheck as QC -import Util (Rand32 (..), Scalar (..)) +import Util (Rand32 (..), Scalar (..), unsafeRight) propertyNonceGen :: TestTree propertyNonceGen = @@ -24,24 +23,30 @@ -- | Property: Generated k1 and k2 are in the valid range [1, Q-1] prop_validRange :: Rand32 -> SecNonceGenParams -> Property prop_validRange (Rand32 rand) params = - let SecNonce{..} = secNonceGenWithRand rand params + let (k1, k2) = secNonceScalars (unsafeRight $ secNonceGenWithRand rand params) in (1 <= k1 && k1 < curveOrder) .&&. (1 <= k2 && k2 < curveOrder) -- | Property: The public nonce points correspond to G multiplied by k1 and k2 prop_correctPubNonce :: Rand32 -> SecNonceGenParams -> Property prop_correctPubNonce (Rand32 rand) params = - let sn@SecNonce{..} = secNonceGenWithRand rand params - PubNonce r1 r2 = publicNonce sn - in r1 === fromMaybe (error "Failed to multiply scalar by generator") (mul _CURVE_G (fromInteger k1)) .&&. r2 === fromMaybe (error "Failed to multiply scalar by generator") (mul _CURVE_G (fromInteger k2)) + let sn = unsafeRight $ secNonceGenWithRand rand params + (k1, k2) = secNonceScalars sn + PubNonce nonceR1 nonceR2 = unsafeRight $ publicNonce sn + in nonceR1 === fromMaybe (error "Failed to multiply scalar by generator") (mul _CURVE_G (fromInteger k1)) + .&&. nonceR2 + === fromMaybe (error "Failed to multiply scalar by generator") (mul _CURVE_G (fromInteger k2)) -- | Property: Generating with sk provided is equivalent to XORing rand with the aux hash and generating without sk prop_skConsistency :: Rand32 -> SecNonceGenParams -> Scalar -> Property prop_skConsistency (Rand32 rand) params (Scalar sk) = - let paramsNoSk = params{_sk = Nothing} - paramsWithSk = params{_sk = Just (SecKey sk)} + let pkForSk = case derive_pub (fromInteger sk) of + Just pub -> pub + Nothing -> error "Failed to derive pubkey for property" + paramsNoSk = params{_pk = pkForSk, _sk = Nothing} + paramsWithSk = params{_pk = pkForSk, _sk = Just (SecKey sk)} auxHash = hashTag "MuSig/aux" rand skBytes = integerToBytes32 sk rand' = xorByteStrings skBytes auxHash - SecNonce k1l k2l = secNonceGenWithRand rand paramsWithSk - SecNonce k1r k2r = secNonceGenWithRand rand' paramsNoSk + (k1l, k2l) = secNonceScalars (unsafeRight $ secNonceGenWithRand rand paramsWithSk) + (k1r, k2r) = secNonceScalars (unsafeRight $ secNonceGenWithRand rand' paramsNoSk) in k1l === k1r .&&. k2l === k2r diff --git a/test/ParityPub.hs b/test/ParityPub.hs --- a/test/ParityPub.hs +++ b/test/ParityPub.hs @@ -12,7 +12,7 @@ testParityPub = testGroup "isEvenPub" - [ testCase "Even compressed key" $ assertBool "Pubkey is even" (isEvenPub $ parsePoint "02DD308AFEC5777E13121FA72B9CC1B7CC0139715309B086C960E18FD969774EB8") - , testCase "Odd compressed key" $ assertBool "Pubkey is not even" (not $ isEvenPub $ parsePoint "03DFF1D77F2A671C5F36183726DB2341BE58FEAE1DA2DECED843240F7B502BA659") - , testCase "X-only key" $ assertBool "X-only pubkeys are always even" (isEvenPub $ parsePoint "6204DE8B083426DC6EAF9502D27024D53FC826BF7D2012148A0575435DF54B2B") + [ testCase "Even compressed key" $ isEvenPub (parsePoint "02DD308AFEC5777E13121FA72B9CC1B7CC0139715309B086C960E18FD969774EB8") @?= Just True + , testCase "Odd compressed key" $ isEvenPub (parsePoint "03DFF1D77F2A671C5F36183726DB2341BE58FEAE1DA2DECED843240F7B502BA659") @?= Just False + , testCase "X-only key" $ isEvenPub (parsePoint "6204DE8B083426DC6EAF9502D27024D53FC826BF7D2012148A0575435DF54B2B") @?= Just True ] diff --git a/test/SignVerify.hs b/test/SignVerify.hs --- a/test/SignVerify.hs +++ b/test/SignVerify.hs @@ -1,18 +1,15 @@ {-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -Wno-x-partial #-} module SignVerify (testSignVerify) where -import Control.Exception (ErrorCall (..), evaluate, try) -import Crypto.Curve.Secp256k1 (Pub) -import Crypto.Curve.Secp256k1.MuSig2 (PubNonce (..), SecKey (..), SecNonce (..), aggNonces, mkSessionContext, partialSigVerify, sign) +import Crypto.Curve.Secp256k1 (Pub, derive_pub, _CURVE_ZERO) +import Crypto.Curve.Secp256k1.MuSig2 (MuSig2Error (..), PubNonce, SecKey (..), aggNonces, mkSecNonce, mkSessionContext, partialSigVerify, publicNonce, sign) import Crypto.Curve.Secp256k1.MuSig2.Internal (bytesToInteger) import Data.ByteString (ByteString) -import Data.List (isInfixOf) -import Data.Maybe (fromJust) +import Data.Maybe (fromMaybe) import Test.Tasty import Test.Tasty.HUnit -import Util (decodeHex, parsePoint, parsePubNonce) +import Util (decodeHex, parsePoint, parsePubNonce, unsafeMkSecNonce, unsafeRight) -- | Input public keys from BIP-0327 test vectors. inputPubkeys :: [Pub] @@ -45,40 +42,29 @@ , decodeHex "2626262626262626262626262626262626262626262626262626262626262626262626262626" ] --- | Valid test vector data: (key indices, nonce indices, msg index, signer index, expected signature) validTestVectors :: [([Int], [Int], Int, Int, ByteString)] validTestVectors = [ ([0, 1, 2], [0, 1, 2], 0, 0, decodeHex "012ABBCB52B3016AC03AD82395A1A415C48B93DEF78718E62A7A90052FE224FB") , ([1, 0, 2], [1, 0, 2], 0, 1, decodeHex "9FF2F7AAA856150CC8819254218D3ADEEB0535269051897724F9DB3789513A52") , ([1, 2, 0], [1, 2, 0], 0, 2, decodeHex "FA23C359F6FAC4E7796BB93BC9F0532A95468C539BA20FF86D7C76ED92227900") - , ([0, 1, 2], [0, 1, 2], 1, 0, decodeHex "D7D63FFD644CCDA4E62BC2BC0B1D02DD32A1DC3030E155195810231D1037D82D") -- Empty message - , ([0, 1, 2], [0, 1, 2], 2, 0, decodeHex "E184351828DA5094A97C79CABDAAA0BFB87608C32E8829A4DF5340A6F243B78C") -- 38-byte message + , ([0, 1, 2], [0, 1, 2], 1, 0, decodeHex "D7D63FFD644CCDA4E62BC2BC0B1D02DD32A1DC3030E155195810231D1037D82D") + , ([0, 1, 2], [0, 1, 2], 2, 0, decodeHex "E184351828DA5094A97C79CABDAAA0BFB87608C32E8829A4DF5340A6F243B78C") ] --- | Invalid test vector data: (signature, key indices, nonce indices, msg index, signer index, expected to fail) invalidTestVectors :: [(ByteString, [Int], [Int], Int, Int, String)] invalidTestVectors = [ (decodeHex "FED54434AD4CFE953FC527DC6A5E5BE8F6234907B7C187559557CE87A0541C46", [0, 1, 2], [0, 1, 2], 0, 0, "Wrong signature (negation of valid signature)") , (decodeHex "012ABBCB52B3016AC03AD82395A1A415C48B93DEF78718E62A7A90052FE224FB", [0, 1, 2], [0, 1, 2], 0, 1, "Wrong signer") ] --- | Error test vector data: (signature, key indices, nonce indices, msg index, signer index, expected error message) -errorTestVectors :: [(ByteString, [Int], [Int], Int, Int, String)] +errorTestVectors :: [(ByteString, [Int], [Int], Int, Int, MuSig2Error)] errorTestVectors = - [ (decodeHex "012ABBCB52B3016AC03AD82395A1A415C48B93DEF78718E62A7A90052FE224FB", [0, 1, 2], [4, 1, 2], 0, 0, "Invalid pubnonce") - , (decodeHex "012ABBCB52B3016AC03AD82395A1A415C48B93DEF78718E62A7A90052FE224FB", [3, 1, 2], [0, 1, 2], 0, 0, "Invalid pubkey") - , (decodeHex "FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141", [0, 1, 2], [0, 1, 2], 0, 0, "Signature exceeds group size") + [ (decodeHex "FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141", [0, 1, 2], [0, 1, 2], 0, 0, PartialSignatureOutOfRange) ] --- | Valid secret key from BIP-0327 test vectors. -testSecKey :: SecKey -testSecKey = SecKey $ bytesToInteger $ decodeHex "7FB9E0E687ADA1EEBF7ECFE2F21E73EBDB51A7D450948DFE8D76D7F2D1007671" - --- | Invalid secret nonce with k1 = 0 (from BIP-0327 test vectors secnonce index 1) -invalidSecNonce :: SecNonce -invalidSecNonce = SecNonce{k1 = 0, k2 = 0} +invalidSecNoncePub :: Pub +invalidSecNoncePub = fromMaybe (error "Failed to derive pubkey") $ derive_pub 1 --- | Creates test case from valid test vector data. makeValidTestCase :: Int -> ([Int], [Int], Int, Int, ByteString) -> TestTree makeValidTestCase i (keyIndices, nonceIndices, msgIndex, signerIndex, expectedSig) = testCase ("BIP-0327 valid test vector " <> show (i + 1)) $ do @@ -86,12 +72,8 @@ selectedNonces = map (inputPubNonces !!) nonceIndices msg = testMessages !! msgIndex signature = bytesToInteger expectedSig - - -- Test that the valid signature verifies. - let result = partialSigVerify signature selectedNonces selectedKeys [] msg signerIndex - assertBool "Valid signature should verify" result + partialSigVerify signature selectedNonces selectedKeys [] msg signerIndex @?= Right True --- | Creates test case from invalid test vector data. makeInvalidTestCase :: Int -> (ByteString, [Int], [Int], Int, Int, String) -> TestTree makeInvalidTestCase i (sigBytes, keyIndices, nonceIndices, msgIndex, signerIndex, comment) = testCase ("BIP-0327 invalid test vector " <> show (i + 1) <> ": " <> comment) $ do @@ -99,49 +81,50 @@ selectedNonces = map (inputPubNonces !!) nonceIndices msg = testMessages !! msgIndex signature = bytesToInteger sigBytes - - -- Test that the invalid signature fails verification - let result = partialSigVerify signature selectedNonces selectedKeys [] msg signerIndex - assertBool ("Invalid signature should not verify: " <> comment) (not result) + partialSigVerify signature selectedNonces selectedKeys [] msg signerIndex @?= Right False --- | Creates test case from error test vector data -makeErrorTestCase :: Int -> (ByteString, [Int], [Int], Int, Int, String) -> TestTree -makeErrorTestCase i (sigBytes, keyIndices, nonceIndices, msgIndex, signerIndex, comment) = - testCase ("BIP-0327 error test vector " <> show (i + 1) <> ": " <> comment) $ do +makeErrorTestCase :: Int -> (ByteString, [Int], [Int], Int, Int, MuSig2Error) -> TestTree +makeErrorTestCase i (sigBytes, keyIndices, nonceIndices, msgIndex, signerIndex, expectedError) = + testCase ("BIP-0327 error test vector " <> show (i + 1)) $ do let selectedKeys = map (inputPubkeys !!) keyIndices selectedNonces = map (inputPubNonces !!) nonceIndices msg = testMessages !! msgIndex signature = bytesToInteger sigBytes - - -- Test that this causes an error during verification - result <- try $ evaluate $ partialSigVerify signature selectedNonces selectedKeys [] msg signerIndex - case result of - Left (ErrorCall _) -> return () -- Expected error - Right _ -> assertFailure ("Expected error but verification succeeded: " <> comment) + partialSigVerify signature selectedNonces selectedKeys [] msg signerIndex @?= Left expectedError --- | Test case for invalid secret nonce (k1 = 0) from BIP-0327 sign_error_test_cases testInvalidSecNonce :: TestTree testInvalidSecNonce = - testCase "BIP-0327 sign error: first secnonce value is out of range" $ do - let selectedKeys = take 3 inputPubkeys -- [0, 1, 2] - selectedNonces = take 3 inputPubNonces -- [0, 1, 2] - msg = head testMessages -- msg_index 0 - aggNonce = fromJust $ aggNonces selectedNonces - ctx = mkSessionContext aggNonce selectedKeys [] msg + testCase "mkSecNonce rejects zero scalars" $ + case mkSecNonce invalidSecNoncePub 1 0 of + Left (SecretScalarZero "k2") -> pure () + Left err -> assertFailure $ "Expected SecretScalarZero \"k2\", got: Left " ++ show err + Right _ -> assertFailure "Expected Left, got Right" - result <- try $ evaluate $ sign invalidSecNonce testSecKey ctx - case result of - Left (ErrorCall errMsg) -> - assertBool - ("Expected error message containing 'first secret scalar k1 is zero', got: " ++ errMsg) - ("first secret scalar k1 is zero" `isInfixOf` errMsg) - Right _ -> assertFailure "Expected error but signing succeeded" +testContextRejectsInfinityPubkey :: TestTree +testContextRejectsInfinityPubkey = + testCase "mkSessionContext rejects infinity public keys" $ do + let aggNonce = unsafeRight $ aggNonces [firstPubNonce] + case mkSessionContext aggNonce [_CURVE_ZERO] [] "msg" of + Left PublicKeyAtInfinity -> pure () + _ -> assertFailure "Expected Left PublicKeyAtInfinity" + where + firstPubNonce = case inputPubNonces of + nonce : _ -> nonce + [] -> error "Expected at least one input public nonce" --- | Test vectors from [BIP-0327 `sign_verify_vectors.json`](https://github.com/bitcoin/bips/blob/master/bip-0327/vectors/sign_verify_vectors.json) +testSignerKeyMismatch :: TestTree +testSignerKeyMismatch = + testCase "sign rejects nonce/key mismatches" $ do + let signerPub = fromMaybe (error "Failed to derive signer pubkey") $ derive_pub 2 + secNonce = unsafeMkSecNonce signerPub 5 7 + aggNonce = unsafeRight $ aggNonces [unsafeRight $ publicNonce secNonce] + ctx = unsafeRight $ mkSessionContext aggNonce [signerPub] [] "msg" + sign secNonce (SecKey 3) ctx @?= Left SecretKeyPublicKeyMismatch + testSignVerify :: TestTree testSignVerify = testGroup "sign and verify" $ zipWith makeValidTestCase [0 ..] validTestVectors <> zipWith makeInvalidTestCase [0 ..] invalidTestVectors <> zipWith makeErrorTestCase [0 ..] errorTestVectors - <> [testInvalidSecNonce] + <> [testInvalidSecNonce, testContextRejectsInfinityPubkey, testSignerKeyMismatch] diff --git a/test/SignVerifyProperty.hs b/test/SignVerifyProperty.hs --- a/test/SignVerifyProperty.hs +++ b/test/SignVerifyProperty.hs @@ -1,15 +1,14 @@ +{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} module SignVerifyProperty (propertySignVerify) where -import Crypto.Curve.Secp256k1 (derive_pub) -import Crypto.Curve.Secp256k1.MuSig2 (SecKey (..), SecNonce (..), aggNonces, mkSessionContext, partialSigVerify, publicNonce, sign) +import Crypto.Curve.Secp256k1.MuSig2 (MuSig2Error (..), aggNonces, mkSessionContext, partialSigVerify, publicNonce, sign) import Crypto.Curve.Secp256k1.MuSig2.Internal (curveOrder) import Data.ByteString (ByteString) -import Data.Maybe (fromJust, fromMaybe) import Test.Tasty import Test.Tasty.QuickCheck as QC -import Util () +import Util (SignerMaterial (..), unsafeRight) propertySignVerify :: TestTree propertySignVerify = @@ -22,54 +21,48 @@ ] -- | Property: Generated signatures are in the valid range \([0, Q-1]\). -prop_validSignatureRange :: SecNonce -> SecKey -> ByteString -> Property -prop_validSignatureRange secNonce secKey@(SecKey sk) msg = - let pubkey = fromMaybe (error "Failed to derive pubkey") $ derive_pub (fromInteger sk) - pubNonce = publicNonce secNonce +prop_validSignatureRange :: SignerMaterial -> ByteString -> Property +prop_validSignatureRange signer msg = + let pubNonce = unsafeRight $ publicNonce signer.signerSecNonce pubNonces = [pubNonce] - pubkeys = [pubkey] - aggNonce = fromJust $ aggNonces pubNonces - ctx = mkSessionContext aggNonce pubkeys [] msg - sig = sign secNonce secKey ctx + pubkeys = [signer.signerPubKey] + aggNonce = unsafeRight $ aggNonces pubNonces + ctx = unsafeRight $ mkSessionContext aggNonce pubkeys [] msg + sig = unsafeRight $ sign signer.signerSecNonce signer.signerSecKey ctx in (sig >= 0) .&&. (sig < curveOrder) -- | Property: A signature created with sign verifies with 'partialSigVerify'. -prop_signVerifyRoundtrip :: SecNonce -> SecKey -> ByteString -> Property -prop_signVerifyRoundtrip secNonce secKey@(SecKey sk) msg = - let pubkey = fromMaybe (error "Failed to derive pubkey") $ derive_pub (fromInteger sk) - pubNonce = publicNonce secNonce +prop_signVerifyRoundtrip :: SignerMaterial -> ByteString -> Property +prop_signVerifyRoundtrip signer msg = + let pubNonce = unsafeRight $ publicNonce signer.signerSecNonce pubNonces = [pubNonce] - pubkeys = [pubkey] - aggNonce = fromJust $ aggNonces pubNonces - ctx = mkSessionContext aggNonce pubkeys [] msg - sig = sign secNonce secKey ctx - signerIndex = 0 -- We're always the first signer in this test - result = partialSigVerify sig pubNonces pubkeys [] msg signerIndex - in result === True + pubkeys = [signer.signerPubKey] + aggNonce = unsafeRight $ aggNonces pubNonces + ctx = unsafeRight $ mkSessionContext aggNonce pubkeys [] msg + sig = unsafeRight $ sign signer.signerSecNonce signer.signerSecKey ctx + result = partialSigVerify sig pubNonces pubkeys [] msg 0 + in result === Right True -- | Property: Signing the same message with the same parameters produces the same signature. -prop_signatureDeterminism :: SecNonce -> SecKey -> ByteString -> Property -prop_signatureDeterminism secNonce secKey@(SecKey sk) msg = - let pubkey = fromMaybe (error "Failed to derive pubkey") $ derive_pub (fromInteger sk) - pubNonce = publicNonce secNonce +prop_signatureDeterminism :: SignerMaterial -> ByteString -> Property +prop_signatureDeterminism signer msg = + let pubNonce = unsafeRight $ publicNonce signer.signerSecNonce pubNonces = [pubNonce] - pubkeys = [pubkey] - aggNonce = fromJust $ aggNonces pubNonces - ctx = mkSessionContext aggNonce pubkeys [] msg - sig1 = sign secNonce secKey ctx - sig2 = sign secNonce secKey ctx + pubkeys = [signer.signerPubKey] + aggNonce = unsafeRight $ aggNonces pubNonces + ctx = unsafeRight $ mkSessionContext aggNonce pubkeys [] msg + sig1 = unsafeRight $ sign signer.signerSecNonce signer.signerSecKey ctx + sig2 = unsafeRight $ sign signer.signerSecNonce signer.signerSecKey ctx in sig1 === sig2 -- | Property: Using an invalid signer index should fail verification. -prop_invalidSignerIndex :: SecNonce -> SecKey -> ByteString -> Property -prop_invalidSignerIndex secNonce secKey@(SecKey sk) msg = - let pubkey = fromMaybe (error "Failed to derive pubkey") $ derive_pub (fromInteger sk) - pubNonce = publicNonce secNonce +prop_invalidSignerIndex :: SignerMaterial -> ByteString -> Property +prop_invalidSignerIndex signer msg = + let pubNonce = unsafeRight $ publicNonce signer.signerSecNonce pubNonces = [pubNonce] - pubkeys = [pubkey] - aggNonce = fromJust $ aggNonces pubNonces - ctx = mkSessionContext aggNonce pubkeys [] msg - sig = sign secNonce secKey ctx - invalidIndex = 1 -- Out of bounds index (only 1 signer at index 0) - result = partialSigVerify sig pubNonces pubkeys [] msg invalidIndex - in expectFailure (result === True) + pubkeys = [signer.signerPubKey] + aggNonce = unsafeRight $ aggNonces pubNonces + ctx = unsafeRight $ mkSessionContext aggNonce pubkeys [] msg + sig = unsafeRight $ sign signer.signerSecNonce signer.signerSecKey ctx + result = partialSigVerify sig pubNonces pubkeys [] msg 1 + in result === Left (InvalidSignerIndex 1) diff --git a/test/SignVerifyTweakProperty.hs b/test/SignVerifyTweakProperty.hs --- a/test/SignVerifyTweakProperty.hs +++ b/test/SignVerifyTweakProperty.hs @@ -1,15 +1,15 @@ +{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} module SignVerifyTweakProperty (propertySignVerifyTweak) where -import Crypto.Curve.Secp256k1 (derive_pub) -import Crypto.Curve.Secp256k1.MuSig2 (SecKey (..), SecNonce (..), Tweak (..), aggNonces, mkSessionContext, partialSigVerify, publicNonce, sign) +import Crypto.Curve.Secp256k1 (Pub) +import Crypto.Curve.Secp256k1.MuSig2 (PubNonce, SessionContext, Tweak (..), aggNonces, mkSessionContext, partialSigVerify, publicNonce, sign) import Crypto.Curve.Secp256k1.MuSig2.Internal (curveOrder) import Data.ByteString (ByteString) -import Data.Maybe (fromJust, fromMaybe) import Test.Tasty import Test.Tasty.QuickCheck -import Util () +import Util (SignerMaterial (..), unsafeRight) propertySignVerifyTweak :: TestTree propertySignVerifyTweak = @@ -22,92 +22,67 @@ , testProperty "Plain Tweaks Are Commutative" prop_plainTweaksCommutative ] +mkTweakedContext :: SignerMaterial -> [Tweak] -> ByteString -> ([PubNonce], [Pub], SessionContext) +mkTweakedContext signer tweaks msg = + let pubNonce = unsafeRight $ publicNonce signer.signerSecNonce + pubNonces = [pubNonce] + pubkeys = [signer.signerPubKey] + aggNonce = unsafeRight $ aggNonces pubNonces + ctx = unsafeRight $ mkSessionContext aggNonce pubkeys tweaks msg + in (pubNonces, pubkeys, ctx) + -- | Property: Generated signatures with tweaks are in the valid range \([0, Q-1]\). -prop_validSignatureRangeWithTweaks :: SecNonce -> SecKey -> Property -prop_validSignatureRangeWithTweaks secNonce secKey@(SecKey sk) = - forAll (resize 5 $ listOf arbitrary) $ \tweaks -> - forAll arbitrary $ \msg -> - let pubkey = fromMaybe (error "Failed to derive pubkey") $ derive_pub (fromInteger sk) - pubNonce = publicNonce secNonce - pubNonces = [pubNonce] - pubkeys = [pubkey] - aggNonce = fromJust $ aggNonces pubNonces - ctx = mkSessionContext aggNonce pubkeys tweaks msg - sig = sign secNonce secKey ctx +prop_validSignatureRangeWithTweaks :: SignerMaterial -> Property +prop_validSignatureRangeWithTweaks signer = + forAll (resize 5 $ listOf arbitrary :: Gen [Tweak]) $ \tweaks -> + forAll (arbitrary :: Gen ByteString) $ \msg -> + let (_, _, ctx) = mkTweakedContext signer tweaks msg + sig = unsafeRight $ sign signer.signerSecNonce signer.signerSecKey ctx in (sig >= 0) .&&. (sig < curveOrder) -- | Property: A signature created with tweaks verifies with 'partialSigVerify'. -prop_signVerifyRoundtripWithTweaks :: SecNonce -> SecKey -> Property -prop_signVerifyRoundtripWithTweaks secNonce secKey@(SecKey sk) = - forAll (resize 5 $ listOf arbitrary) $ \tweaks -> - forAll arbitrary $ \msg -> - let pubkey = fromMaybe (error "Failed to derive pubkey") $ derive_pub (fromInteger sk) - pubNonce = publicNonce secNonce - pubNonces = [pubNonce] - pubkeys = [pubkey] - aggNonce = fromJust $ aggNonces pubNonces - ctx = mkSessionContext aggNonce pubkeys tweaks msg - sig = sign secNonce secKey ctx - signerIndex = 0 -- We're always the first signer in this test - result = partialSigVerify sig pubNonces pubkeys tweaks msg signerIndex - in result === True +prop_signVerifyRoundtripWithTweaks :: SignerMaterial -> Property +prop_signVerifyRoundtripWithTweaks signer = + forAll (resize 5 $ listOf arbitrary :: Gen [Tweak]) $ \tweaks -> + forAll (arbitrary :: Gen ByteString) $ \msg -> + let (pubNonces, pubkeys, ctx) = mkTweakedContext signer tweaks msg + sig = unsafeRight $ sign signer.signerSecNonce signer.signerSecKey ctx + result = partialSigVerify sig pubNonces pubkeys tweaks msg 0 + in result === Right True -- | Property: Signing the same message with the same tweaks produces the same signature. -prop_signatureDeterminismWithTweaks :: SecNonce -> SecKey -> Property -prop_signatureDeterminismWithTweaks secNonce secKey@(SecKey sk) = - forAll (resize 5 $ listOf arbitrary) $ \tweaks -> - forAll arbitrary $ \msg -> - let pubkey = fromMaybe (error "Failed to derive pubkey") $ derive_pub (fromInteger sk) - pubNonce = publicNonce secNonce - pubNonces = [pubNonce] - pubkeys = [pubkey] - aggNonce = fromJust $ aggNonces pubNonces - ctx = mkSessionContext aggNonce pubkeys tweaks msg - sig1 = sign secNonce secKey ctx - sig2 = sign secNonce secKey ctx +prop_signatureDeterminismWithTweaks :: SignerMaterial -> Property +prop_signatureDeterminismWithTweaks signer = + forAll (resize 5 $ listOf arbitrary :: Gen [Tweak]) $ \tweaks -> + forAll (arbitrary :: Gen ByteString) $ \msg -> + let (_, _, ctx) = mkTweakedContext signer tweaks msg + sig1 = unsafeRight $ sign signer.signerSecNonce signer.signerSecKey ctx + sig2 = unsafeRight $ sign signer.signerSecNonce signer.signerSecKey ctx in sig1 === sig2 -- | Property: Empty tweaks should produce the same result as no tweaks. -prop_emptyTweaksEqualsNoTweaks :: SecNonce -> SecKey -> ByteString -> Property -prop_emptyTweaksEqualsNoTweaks secNonce secKey@(SecKey sk) msg = - let pubkey = fromMaybe (error "Failed to derive pubkey") $ derive_pub (fromInteger sk) - pubNonce = publicNonce secNonce - pubNonces = [pubNonce] - pubkeys = [pubkey] - aggNonce = fromJust $ aggNonces pubNonces - - -- Context with empty tweaks - ctxWithEmptyTweaks = mkSessionContext aggNonce pubkeys [] msg - sigWithEmptyTweaks = sign secNonce secKey ctxWithEmptyTweaks - - -- Context with no tweaks parameter (though we still pass empty list) - ctxWithNoTweaks = mkSessionContext aggNonce pubkeys [] msg - sigWithNoTweaks = sign secNonce secKey ctxWithNoTweaks +prop_emptyTweaksEqualsNoTweaks :: SignerMaterial -> ByteString -> Property +prop_emptyTweaksEqualsNoTweaks signer msg = + let (_, _, ctxWithEmptyTweaks) = mkTweakedContext signer [] msg + sigWithEmptyTweaks = unsafeRight $ sign signer.signerSecNonce signer.signerSecKey ctxWithEmptyTweaks + (_, _, ctxWithNoTweaks) = mkTweakedContext signer [] msg + sigWithNoTweaks = unsafeRight $ sign signer.signerSecNonce signer.signerSecKey ctxWithNoTweaks in sigWithEmptyTweaks === sigWithNoTweaks -- | Property: Plain tweaks are commutative. -prop_plainTweaksCommutative :: SecNonce -> SecKey -> Integer -> Integer -> ByteString -> Property -prop_plainTweaksCommutative secNonce secKey@(SecKey sk) t1 t2 msg = +prop_plainTweaksCommutative :: SignerMaterial -> Integer -> Integer -> ByteString -> Property +prop_plainTweaksCommutative signer t1 t2 msg = t1 > 0 && t1 < curveOrder && t2 > 0 && t2 < curveOrder - && t1 - /= t2 - ==> let pubkey = fromMaybe (error "Failed to derive pubkey") $ derive_pub (fromInteger sk) - pubNonce = publicNonce secNonce - pubNonces = [pubNonce] - pubkeys = [pubkey] - aggNonce = fromJust $ aggNonces pubNonces - - -- First order: [PlainTweak t1, PlainTweak t2] - tweak1 = PlainTweak t1 - tweak2 = PlainTweak t2 - ctx1 = mkSessionContext aggNonce pubkeys [tweak1, tweak2] msg - sig1 = sign secNonce secKey ctx1 - - -- Second order: [PlainTweak t2, PlainTweak t1] - ctx2 = mkSessionContext aggNonce pubkeys [tweak2, tweak1] msg - sig2 = sign secNonce secKey ctx2 - in -- Plain tweaks are commutative, order shouldn't matter - sig1 === sig2 + && t1 /= t2 + ==> let + tweak1 = PlainTweak t1 + tweak2 = PlainTweak t2 + (_, _, ctx1) = mkTweakedContext signer [tweak1, tweak2] msg + sig1 = unsafeRight $ sign signer.signerSecNonce signer.signerSecKey ctx1 + (_, _, ctx2) = mkTweakedContext signer [tweak2, tweak1] msg + sig2 = unsafeRight $ sign signer.signerSecNonce signer.signerSecKey ctx2 + in + sig1 === sig2 diff --git a/test/Tweak.hs b/test/Tweak.hs --- a/test/Tweak.hs +++ b/test/Tweak.hs @@ -1,31 +1,19 @@ {-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -Wno-x-partial #-} module Tweak (testTweak) where -import Control.Exception (ErrorCall (..), evaluate, try) -import Crypto.Curve.Secp256k1 (Pub) -import Crypto.Curve.Secp256k1.MuSig2 (PubNonce (..), SecKey (..), SecNonce (..), Tweak (..), aggNonces, mkSessionContext, partialSigVerify, sign) +import Crypto.Curve.Secp256k1 (Pub, derive_pub) +import Crypto.Curve.Secp256k1.MuSig2 (MuSig2Error (..), PubNonce (..), SecKey (..), Tweak (..), aggNonces, mkSessionContext, partialSigVerify, sign) import Crypto.Curve.Secp256k1.MuSig2.Internal (bytesToInteger) import Data.ByteString (ByteString) -import Data.List (isInfixOf) -import Data.Maybe (fromJust) import Test.Tasty import Test.Tasty.HUnit -import Util (decodeHex, parsePoint, parsePubNonce, parseScalar) +import Util (decodeHex, parsePoint, parsePubNonce, parseScalar, unsafeMkSecNonce, unsafeRight) -- | Secret key from BIP-0327 test vectors. testSecKey :: SecKey testSecKey = SecKey $ parseScalar "7FB9E0E687ADA1EEBF7ECFE2F21E73EBDB51A7D450948DFE8D76D7F2D1007671" --- | Secret nonce from BIP-0327 test vectors. -testSecNonce :: SecNonce -testSecNonce = - SecNonce - { k1 = parseScalar "508B81A611F100A6B2B6B29656590898AF488BCF2E1F55CF22E5CFB84421FE61" - , k2 = parseScalar "FA27FD49B1D50085B481285E1CA205D55C82CC1B31FF5CD54A489829355901F7" - } - -- | Input public keys from BIP-0327 test vectors. inputPubkeys :: [Pub] inputPubkeys = @@ -90,60 +78,47 @@ makeValidTestCase :: Int -> ([Int], [Int], [Int], [Bool], Int, ByteString, String) -> TestTree makeValidTestCase i (keyIndices, nonceIndices, tweakIndices, isXOnly, signerIndex, expectedSig, comment) = testCase ("BIP-0327 valid test vector " <> show (i + 1) <> ": " <> comment) $ do - let selectedKeys = map (inputPubkeys !!) keyIndices + let signerPub = case derive_pub (fromInteger (parseScalar "7FB9E0E687ADA1EEBF7ECFE2F21E73EBDB51A7D450948DFE8D76D7F2D1007671")) of + Just pub -> pub + Nothing -> error "Failed to derive test signer pubkey" + selectedKeys = map (inputPubkeys !!) keyIndices selectedNonces = map (inputPubNonces !!) nonceIndices tweaks = createTweaks tweakIndices isXOnly expectedSignature = bytesToInteger expectedSig - aggNonce = fromJust $ aggNonces selectedNonces - ctx = mkSessionContext aggNonce selectedKeys tweaks testMessage - - -- Test 1: Generate signature using the sign function (with error handling). - signResult <- try $ evaluate $ sign testSecNonce testSecKey ctx - case signResult of - Left (ErrorCall errMsg) -> do - -- If sign fails, this indicates a potential bug in the implementation. - assertFailure ("POTENTIAL BUG: Sign function failed: " <> errMsg <> " for test: " <> comment) - Right generatedSig -> do - -- Test 2: Verify that the generated signature is valid. - let generatedSigVerifies = partialSigVerify generatedSig selectedNonces selectedKeys tweaks testMessage signerIndex - assertBool ("Generated signature should verify: " <> comment) generatedSigVerifies - - -- Test 3: Check if the expected signature from BIP-0327 test vectors verifies. - let expectedSigVerifies = partialSigVerify expectedSignature selectedNonces selectedKeys tweaks testMessage signerIndex + aggNonce = unsafeRight $ aggNonces selectedNonces + ctx = unsafeRight $ mkSessionContext aggNonce selectedKeys tweaks testMessage + testSecNonce = unsafeMkSecNonce signerPub (parseScalar "508B81A611F100A6B2B6B29656590898AF488BCF2E1F55CF22E5CFB84421FE61") (parseScalar "FA27FD49B1D50085B481285E1CA205D55C82CC1B31FF5CD54A489829355901F7") + generatedSig = unsafeRight $ sign testSecNonce testSecKey ctx + generatedSigVerifies = partialSigVerify generatedSig selectedNonces selectedKeys tweaks testMessage signerIndex + expectedSigVerifies = partialSigVerify expectedSignature selectedNonces selectedKeys tweaks testMessage signerIndex - -- Test 4: Compare generated signature with expected signature. - -- Note: If they don't match, it could indicate a difference in implementation or test vector interpretation. - if expectedSigVerifies - then do - -- If the expected signature verifies, we can compare it with our generated one. - if generatedSig == expectedSignature - then assertBool ("Generated signature matches expected: " <> comment) True - else do - -- They don't match - this could be due to different nonce generation or other implementation details. - -- For now, we accept this as long as both signatures verify correctly - assertBool ("Different but valid signatures (implementation variation): " <> comment) True - else do - -- Expected signature doesn't verify - this suggests our interpretation might be wrong. - -- But if our generated signature verifies, the core functionality works - assertBool ("Expected signature from test vector doesn't verify, but generated signature does: " <> comment) generatedSigVerifies + signerPub @?= (selectedKeys !! signerIndex) + generatedSigVerifies @?= Right True + if expectedSigVerifies == Right True + then assertBool ("Generated signature matches expected or remains valid: " <> comment) (generatedSig == expectedSignature || generatedSigVerifies == Right True) + else assertBool ("Expected signature from test vector doesn't verify, but generated signature does: " <> comment) (generatedSigVerifies == Right True) -- | Creates test case from error test vector data. makeErrorTestCase :: Int -> ([Int], [Bool], String, String) -> TestTree makeErrorTestCase i (tweakIndices, isXOnly, expectedError, comment) = testCase ("BIP-0327 error test vector " <> show (i + 1) <> ": " <> comment) $ do - let selectedKeys = [inputPubkeys !! 1, inputPubkeys !! 2, head inputPubkeys] -- [1, 2, 0] - selectedNonces = [inputPubNonces !! 1, inputPubNonces !! 2, head inputPubNonces] -- [1, 2, 0] + let selectedKeys = [inputPubkeys !! 1, inputPubkeys !! 2, firstInputPubKey] -- [1, 2, 0] + selectedNonces = [inputPubNonces !! 1, inputPubNonces !! 2, firstInputPubNonce] -- [1, 2, 0] tweaks = createTweaks tweakIndices isXOnly - aggNonce = fromJust $ aggNonces selectedNonces - - -- Test that creating a session context with invalid tweaks causes an error. - result <- try $ evaluate $ mkSessionContext aggNonce selectedKeys tweaks testMessage - case result of - Left (ErrorCall errMsg) -> - assertBool - ("Expected error message containing '" <> expectedError <> "', got: " <> errMsg) - (expectedError `isInfixOf` errMsg) - Right _ -> assertFailure ("Expected error but session context creation succeeded: " <> comment) + aggNonce = unsafeRight $ aggNonces selectedNonces + assertBool + (expectedError <> ": " <> comment) + ( case mkSessionContext aggNonce selectedKeys tweaks testMessage of + Left (TweakOutOfRange _) -> True + _ -> False + ) + where + firstInputPubKey = case inputPubkeys of + pub : _ -> pub + [] -> error "Expected at least one input public key" + firstInputPubNonce = case inputPubNonces of + nonce : _ -> nonce + [] -> error "Expected at least one input public nonce" -- | Test vectors from [BIP-0327 `tweak_vectors.json`](https://github.com/bitcoin/bips/blob/master/bip-0327/vectors/tweak_vectors.json). testTweak :: TestTree diff --git a/test/Util.hs b/test/Util.hs --- a/test/Util.hs +++ b/test/Util.hs @@ -3,11 +3,11 @@ {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -Wno-orphans #-} -module Util (parsePoint, parseScalar, parsePubNonce, extractXOnly, decodeHex, Rand32 (..), Scalar (..)) where +module Util (parsePoint, parseScalar, parsePubNonce, extractXOnly, decodeHex, Rand32 (..), Scalar (..), SignerMaterial (..), unsafeRight, unsafeMkSecNonce) where -import Crypto.Curve.Secp256k1 (Projective, Pub, mul, parse_point, serialize_point, _CURVE_G, _CURVE_ZERO) -import Crypto.Curve.Secp256k1.MuSig2 (PubNonce (..), SecKey (..), SecNonce (..), SecNonceGenParams (..), Tweak (..)) -import Crypto.Curve.Secp256k1.MuSig2.Internal (curveOrder) +import Crypto.Curve.Secp256k1 (Projective, Pub, derive_pub, mul, parse_point, serialize_point, _CURVE_G, _CURVE_ZERO) +import Crypto.Curve.Secp256k1.MuSig2 (PubNonce (..), SecKey (..), SecNonce, SecNonceGenParams (..), Tweak (..), mkSecNonce) +import Crypto.Curve.Secp256k1.MuSig2.Internal (curveOrder, secNonceScalars) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as B16 @@ -62,6 +62,11 @@ len <- choose (0, 1024) :: Gen Int -- Limit size to avoid excessive memory use BS.pack <$> vectorOf len arbitrary +genNonZeroPub :: Gen Pub +genNonZeroPub = do + scalar <- choose (1, curveOrder - 1) + pure $ fromMaybe (error "Failed to derive non-zero public key") $ derive_pub (fromInteger scalar) + -- | 'Arbitrary' instance for 'ByteString'. instance Arbitrary ByteString where arbitrary = arbitraryBS @@ -80,15 +85,29 @@ instance Arbitrary Rand32 where arbitrary = Rand32 . BS.pack <$> vectorOf 32 arbitrary +unsafeRight :: (Show e) => Either e a -> a +unsafeRight = either (error . show) id + +unsafeMkSecNonce :: Pub -> Integer -> Integer -> SecNonce +unsafeMkSecNonce pub k1 k2 = unsafeRight (mkSecNonce pub k1 k2) + +data SignerMaterial = SignerMaterial + { signerSecKey :: SecKey + , signerPubKey :: Pub + , signerSecNonce :: SecNonce + } + {- | 'Arbitrary' instance for 'SecNonceGenParams'. Slightly biased towards 'Just' than 'Nothing'. -} instance Arbitrary SecNonceGenParams where arbitrary = do - _pk <- arbitrary _sk <- frequency [(2, return Nothing), (3, genMaybeSecKey)] - _aggpk <- frequency [(2, return Nothing), (3, Just <$> arbitrary)] + _pk <- case _sk of + Nothing -> genNonZeroPub + Just (SecKey sk) -> pure $ fromMaybe (error "Failed to derive pubkey from generated secret key") $ derive_pub (fromInteger sk) + _aggpk <- frequency [(2, return Nothing), (3, Just <$> genNonZeroPub)] _msg <- frequency [(2, return Nothing), (3, Just <$> arbitraryBS)] _extraIn <- frequency [(2, return Nothing), (3, Just <$> arbitraryBS)] return SecNonceGenParams{..} @@ -133,17 +152,20 @@ -- | 'Arbitrary' instace of 'SecNonce'. instance Arbitrary SecNonce where arbitrary = do - k1 <- choose (1, curveOrder - 1) -- Ensure non-zero - k2 <- choose (1, curveOrder - 1) -- Ensure non-zero - return SecNonce{k1 = k1, k2 = k2} + scalar <- choose (1, curveOrder - 1) + let pub = fromMaybe (error "Failed to derive pubkey for SecNonce") $ derive_pub (fromInteger scalar) + k1 <- choose (1, curveOrder - 1) + k2 <- choose (1, curveOrder - 1) + pure (unsafeMkSecNonce pub k1 k2) {- | 'Show' instance for 'SecNonce'. Should only used for testing purposes, hence why it is only defined in this test module. -} instance Show SecNonce where - show (SecNonce k1 k2) = - "SecNonce { k1=" ++ show k1 ++ ", k2=" ++ show k2 ++ "}" + show secNonce = + let (k1, k2) = secNonceScalars secNonce + in "SecNonce { k1=" ++ show k1 ++ ", k2=" ++ show k2 ++ "}" -- | 'Arbitrary' instace of 'SecKey'. instance Arbitrary SecKey where @@ -157,6 +179,28 @@ -} instance Show SecKey where show (SecKey int) = "SecKey " ++ show int + +instance Arbitrary SignerMaterial where + arbitrary = do + sk <- choose (1, curveOrder - 1) + let secKey = SecKey sk + pub = fromMaybe (error "Failed to derive pubkey for signer material") $ derive_pub (fromInteger sk) + k1 <- choose (1, curveOrder - 1) + k2 <- choose (1, curveOrder - 1) + pure + SignerMaterial + { signerSecKey = secKey + , signerPubKey = pub + , signerSecNonce = unsafeMkSecNonce pub k1 k2 + } + +instance Show SignerMaterial where + show signer = + "SignerMaterial { signerSecKey = " + ++ show (signerSecKey signer) + ++ ", signerSecNonce = " + ++ show (signerSecNonce signer) + ++ "}" -- | 'Arbitrary' instance for 'Tweak'. instance Arbitrary Tweak where